feat: add host field to request

src/Tiny_httpd.ml

@@ -257,12 +257,14 @@ end
 module Request = struct
   type 'body t = {
     meth: Meth.t;
+    host: string;
     headers: Headers.t;
     path: string;
     body: 'body;
   }
 
   let headers self = self.headers
+  let host self = self.host
   let meth self = self.meth
   let path self = self.path
   let body self = self.body
@@ -274,11 +276,11 @@ module Request = struct
   let set_header self k v = {self with headers=Headers.set k v self.headers}
 
   let pp_ out self : unit =
-    Format.fprintf out "{@[meth=%s;@ headers=%a;@ path=%S;@ body=?@]}"
+    Format.fprintf out "{@[meth=%s;@ host=%s;@ headers=%a;@ path=%S;@ body=?@]}"
-      (Meth.to_string self.meth) Headers.pp self.headers self.path
+      (Meth.to_string self.meth) self.host Headers.pp self.headers self.path
   let pp out self : unit =
-    Format.fprintf out "{@[meth=%s;@ headers=%a;@ path=%S;@ body=%S@]}"
+    Format.fprintf out "{@[meth=%s;@ host=%s;@ headers=%a;@ path=%S;@ body=%S@]}"
-      (Meth.to_string self.meth) Headers.pp self.headers
+      (Meth.to_string self.meth) self.host Headers.pp self.headers
       self.path self.body
 
   let read_body_exact (is:stream) (n:int) : string =
@@ -364,7 +366,11 @@ module Request = struct
       let meth = Meth.of_string meth in
       _debug (fun k->k "got meth: %s, path %S" (Meth.to_string meth) path);
       let headers = Headers.parse_ ~buf is in
-      Ok (Some {meth; path; headers; body=()})
+      let host =
+        try List.assoc "Host" headers
+        with Not_found -> bad_reqf 400 "No 'Host' header in request"
+      in
+      Ok (Some {meth; host; path; headers; body=()})
     with
     | End_of_file | Sys_error _ -> Ok None
     | Bad_req (c,s) -> Error (c,s)
@@ -658,7 +664,7 @@ let run (self:t) : (unit,_) result =
     Unix.setsockopt_optint sock Unix.SO_LINGER None;
     let inet_addr = Unix.inet_addr_of_string self.addr in
     Unix.bind sock (Unix.ADDR_INET (inet_addr, self.port));
-    Unix.listen sock 10;
+    Unix.listen sock (2 * self.sem_max_connections.Sem_.n);
     while self.running do
       (* limit concurrency *)
       Sem_.acquire 1 self.sem_max_connections;

src/Tiny_httpd.mli

@@ -98,7 +98,7 @@ type stream = {
 }
 (** A buffered stream, with a view into the current buffer (or refill if empty),
     and a function to consume [n] bytes.
-    See {!Buf_} for more details. *)
+    See {!Stream_} for more details. *)
 
 module Stream_ : sig
   type t = stream
@@ -179,11 +179,12 @@ end
 module Request : sig
   type 'body t = {
     meth: Meth.t;
+    host: string;
     headers: Headers.t;
     path: string;
     body: 'body;
   }
-(** A request with method, path, headers, and a body, sent by a client.
+  (** A request with method, path, host, headers, and a body, sent by a client.
 
       The body is polymorphic because the request goes through
       several transformations. First it has no body, as only the request
@@ -197,6 +198,7 @@ module Request : sig
   (** Pretty print the request without its body *)
 
   val headers : _ t -> Headers.t
+  (** List of headers of the request, including ["Host"] *)
 
   val get_header : ?f:(string->string) -> _ t -> string -> string option
 
@@ -204,11 +206,17 @@ module Request : sig
 
   val set_header : 'a t -> string -> string -> 'a t
 
+  val host : _ t -> string
+  (** Host field of the request. It also appears in the headers. *)
+
   val meth : _ t -> Meth.t
+  (** Method for the request. *)
 
   val path : _ t -> string
+  (** Request path. *)
 
   val body : 'b t -> 'b
+  (** Request body, possibly empty. *)
 
   val read_body_full : stream t -> string t
   (** Read the whole body into a string. Potentially blocking. *)
@@ -331,10 +339,10 @@ val create :
     *)
 
 val addr : t -> string
-(** Address on which the server listen. *)
+(** Address on which the server listens. *)
 
 val port : t -> int
-(** Port on which the server listen. *)
+(** Port on which the server listens. *)
 
 val add_decode_request_cb :
   t ->