diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index a95db2fa..eb424949 100644 --- a/src/Tiny_httpd.ml +++ b/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=?@]}" - (Meth.to_string self.meth) Headers.pp self.headers self.path + Format.fprintf out "{@[meth=%s;@ host=%s;@ headers=%a;@ path=%S;@ body=?@]}" + (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@]}" - (Meth.to_string self.meth) Headers.pp self.headers + Format.fprintf out "{@[meth=%s;@ host=%s;@ headers=%a;@ path=%S;@ body=%S@]}" + (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; diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index 0e4bd80d..318728a6 100644 --- a/src/Tiny_httpd.mli +++ b/src/Tiny_httpd.mli @@ -81,7 +81,7 @@ end (** {2 Generic stream of data} - Streams are used to represent a series of bytes that can arrive progressively. + Streams are used to represent a series of bytes that can arrive progressively. For example, an uploaded file will be sent as a series of chunks. *) type stream = { @@ -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,16 +179,17 @@ 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 - and headers are read; then it has a stream body; then the body might be - entirely read as a string via {!read_body_full}. *) + The body is polymorphic because the request goes through + several transformations. First it has no body, as only the request + and headers are read; then it has a stream body; then the body might be + entirely read as a string via {!read_body_full}. *) val pp : Format.formatter -> string t -> unit (** Pretty print the request and its body *) @@ -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 ->