remove some uses of scanf in parsing

src/Tiny_httpd.mli

@@ -1,7 +1,7 @@
 (** Tiny Http Server
 
     This library implements a very simple, basic HTTP/1.1 server using blocking
-    IOs and threads. Basic routing based on {!Scanf} is provided for convenience,
+    IOs and threads. Basic routing based is provided for convenience,
     so that several handlers can be registered.
 
     It is possible to use a thread pool, see {!create}'s argument [new_thread].

src/Tiny_httpd_parse_.ml

@@ -0,0 +1,77 @@
+(** Basic parser for lines *)
+
+type 'a t = string -> int ref -> 'a
+
+open struct
+  let spf = Printf.sprintf
+end
+
+let[@inline] eof s off = !off = String.length s
+
+let[@inline] skip_space : unit t =
+ fun s off ->
+  while !off < String.length s && String.unsafe_get s !off = ' ' do
+    incr off
+  done
+
+let pos_int : int t =
+ fun s off : int ->
+  skip_space s off;
+  let n = ref 0 in
+  let continue = ref true in
+  while !off < String.length s && !continue do
+    match String.unsafe_get s !off with
+    | '0' .. '9' as c -> n := (!n * 10) + Char.code c - Char.code '0'
+    | ' ' | '\t' | '\n' -> continue := false
+    | c -> failwith @@ spf "expected int, got %C" c
+  done;
+  !n
+
+let pos_hex : int t =
+ fun s off : int ->
+  skip_space s off;
+  let n = ref 0 in
+  let continue = ref true in
+  while !off < String.length s && !continue do
+    match String.unsafe_get s !off with
+    | 'a' .. 'f' as c ->
+      incr off;
+      n := (!n * 16) + Char.code c - Char.code 'a' + 10
+    | 'A' .. 'F' as c ->
+      incr off;
+      n := (!n * 16) + Char.code c - Char.code 'A' + 10
+    | '0' .. '9' as c ->
+      incr off;
+      n := (!n * 16) + Char.code c - Char.code '0'
+    | ' ' | '\r' -> continue := false
+    | c -> failwith @@ spf "expected int, got %C" c
+  done;
+  !n
+
+(** Parse a word without spaces *)
+let word : string t =
+ fun s off ->
+  skip_space s off;
+  let start = !off in
+  let continue = ref true in
+  while !off < String.length s && !continue do
+    match String.unsafe_get s !off with
+    | ' ' | '\r' -> continue := false
+    | _ -> incr off
+  done;
+  if !off = start then failwith "expected word";
+  String.sub s start (!off - start)
+
+let exact str : unit t =
+ fun s off ->
+  skip_space s off;
+  let len = String.length str in
+  if !off + len > String.length s then
+    failwith @@ spf "unexpected EOF, expected %S" str;
+  for i = 0 to len - 1 do
+    let expected = String.unsafe_get str i in
+    let c = String.unsafe_get s (!off + i) in
+    if c <> expected then
+      failwith @@ spf "expected %S, got %C at position %d" str c i
+  done;
+  off := !off + len

src/Tiny_httpd_server.ml

@@ -173,6 +173,9 @@ module Request = struct
   let query self = self.query
   let get_header ?f self h = Headers.get ?f h self.headers
 
+  let remove_header k self =
+    { self with headers = Headers.remove k self.headers }
+
   let get_header_int self h =
     match get_header self h with
     | Some x -> (try Some (int_of_string x) with _ -> None)
@@ -243,12 +246,22 @@ module Request = struct
       let start_time = get_time_s () in
       let meth, path, version =
         try
-          let meth, path, version =
+          let off = ref 0 in
-            Scanf.sscanf line "%s %s HTTP/1.%d\r" (fun x y z -> x, y, z)
+          let meth = Tiny_httpd_parse_.word line off in
+          let path = Tiny_httpd_parse_.word line off in
+          let http_version = Tiny_httpd_parse_.word line off in
+          let version =
+            match http_version with
+            | "HTTP/1.1" -> 1
+            | "HTTP/1.0" -> 0
+            | v -> invalid_arg (Printf.sprintf "unsupported HTTP version: %s" v)
           in
-          if version != 0 && version != 1 then raise Exit;
           meth, path, version
-        with _ ->
+        with
+        | Invalid_argument msg ->
+          Log.error (fun k -> k "invalid request line: `%s`: %s" line msg);
+          raise (Bad_req (400, "Invalid request line"))
+        | _ ->
           Log.error (fun k -> k "invalid request line: `%s`" line);
           raise (Bad_req (400, "Invalid request line"))
       in
@@ -354,6 +367,10 @@ module Response = struct
   let set_headers headers self = { self with headers }
   let update_headers f self = { self with headers = f self.headers }
   let set_header k v self = { self with headers = Headers.set k v self.headers }
+
+  let remove_header k self =
+    { self with headers = Headers.remove k self.headers }
+
   let set_code code self = { self with code }
 
   let make_raw ?(headers = []) ~code body : t =

src/Tiny_httpd_server.mli

@@ -115,6 +115,10 @@ module Request : sig
   val set_header : string -> string -> 'a t -> 'a t
   (** [set_header k v req] sets [k: v] in the request [req]'s headers. *)
 
+  val remove_header : string -> 'a t -> 'a t
+  (** Remove one instance of this header.
+      @since NEXT_RELEASE *)
+
   val update_headers : (Headers.t -> Headers.t) -> 'a t -> 'a t
   (** Modify headers using the given function.
       @since 0.11 *)
@@ -243,6 +247,10 @@ module Response : sig
   (** Modify headers.
       @since 0.11 *)
 
+  val remove_header : string -> t -> t
+  (** Remove one instance of this header.
+      @since NEXT_RELEASE *)
+
   val set_headers : Headers.t -> t -> t
   (** Set all headers.
       @since 0.11 *)

src/Tiny_httpd_stream.ml

@@ -268,7 +268,10 @@ let read_chunked ?(buf = Buf.create ()) ~fail (bs : t) : t =
       if String.trim line = "" then
         0
       else (
-        try Scanf.sscanf line "%x %s@\r" (fun n _ext -> n)
+        try
+          let off = ref 0 in
+          let n = Tiny_httpd_parse_.pos_hex line off in
+          n
         with _ ->
           raise (fail (spf "cannot read chunk size from line %S" line))
       )

src/Tiny_httpd_util.ml

@@ -11,7 +11,11 @@ let percent_encode ?(skip = fun _ -> false) s =
     s;
   Buffer.contents buf
 
-let hex_int (s : string) : int = Scanf.sscanf s "%x" (fun x -> x)
+let int_of_hex_nibble = function
+  | '0' .. '9' as c -> Char.code c - Char.code '0'
+  | 'a' .. 'f' as c -> 10 + Char.code c - Char.code 'a'
+  | 'A' .. 'F' as c -> 10 + Char.code c - Char.code 'A'
+  | _ -> invalid_arg "string: invalid hex"
 
 let percent_decode (s : string) : _ option =
   let buf = Buffer.create (String.length s) in
@@ -21,7 +25,10 @@ let percent_decode (s : string) : _ option =
       match String.get s !i with
       | '%' ->
         if !i + 2 < String.length s then (
-          (match hex_int @@ String.sub s (!i + 1) 2 with
+          (match
+             (int_of_hex_nibble (String.get s (!i + 1)) lsl 4)
+             + int_of_hex_nibble (String.get s (!i + 2))
+           with
           | n -> Buffer.add_char buf (Char.chr n)
           | exception _ -> raise Exit);
           i := !i + 3

src/camlzip/Tiny_httpd_camlzip.ml

@@ -148,6 +148,11 @@ let decompress_req_stream_ ~buf_size (req : BS.t S.Request.t) : _ S.Request.t =
        let req' = S.Request.set_header req "Transfer-Encoding" "chunked" in
        Some (req', decode_gzip_stream_)
   *)
+  | Some "deflate" ->
+    let body' = S.Request.body req |> decode_deflate_stream_ ~buf_size in
+    req
+    |> S.Request.remove_header "Transfer-Encoding"
+    |> S.Request.set_body body'
   | Some s when has_deflate s ->
     (match Scanf.sscanf s "deflate, %s" (fun s -> s) with
     | tr' ->

src/dune

@@ -1,7 +1,7 @@
 (library
   (name tiny_httpd)
   (public_name tiny_httpd)
-  (private_modules Tiny_httpd_mime_)
+  (private_modules Tiny_httpd_mime_ Tiny_httpd_parse_)
   (libraries threads seq unix
              (select Tiny_httpd_mime_.ml from
               (magic-mime -> Tiny_httpd_mime_.magic.ml)