Merge pull request #31 from c-cube/keepalive-handle

handle keepalive, or its absence

src/Tiny_httpd.ml

@@ -363,6 +363,7 @@ module Request = struct
     meth: Meth.t;
     host: string;
     headers: Headers.t;
+    http_version: int*int;
     path: string;
     path_components: string list;
     query: (string*string) list;
@@ -386,6 +387,13 @@ module Request = struct
   let update_headers f self = {self with headers=f self.headers}
   let set_body b self = {self with body=b}
 
+  (** Should we close the connection after this request? *)
+  let close_after_req (self:_ t) : bool =
+    match self.http_version with
+    | 1, 1 -> get_header self "connection" =Some"close"
+    | 1, 0 -> not (get_header self "connection"=Some"keep-alive")
+    | _ -> false
+
   let pp_comp_ out comp =
     Format.fprintf out "[%s]"
       (String.concat ";" @@ List.map (Printf.sprintf "%S") comp)
@@ -486,11 +494,11 @@ module Request = struct
     try
       let line = Byte_stream.read_line ~buf bs in
       let start_time = Unix.gettimeofday () in
-      let meth, path =
+      let meth, path, version =
         try
-          let m, p, v = Scanf.sscanf line "%s %s HTTP/1.%d\r" (fun x y z->x,y,z) in
-          if v != 0 && v != 1 then raise Exit;
-          m, p
+          let meth, path, version = Scanf.sscanf line "%s %s HTTP/1.%d\r" (fun x y z->x,y,z) in
+          if version != 0 && version != 1 then raise Exit;
+          meth, path, version
         with _ ->
           _debug (fun k->k "invalid request line: `%s`" line);
           raise (Bad_req (400, "Invalid request line"))
@@ -510,8 +518,11 @@ module Request = struct
         | Ok l -> l
         | Error e -> bad_reqf 400 "invalid query: %s" e
       in
-      Ok (Some {meth; query; host; path; path_components;
-                headers; body=(); start_time; })
+      let req = {
+        meth; query; host; path; path_components;
+        headers; http_version=(1, version); body=(); start_time;
+      } in
+      Ok (Some req)
     with
     | End_of_file | Sys_error _ -> Ok None
     | Bad_req (c,s) -> Error (c,s)
@@ -1016,8 +1027,8 @@ let find_map f l =
   in aux f l
 
 let handle_client_ (self:t) (client_sock:Unix.file_descr) : unit =
-  let _ = Unix.(setsockopt_float client_sock SO_RCVTIMEO self.timeout) in
-  let _ = Unix.(setsockopt_float client_sock SO_SNDTIMEO self.timeout) in
+  Unix.(setsockopt_float client_sock SO_RCVTIMEO self.timeout);
+  Unix.(setsockopt_float client_sock SO_SNDTIMEO self.timeout);
   let ic = Unix.in_channel_of_descr client_sock in
   let oc = Unix.out_channel_of_descr client_sock in
   let buf = Buf_.create ~size:self.buf_size () in
@@ -1041,6 +1052,8 @@ let handle_client_ (self:t) (client_sock:Unix.file_descr) : unit =
     | Ok (Some req) ->
       _debug (fun k->k "req: %s" (Format.asprintf "@[%a@]" Request.pp_ req));
 
+      if Request.close_after_req req then continue := false;
+
       try
         (* is there a handler for this path? *)
         let handler =
@@ -1076,7 +1089,10 @@ let handle_client_ (self:t) (client_sock:Unix.file_descr) : unit =
 
         (* how to reply *)
         let resp r =
-          try Response.output_ oc r
+          try
+            if Headers.get "connection" r.Response.headers = Some"close" then
+              continue := false;
+            Response.output_ oc r
           with Sys_error _ -> continue := false
         in
 

src/Tiny_httpd.mli

@@ -219,10 +219,11 @@ end
     Requests are sent by a client, e.g. a web browser or cURL. *)
 
 module Request : sig
-  type 'body t = {
+  type 'body t = private {
     meth: Meth.t;
     host: string;
     headers: Headers.t;
+    http_version: int*int;
     path: string;
     path_components: string list;
     query: (string*string) list;