X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Focaml-http%2Fhttp_daemon.ml;h=732a5b31d1e7f77f88b2141502f604d424dcd06a;hb=d4993a3584bd83a87f642e8766eb86c0a24b682b;hp=56596a920d730cd620fbfcd8914cb4d96a344c3a;hpb=8c529f71e51025d3e827475f9e224bd0e07190eb;p=helm.git

diff --git a/helm/DEVEL/ocaml-http/http_daemon.ml b/helm/DEVEL/ocaml-http/http_daemon.ml
index 56596a920..732a5b31d 100644
--- a/helm/DEVEL/ocaml-http/http_daemon.ml
+++ b/helm/DEVEL/ocaml-http/http_daemon.ml
@@ -340,16 +340,18 @@ let safe_parse_request = wrap_parse_request_w_safety parse_request
   (* as above but for OO version (Http_parser.parse_request') *)
 let safe_parse_request' = wrap_parse_request_w_safety parse_request'
 
+let chdir_to_document_root = function (* chdir to document root *)
+  | Some dir -> Sys.chdir dir
+  | None -> ()
+
   (* TODO support also chroot to 'root', not only chdir *)
   (* curried request *)
 let start
   ?(addr = default_addr) ?(port = default_port)
   ?(timeout = Some default_timeout) ?(mode = default_mode) ?root callback
   =
-  (match root with  (* chdir to document root *)
-  | Some dir -> Sys.chdir dir
-  | None -> ());
-  let sockaddr = Http_misc.build_sockaddr ~addr ~port in
+  chdir_to_document_root root;
+  let sockaddr = Http_misc.build_sockaddr (addr, port) in
   let daemon_callback inchan outchan =
     try
       let (path, parameters) = safe_parse_request inchan outchan in
@@ -368,7 +370,8 @@ let start'
   ?(timeout = Some default_timeout) ?(mode = default_mode) ?root callback
   =
   let wrapper path params outchan =
-    let req = new Http_request.request ~path ~params in
+    let clisockaddr = Http_misc.peername_of_out_channel outchan in
+    let req = new Http_request.request ~path ~params ~clisockaddr in
     callback req outchan
   in
   match root with
@@ -424,7 +427,7 @@ class daemon ?(addr = "0.0.0.0") ?(port = 80) () =
   object (self)
 
     val suck =
-      Http_tcp_server.init_socket (Http_misc.build_sockaddr ~addr ~port)
+      Http_tcp_server.init_socket (Http_misc.build_sockaddr (addr, port))
 
     method accept =
       let (cli_suck, cli_sockaddr) = Unix.accept suck in  (* may block *)