basic fixes

src/core/headers.ml

@@ -25,6 +25,8 @@ let equal_name_ (s1 : string) (s2 : string) : bool =
 let contains name headers =
   List.exists (fun (n, _) -> equal_name_ name n) headers
 
+let list_contains_nocase_ name l = List.exists (equal_name_ name) l
+
 let rec get_exn ?(f = fun x -> x) x h =
   match h with
   | [] -> raise Not_found
@@ -83,6 +85,11 @@ let parse_line_ (line : string) : _ result =
     Ok (k, v)
   with Failure msg -> Error msg
 
+open struct
+  let nodup_ = [ "content-length"; "host"; "transfer-encoding" ]
+  let is_nodup_ k = list_contains_nocase_ k nodup_
+end
+
 let parse_ ~(buf : Buf.t) ?(max_headers = 100) ?(max_header_size = 16 * 1024)
     ?(max_total_size = 256 * 1024) (bs : IO.Input.t) : t =
   let rec loop acc count total_size =
@@ -106,6 +113,18 @@ let parse_ ~(buf : Buf.t) ?(max_headers = 100) ?(max_header_size = 16 * 1024)
         | Error msg ->
           bad_reqf 400 "invalid header line: %s\nline is: %S" msg line
       in
+
+      if is_nodup_ k && contains k acc then
+        bad_reqf 400 "header %S is duplicated" k;
+
       loop ((k, v) :: acc) (count + 1) (total_size + line_len)
   in
-  loop [] 0 0
+
+  let headers = loop [] 0 0 in
+  if
+    contains "content-length" headers
+    && get "transfer-encoding" headers = Some "chunked"
+  then
+    bad_reqf 400 "cannot specify both chunked encoding and content-length";
+
+  headers

src/core/headers.mli

@@ -43,5 +43,6 @@ val parse_ :
   t
 
 val parse_line_ : string -> (string * string, string) result
+val list_contains_nocase_ : string -> string list -> bool
 
 (**/*)

src/core/request.ml

@@ -63,12 +63,13 @@ let pp_with ?(mask_header = fun _ -> false)
       Format.fprintf out "<hidden>"
   in
 
-  let headers_to_mask = List.rev_map String.lowercase_ascii headers_to_mask in
   (* hide some headers *)
   let headers =
     List.map
       (fun (k, v) ->
-        let hidden = List.mem k headers_to_mask || mask_header k in
+        let hidden =
+          Headers.list_contains_nocase_ k headers_to_mask || mask_header k
+        in
         if hidden then
           k, "<hidden>"
         else

src/core/response.ml

@@ -79,14 +79,15 @@ let default_pp_body_ out = function
   | `Void -> ()
 
 let pp_with ?(mask_header = fun _ -> false)
-    ?(headers_to_mask = [ "set-cookie" ]) ?(pp_body = default_pp_body_) () out
-    self : unit =
-  let headers_to_mask = List.rev_map String.lowercase_ascii headers_to_mask in
+    ?(headers_to_mask = [ "set-cookie"; "authorization" ])
+    ?(pp_body = default_pp_body_) () out self : unit =
   (* hide some headers *)
   let headers =
     List.map
       (fun (k, v) ->
-        let hidden = List.mem k headers_to_mask || mask_header k in
+        let hidden =
+          Headers.list_contains_nocase_ k headers_to_mask || mask_header k
+        in
         if hidden then
           k, "<hidden>"
         else

src/core/response.mli

@@ -122,7 +122,8 @@ val pp_with :
       header's value is masked. The presence of the header is still printed.
       Default [fun _ -> false].
     @param headers_to_mask
-      a list of headers masked by default. Default is ["set-cookie"].
+      a list of headers masked by default. Default is
+      ["set-cookie"; "authorization"].
     @param pp_body
       body printer (default fully prints String bodies, but omits stream bodies)
     @since 0.18 *)

src/core/server.mli

@@ -187,7 +187,8 @@ val add_route_handler :
       its content is too big, or for some permission error). See the
       {!http_of_dir} program for an example of how to use [accept] to filter
       uploads that are too large before the upload even starts. The default
-      always returns [Ok()], i.e. it accepts all requests.
+      always returns [Ok()], i.e. it accepts all requests. Beware that
+      {!Request.path} is the full URL path and needs decoding.
 
     @since 0.6 *)
 

src/ws/tiny_httpd_ws.mli

@@ -59,8 +59,7 @@ val add_route_handler :
       Cross-Site WebSocket Hijacking (CSWSH).
     @param with_lock
       if provided, use this to synchronize writes between the frame reader
-      (replies "pong" to "ping") and the handler emitting writes. since
-      0.21. *)
+      (replies "pong" to "ping") and the handler emitting writes. since 0.21. *)
 
 (**/**)