From 957f15fe6c28684d4fbafb15f5609bcc12dc246c Mon Sep 17 00:00:00 2001
From: Thomas Leonard <talex5@gmail.com>
Date: Thu, 27 Jan 2022 20:47:56 +0000
Subject: [PATCH] Add fuzz tests for `Buf_read` module

Bugs found:

- `Buf_read.string` didn't consume the string.
- If `ensure` was called with `n > max_size` at end-of-file then
  it would sometimes report one error and sometimes the other,
  depending on the internal state of the buffer. Now it always
  reports the size problem.
- `take` and `skip` now raise `Invalid_arg` on bad input, instead
  of triggering an assertion failure.
- `skip n` where `n` is longer than the remaining data now discards
  all data (in addition to raising). It cannot be atomic because it
  may discard more than one buffer's worth of data before discovering
  the problem, so make it predictable.
- `skip_while` grew the buffer to include all skipped bytes.
  It now discards data as it goes.
---
 dune-project        |   2 +
 eio.opam            |   2 +
 fuzz/dune           |   4 ++
 fuzz/test.ml        | 164 ++++++++++++++++++++++++++++++++++++++++++++
 fuzz/test.mli       |   0
 lib_eio/buf_read.ml |  47 +++++++++----
 lib_eio/eio.mli     |   6 +-
 tests/buf_reader.md |   2 +
 8 files changed, 211 insertions(+), 16 deletions(-)
 create mode 100644 fuzz/dune
 create mode 100644 fuzz/test.ml
 create mode 100644 fuzz/test.mli

diff --git a/dune-project b/dune-project
index cd1de28..e05dfc4 100644
--- a/dune-project
+++ b/dune-project
@@ -18,6 +18,8 @@
   (optint (>= 0.1.0))
   (psq (>= 0.2.0))
   (fmt (>= 0.8.9))
+  (astring (and (>= 0.8.5) :with-test))
+  (crowbar (and (>= 0.2) :with-test))
   (alcotest (and (>= 1.4.0) :with-test))))
 (package
  (name eio_linux)
diff --git a/eio.opam b/eio.opam
index 96a2d62..272adf3 100644
--- a/eio.opam
+++ b/eio.opam
@@ -16,6 +16,8 @@ depends: [
   "optint" {>= "0.1.0"}
   "psq" {>= "0.2.0"}
   "fmt" {>= "0.8.9"}
+  "astring" {>= "0.8.5" & with-test}
+  "crowbar" {>= "0.2" & with-test}
   "alcotest" {>= "1.4.0" & with-test}
   "odoc" {with-doc}
 ]
diff --git a/fuzz/dune b/fuzz/dune
new file mode 100644
index 0000000..716b489
--- /dev/null
+++ b/fuzz/dune
@@ -0,0 +1,4 @@
+(test
+  (package eio)
+  (libraries cstruct crowbar fmt astring eio)
+  (name test))
diff --git a/fuzz/test.ml b/fuzz/test.ml
new file mode 100644
index 0000000..919b34e
--- /dev/null
+++ b/fuzz/test.ml
@@ -0,0 +1,164 @@
+(* This file contains a simple model of `Buf_read`, using a single string.
+   It runs random operations on both the model and the real buffer and
+   checks they always give the same result. *)
+
+open Astring
+
+let debug = false
+
+module Buf_read = Eio.Buf_read
+exception Buffer_limit_exceeded = Buf_read.Buffer_limit_exceeded
+
+let initial_size = 10
+let max_size = 100
+
+let mock_flow next = object (self : #Eio.Flow.read)
+  val mutable next = next
+
+  method read_methods = []
+
+  method read_into buf =
+    match next with
+    | [] ->
+      raise End_of_file
+    | "" :: xs ->
+      next <- xs;
+      self#read_into buf
+    | x :: xs ->
+      let len = min (Cstruct.length buf) (String.length x) in
+      Cstruct.blit_from_string x 0 buf 0 len;
+      let x' = String.with_index_range x ~first:len in
+      next <- (if x' = "" then xs else x' :: xs);
+      len
+end
+
+module Model = struct
+  type t = string ref
+
+  let of_chunks chunks = ref (String.concat chunks)
+
+  let take_all t =
+    let old = !t in
+    if String.length old >= max_size then raise Buffer_limit_exceeded;
+    t := "";
+    old
+
+  let line t =
+    match String.cut ~sep:"\n" !t with
+    | Some (line, rest) ->
+      if String.length line >= max_size then raise Buffer_limit_exceeded;
+      t := rest;
+      if String.is_suffix ~affix:"\r" line then String.with_index_range line ~last:(String.length line - 2)
+      else line
+    | None when !t = "" -> raise End_of_file
+    | None when String.length !t >= max_size -> raise Buffer_limit_exceeded
+    | None -> take_all t
+
+  let any_char t =
+    match !t with
+    | "" -> raise End_of_file
+    | s ->
+      t := String.with_index_range s ~first:1;
+      String.get_head s
+
+  let peek_char t = String.head !t
+
+  let consume t n =
+    t := String.with_index_range !t ~first:n
+
+  let char c t =
+    match peek_char t with
+    | Some c2 when c = c2 -> consume t 1
+    | Some _ -> failwith "char"
+    | None -> raise End_of_file
+
+  let string s t =
+    if debug then Fmt.pr "string %S@." s;
+    let len_t = String.length !t in
+    if not (String.is_prefix ~affix:(String.with_range s ~len:len_t) !t) then failwith "string";
+    if String.length s > max_size then raise Buffer_limit_exceeded;
+    if String.is_prefix ~affix:s !t then consume t (String.length s)
+    else raise End_of_file
+
+  let take n t =
+    if n < 0 then invalid_arg "neg";
+    if n > max_size then raise Buffer_limit_exceeded
+    else if String.length !t >= n then (
+      let data = String.with_range !t ~len:n in
+      t := String.with_range !t ~first:n;
+      data
+    ) else raise End_of_file
+
+  let take_while p t =
+    match String.find (Fun.negate p) !t with
+    | Some i when i >= max_size -> raise Buffer_limit_exceeded
+    | Some i ->
+      let data = String.with_range !t ~len:i in
+      consume t i;
+      data
+    | None -> take_all t
+
+  let skip_while p t =
+    match String.find (Fun.negate p) !t with
+    | Some i -> consume t i
+    | None -> t := ""
+
+  let skip n t =
+    if n < 0 then invalid_arg "skip";
+    if n > String.length !t then (
+      t := "";
+      raise End_of_file;
+    );
+    consume t n
+end
+
+type op = Op : 'a Crowbar.printer * 'a Buf_read.parser * (Model.t -> 'a) -> op
+
+let unit = Fmt.(const string) "()"
+let dump_char f c = Fmt.pf f "%C" c
+
+let digit = function
+  | '0'..'9' -> true
+  | _ -> false
+
+let op =
+  let label (name, gen) = Crowbar.with_printer Fmt.(const string name) gen in
+  Crowbar.choose @@ List.map label [
+    "line", Crowbar.const @@ Op (Fmt.Dump.string, Buf_read.line, Model.line);
+    "char 'x'", Crowbar.const @@ Op (unit, Buf_read.char 'x', Model.char 'x');
+    "any_char", Crowbar.const @@ Op (dump_char, Buf_read.any_char, Model.any_char);
+    "peek_char", Crowbar.const @@ Op (Fmt.Dump.option dump_char, Buf_read.peek_char, Model.peek_char);
+    "string", Crowbar.(map [bytes]) (fun s -> Op (unit, Buf_read.string s, Model.string s));
+    "take", Crowbar.(map [int]) (fun n -> Op (Fmt.Dump.string, Buf_read.take n, Model.take n));
+    "take_all", Crowbar.const @@ Op (Fmt.Dump.string, Buf_read.take_all, Model.take_all);
+    "take_while digit", Crowbar.const @@ Op (Fmt.Dump.string, Buf_read.take_while digit, Model.take_while digit);
+    "skip_while digit", Crowbar.const @@ Op (unit, Buf_read.skip_while digit, Model.skip_while digit);
+    "skip", Crowbar.(map [int]) (fun n -> Op (unit, Buf_read.skip n, Model.skip n));
+  ]
+
+let catch f x =
+  match f x with
+  | y -> Ok y
+  | exception End_of_file -> Error "EOF"
+  | exception Invalid_argument _ -> Error "Invalid"
+  | exception Failure _ -> Error "Failure"
+  | exception Buffer_limit_exceeded -> Error "TooBig"
+
+let random chunks ops =
+  let model = Model.of_chunks chunks in
+  let r = Buf_read.of_flow (mock_flow chunks) ~initial_size ~max_size in
+  if debug then print_endline "*** start ***";
+  let check_eq (Op (pp, a, b)) =
+    if debug then (
+      Fmt.pr "---@.";
+      Fmt.pr "real :%S@." (Cstruct.to_string (Buf_read.peek r));
+      Fmt.pr "model:%S@." !model;
+    );
+    let x = catch a r in
+    let y = catch b model in
+    Crowbar.check_eq ~pp:Fmt.(result ~ok:pp ~error:string) x y
+  in
+  List.iter check_eq ops
+
+let () =
+  Crowbar.(add_test ~name:"random ops" [list bytes; list op] random)
diff --git a/fuzz/test.mli b/fuzz/test.mli
new file mode 100644
index 0000000..e69de29
diff --git a/lib_eio/buf_read.ml b/lib_eio/buf_read.ml
index e12cd6c..475a189 100644
--- a/lib_eio/buf_read.ml
+++ b/lib_eio/buf_read.ml
@@ -59,6 +59,7 @@ let eof_seen t = t.flow = None
 let ensure t n =
   assert (n >= 0);
   if t.len < n then (
+    if n > t.max_size then raise Buffer_limit_exceeded;
     (* We don't have enough data yet, so we'll need to do a read. *)
     match t.flow with
     | None -> raise End_of_file
@@ -69,7 +70,6 @@ let ensure t n =
         let cap = capacity t in
         if n > cap then (
           (* [n] bytes won't fit. We need to resize the buffer. *)
-          if n > t.max_size then raise Buffer_limit_exceeded;
           let new_size = max n (min t.max_size (cap * 2)) in
           let new_buf = Bigarray.(Array1.create char c_layout new_size) in
           Cstruct.blit
@@ -133,6 +133,7 @@ let peek_char t =
   | exception End_of_file -> None
 
 let take len t =
+  if len < 0 then Fmt.invalid_arg "take: %d is negative!" len;
   ensure t len;
   let data = Cstruct.to_string (Cstruct.of_bigarray t.buf ~off:t.pos ~len) in
   consume t len;
@@ -140,22 +141,23 @@ let take len t =
 
 let string s t =
   let rec aux i =
-    if i = String.length s then true
-    else if i < t.len then (
+    if i = String.length s then (
+      consume t i
+    ) else if i < t.len then (
       if get t i = s.[i] then aux (i + 1)
-      else false
+      else (
+        let buf = peek t in
+        let len = min (String.length s) (Cstruct.length buf) in
+        Fmt.failwith "Expected %S but got %S"
+          s
+          (Cstruct.to_string buf ~off:0 ~len)
+      )
     ) else (
       ensure t (t.len + 1);
       aux i
     )
   in
-  if not (aux 0) then (
-    let buf = peek t in
-    let len = min (String.length s) (Cstruct.length buf) in
-    Fmt.failwith "Expected %S but got %S"
-      s
-      (Cstruct.to_string buf ~off:0 ~len)
-  )
+  aux 0
 
 let take_all t =
   try
@@ -186,11 +188,20 @@ let take_while p t =
   data
 
 let skip_while p t =
-  let len = count_while p t in
-  consume t len
+  let rec aux i =
+    if i < t.len then (
+      if p (get t i) then aux (i + 1)
+      else consume t i
+    ) else (
+      consume t t.len;
+      ensure t 1;
+      aux 0
+    )
+  in
+  try aux 0
+  with End_of_file -> ()
 
 let rec skip n t =
-  assert (n >= 0);
   if n <= t.len then (
     consume t n
   ) else (
@@ -200,6 +211,14 @@ let rec skip n t =
     skip n t
   )
 
+let skip n t =
+  if n < 0 then Fmt.invalid_arg "skip: %d is negative!" n;
+  try skip n t
+  with End_of_file ->
+    (* Skip isn't atomic, so discard everything in this case for consistency. *)
+    consume t t.len;
+    raise End_of_file
+
 let line t =
   (* Return the index of the first '\n', reading more data as needed. *)
   let rec aux i =
diff --git a/lib_eio/eio.mli b/lib_eio/eio.mli
index 97110ab..69dcfd9 100644
--- a/lib_eio/eio.mli
+++ b/lib_eio/eio.mli
@@ -551,12 +551,14 @@ module Buf_read : sig
 
   val skip_while : (char -> bool) -> unit parser
   (** [skip_while p] skips zero or more bytes for which [p] is [true].
-      [skip_while p t] does the same thing as [ignore (take_while p t)]. *)
+      [skip_while p t] does the same thing as [ignore (take_while p t)],
+      except that it is not limited by the buffer size. *)
 
   val skip : int -> unit parser
   (** [skip n] discards the next [n] bytes.
       [skip n] = [map ignore (take n)],
-      except that the number of skipped bytes may be larger than the buffer (it will not grow). *)
+      except that the number of skipped bytes may be larger than the buffer (it will not grow).
+      Note: if [End_of_file] is raised, all bytes in the stream will have been consumed. *)
 
   (** {2 Combinators} *)
 
diff --git a/tests/buf_reader.md b/tests/buf_reader.md
index ba67e87..259028d 100644
--- a/tests/buf_reader.md
+++ b/tests/buf_reader.md
@@ -317,6 +317,8 @@ Exception: End_of_file.
 Exception: End_of_file.
 # R.string "bc" i;;
 - : unit = ()
+# peek i;;
+- : string = ""
 ```
 
 ## Scanning