X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2FDEVEL%2Focaml-http%2Fhttp_daemon.ml;h=f7c8495de2c5d747cb0872d19a18524333ce6255;hb=bbf85ddcdfe0809fee0c6ca9812ce0da30c238af;hp=2457c8a7337587336cda7603e4086f7d7ea47a15;hpb=c94c28d6675c7ff4608b065fdb765cdd40826088;p=helm.git diff --git a/helm/software/DEVEL/ocaml-http/http_daemon.ml b/helm/software/DEVEL/ocaml-http/http_daemon.ml index 2457c8a73..f7c8495de 100644 --- a/helm/software/DEVEL/ocaml-http/http_daemon.ml +++ b/helm/software/DEVEL/ocaml-http/http_daemon.ml @@ -36,6 +36,7 @@ let send_raw ~data outchan = let send_CRLF = send_raw ~data:crlf let send_header ~header ~value = + let header = String.lowercase header in Http_parser_sanity.heal_header (header, value); send_raw ~data:(header ^ ": " ^ value ^ crlf) @@ -303,7 +304,15 @@ let invoke_callback req spec outchan = let callback req outchan = if spec.auto_close then Http_misc.finally - (fun () -> try close_out outchan with Sys_error _ -> ()) + (fun () -> + (* XXX the pair flush + shutdown is a temporary solution since double + * close on a socket make ocaml 3.09.2 segfault (see + * http://caml.inria.fr/mantis/view.php?id=4059). The right thing to + * do is probably invoke try_close outchan here *) + flush outchan; + try + Unix.shutdown (Unix.descr_of_out_channel outchan) Unix.SHUTDOWN_ALL + with Unix.Unix_error(_, "shutdown", "") -> ()) (fun () -> spec.callback req outchan) () else spec.callback req outchan in @@ -454,6 +463,7 @@ let daemon_spec { default_spec with address = address; auth = auth; + auto_close = auto_close; callback = callback; mode = mode; port = port;