diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index 4634edc8..b4cc6e89 100644 --- a/src/Tiny_httpd.mli +++ b/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]. diff --git a/src/Tiny_httpd_parse_.ml b/src/Tiny_httpd_parse_.ml new file mode 100644 index 00000000..39430889 --- /dev/null +++ b/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 diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index bdac6110..f023324c 100644 --- a/src/Tiny_httpd_server.ml +++ b/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 = - Scanf.sscanf line "%s %s HTTP/1.%d\r" (fun x y z -> x, y, z) + let off = ref 0 in + 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 = diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli index b91022d2..c9ee0763 100644 --- a/src/Tiny_httpd_server.mli +++ b/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 *) diff --git a/src/Tiny_httpd_stream.ml b/src/Tiny_httpd_stream.ml index 30754e91..a845c8bf 100644 --- a/src/Tiny_httpd_stream.ml +++ b/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)) ) diff --git a/src/Tiny_httpd_util.ml b/src/Tiny_httpd_util.ml index 9ec935ae..73617702 100644 --- a/src/Tiny_httpd_util.ml +++ b/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 diff --git a/src/camlzip/Tiny_httpd_camlzip.ml b/src/camlzip/Tiny_httpd_camlzip.ml index e815641d..7d390211 100644 --- a/src/camlzip/Tiny_httpd_camlzip.ml +++ b/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' -> diff --git a/src/dune b/src/dune index eee6fef7..74542c39 100644 --- a/src/dune +++ b/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)