]> matita.cs.unibo.it Git - helm.git/blobdiff - daemons/http_getter/main.ml
...
[helm.git] / daemons / http_getter / main.ml
index 572e9de1b932419203400a630186111002fec218..f708dc529f54f9f76564d55dcd031a5b7ebdc05e 100644 (file)
@@ -147,7 +147,7 @@ let return_all_xml_uris fmt outchan =
    | `Xml -> return_all_uris "alluris" uris outchan
 
 let return_ls regexp fmt outchan =
-  let ls_items = Http_getter.ls regexp in
+  let ls_items = Http_getter.ls ~local:false regexp in
   let buf = Buffer.create 10240 in
   (match fmt with
   | `Text ->
@@ -194,7 +194,8 @@ let return_help outchan = return_html_raw (Http_getter.help ()) outchan
 let return_resolve writable uri outchan =
   try
     return_xml_raw
-      (sprintf "<url value=\"%s\" />\n" (Http_getter.resolve ~writable uri))
+      (sprintf "<url value=\"%s\" />\n" 
+        (Http_getter.resolve ~writable ~local:false uri))
       outchan
   with
   | Unresolvable_URI _ -> return_xml_raw "<unresolvable />\n" outchan
@@ -263,7 +264,7 @@ let respond_xslt patch_xslt xslt_name outchan =
 
   (* thread action *)
 
-let callback ((req: Http_types.request), outchan) =
+let callback (req: Http_types.request) outchan =
   try
     Http_getter_logger.log ("Connection from " ^ req#clientAddr);
     Http_getter_logger.log ("Received request: " ^ req#uri);
@@ -273,7 +274,9 @@ let callback ((req: Http_types.request), outchan) =
         let uri = req#param "uri" in
         let fname = Http_getter.getxml uri in (* local name, in cache *)
         (* remote name *)
-        let remote_name = Http_getter.resolve ~writable:false uri in 
+        let remote_name = 
+          Http_getter.resolve ~writable:false ~local:false uri 
+        in 
         let src_enc = if is_gzip fname then `Gzipped else `Normal in
         let enc = parse_enc req in
         let fname, cleanup = convert_file ~from_enc:src_enc ~to_enc:enc fname in
@@ -334,11 +337,6 @@ let callback ((req: Http_types.request), outchan) =
           log_failure msg;
           return_html_error ("uncaught_exception", msg) msg outchan)
 
-let callback req outchan =
-  HExtlib.finally
-    (fun () -> try close_out outchan with Sys_error _ -> ())
-    callback (req, outchan)
-
 let batch_update = ref false      
 
 let args = [ ]
@@ -354,6 +352,7 @@ let main () =
   let d_spec = Http_daemon.daemon_spec
      ~mode:`Thread ~timeout:(Some 600) 
      ~port:(Lazy.force Http_getter_env.port)
+     ~auto_close:true
      ~callback:callback ()
   in
   try