simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-06 11:15:35 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

header field names are case insensitive

Browse source 
Reference: https://tools.ietf.org/html/rfc2616#section-4.2
This commit is contained in:
Anurag Soni 2019-12-06 19:40:41 -05:00 • committed by Simon Cruanes
parent ee1b597876
commit 057d5c9f0c
1 changed files with 21 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
src/Tiny_httpd.ml
View file

@ -301,10 +301,20 @@ end
module Headers = struct module Headers = struct
type t = (string * string) list type t = (string * string) list
let contains = List.mem_assoc let contains name headers =
let get ?(f=fun x->x) x h = try Some (List.assoc x h |> f) with Not_found -> None let name' = String.lowercase_ascii name in
let remove x h = List.filter (fun (k,_) -> k<>x) h List.exists (fun (n, _) -> name'=n) headers
let set x y h = (x,y) :: List.filter (fun (k,_) -> k<>x) h let get_exn ?(f=fun x->x) x h =
let x' = String.lowercase_ascii x in
List.assoc x' h |> f
let get ?(f=fun x -> x) x h =
try Some (get_exn ~f x h) with Not_found -> None
let remove x h =
let x' = String.lowercase_ascii x in
List.filter (fun (k,_) -> k<>x') h
let set x y h =
let x' = String.lowercase_ascii x in
(x',y) :: List.filter (fun (k,_) -> k<>x') h
let pp out l = let pp out l =
let pp_pair out (k,v) = Format.fprintf out "@[<h>%s: %s@]" k v in let pp_pair out (k,v) = Format.fprintf out "@[<h>%s: %s@]" k v in
Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_pair) l Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_pair) l
@ -320,7 +330,7 @@ module Headers = struct
try Scanf.sscanf line "%s@: %s@\r" (fun k v->k,v) try Scanf.sscanf line "%s@: %s@\r" (fun k v->k,v)
with _ -> bad_reqf 400 "invalid header line: %S" line with _ -> bad_reqf 400 "invalid header line: %S" line
in in
loop ((k,v)::acc) loop ((String.lowercase_ascii k,v)::acc)
) )
in in
loop [] loop []
@ -444,8 +454,9 @@ module Request = struct
_debug (fun k->k "got meth: %s, path %S" (Meth.to_string meth) path); _debug (fun k->k "got meth: %s, path %S" (Meth.to_string meth) path);
let headers = Headers.parse_ ~buf bs in let headers = Headers.parse_ ~buf bs in
let host = let host =
try List.assoc "Host" headers match Headers.get "Host" headers with
with Not_found -> bad_reqf 400 "No 'Host' header in request" | None -> bad_reqf 400 "No 'Host' header in request"
| Some h -> h
in in
Ok (Some {meth; host; path; headers; body=()}) Ok (Some {meth; host; path; headers; body=()})
with with
@ -459,7 +470,7 @@ module Request = struct
let parse_body_ ~tr_stream ~buf (req:byte_stream t) : byte_stream t resp_result = let parse_body_ ~tr_stream ~buf (req:byte_stream t) : byte_stream t resp_result =
try try
let size = let size =
match List.assoc "Content-Length" req.headers |> int_of_string with match Headers.get_exn "Content-Length" req.headers |> int_of_string with
| n -> n (* body of fixed size *) | n -> n (* body of fixed size *)
| exception Not_found -> 0 | exception Not_found -> 0
| exception _ -> bad_reqf 400 "invalid content-length" | exception _ -> bad_reqf 400 "invalid content-length"
@ -506,6 +517,8 @@ end
| None -> assert_failure "should parse" | None -> assert_failure "should parse"
| Some req -> | Some req ->
assert_equal (Some "coucou") (Headers.get "Host" req.Request.headers); assert_equal (Some "coucou") (Headers.get "Host" req.Request.headers);
assert_equal (Some "coucou") (Headers.get "host" req.Request.headers);
assert_equal (Some "11") (Headers.get "content-length" req.Request.headers);
assert_equal "hello" req.Request.path; assert_equal "hello" req.Request.path;
let req = Request.Internal_.parse_body req str |> Request.read_body_full in let req = Request.Internal_.parse_body req str |> Request.read_body_full in
assert_equal ~printer:(fun s->s) "salutations" req.Request.body; assert_equal ~printer:(fun s->s) "salutations" req.Request.body;