Commits

Anonymous committed 360052b

http/1.1; using I.enumpart*; debug prints

  • Participants
  • Parent commits 779668a

Comments (0)

Files changed (3)

src/amall_http.ml

 
 value (it_http :
   (request -> I.iteratee char 'a) ->
-  (I.iteratee char (request * 'a))
+  I.iteratee char (I.iteratee char (request * 'a))
 )
 process_request =
   let fail r = I.throw_err & Bad_request r in
     ; rq_uri = rq_uri
     }
     >>= fun request ->
-    let ret = I.mapI (fun res -> (request, res)) in
+    let ret = I.mapI
+      (fun res ->
+        let () = dbg "got result from body iteratee" in
+        (request, res)
+      )
+    in
     let user_it = process_request request in
     if not & request_has_message_body request
     then
-      let () = dbg "request has no body, sending EOF to user's iteratee" in
-      ret & it_eof user_it
+      let () = dbg "request has no body" in
+      I.return (ret user_it)
     else
       let () = dbg "request has body" in
       (
       match bounds with
       [ `Till_eof ->
           let () = dbg "bounds: till eof" in
-          ret & user_it
+          I.return & ret user_it
       | `Content_length len ->
           let () = dbg "bounds: Content_length %i" len in
-          ret & I.joinI & I.take len user_it
+          I.take len user_it >>= fun it ->
+          I.return & ret it
       ]
 ;
 

src/amall_http_server.ml

 
 (**********************************************************)
 
-(* гарантируется, что всё мероприятие начнётся с вызова it_proc_req,
-   затем будет дано хоть что-то итерату, возвращённому функцией
-   (возможно ошибка или просто конец потока; в случае наличия тела
-   запроса будет дано тело).
- *)
 
-value io_http_server_func (it_proc_req : http_server_func) inch
-: IO.m (request * response) =
-
-  I.enum_fd inch (H.it_http it_proc_req) >>% fun it ->
-  I.run it
-;
-
-
-(*
-        >>= fun (request, response) ->
-      dump_chars_chunks "after body" >>= fun () ->
-      I.return r
-    )
-  )
-;
-*)
+value dbg fmt = Printf.ksprintf (Printf.printf "hs: %s\n%!") fmt;
 
 
 value http_server_func userfunc (inch, outch) =
   IO.run_and_ignore_result
      (IO.catch
         (fun () ->
-           io_http_server_func userfunc inch >>% fun (request, resp) ->
+           let do_close () =
+             IO.close_in inch >>% fun () ->
+             IO.close_out outch
+           in
+           let it_req = H.it_http userfunc in
+           I.enumpart_readchars
+             ~buffer_size:4096
+             ~read_func:IO.read_into
+             inch
+             I.Sl.empty
+             it_req
+           >>% loop
+           where rec loop (it, sl_l, opt_enp) =
+             let () = dbg "hs: entered loop" in
+             match opt_enp with
+             [ I.EP_None -> do_close ()
+             | I.EP_Some cont ->
+                 let () = dbg "got cont" in
 
-           let is_head = (request.rq_method = `HEAD) in
-           H.output_response ~is_head outch resp >>% fun () ->
-           (* IO.flush outch -- если не будет close *)
+    match it with
+    [ I.IE_cont (Some e) _ ->
+      let () = dbg "cont: error %S" (Printexc.to_string e) in
+      do_close ()
+    | I.IE_cont None _ ->
+        let () = dbg "cont: cont" in
+        failwith "cont-cont1111"
+    | I.IE_done it -> I.run it >>% fun (request, resp) ->
+    let () = dbg "hsf: got req/resp" in
 
-           IO.close_in inch >>% fun () ->
-           IO.close_out outch
+    let is_head = (request.rq_method = `HEAD) in
+    H.output_response ~is_head outch resp >>% fun () ->
+
+    let need_to_close =
+      (List.mem `Close request.rq_headers.connection) ||
+      (List.exists (fun (hk, hv) -> hk = "Connection" && hv = "close")
+         resp.rs_headers.rs_all)
+    in
+      if need_to_close
+      then
+        do_close ()
+      else
+        IO.flush outch >>% fun () ->
+        let sl = Lazy.force sl_l in
+        cont sl it_req >>% loop
+
+
+             ]
+   ]
         )
         (fun e ->
           ( Printf.eprintf "amall http: exception: %s\n%!" &
       string ->
       S.t char -> int -> option (It_IO.m (iteratee char unit * sl char));
     value it_last : int -> iteratee 'a (list 'a);
+
+    type enumpart 'el 'a = sl 'el -> iteratee 'el 'a ->
+      It_IO.m (iteratee 'el 'a * Lazy.t (sl 'el) * opt_enumpart 'el 'a)
+    and opt_enumpart 'el 'a =
+      [ EP_None
+      | EP_Some of enumpart 'el 'a
+      ]
+    ;
+    value enumpart_readchars
+     :
+       ~buffer_size:int ->
+       ~read_func:('ch -> string -> int (*ofs*) -> int (*len*)
+                   -> It_IO.m int
+                  ) ->
+       'ch ->
+       enumpart char 'a
+    ;
+
   end
 ;