catch CTRL-C and save maps before quitting

[helm.git] / helm / http_getter / http_getter.ml

diff --git a/helm/http_getter/http_getter.ml b/helm/http_getter/http_getter.ml
index c46a793268911ea98ab702dc7dfb48ef159f3691..7eb8deae4998047b59b6adb181a0488e143ed194 100644 (file)
--- a/helm/http_getter/http_getter.ml
+++ b/helm/http_getter/http_getter.ml
@@ -83,6 +83,7 @@ let xml_map = new Http_getter_map.map Http_getter_env.xml_dbm in
 let rdf_map = new Http_getter_map.map Http_getter_env.rdf_dbm in
 let xsl_map = new Http_getter_map.map Http_getter_env.xsl_dbm in
 
+let save_maps () = xml_map#close; rdf_map#close; xsl_map#close in
 let map_of_uri = function
   | uri when is_xml_uri uri -> xml_map
   | uri when is_rdf_uri uri -> rdf_map
@@ -239,7 +240,7 @@ let update_from_server logmsg server_url = (* use global maps *)
         Pcre.replace ~pat:"^helm:rdf.*//theory:" ~templ:server_url uri
     | uri -> raise (Http_getter_invalid_URI uri)
   in
-  let log = ref ("Processing server: " ^ server_url ^ "<br />\n") in
+  let log = ref (logmsg ^ "Processing server: " ^ server_url ^ "<br />\n") in
   let (xml_index, rdf_index, xsl_index) =
     (* TODO keeps index in memory, is better to keep them on temp files? *)
     (http_get (server_url ^ "/" ^ Http_getter_env.xml_index),
@@ -328,9 +329,7 @@ let callback (req: Http_types.request) outchan =
             return_html_msg "Register done" outchan
         | _ -> assert false)
     | "/update" ->
-        (xml_map#clear;
-        rdf_map#clear;
-        xsl_map#clear;
+        (xml_map#clear; rdf_map#clear; xsl_map#clear;
         let log =
           List.fold_left
             update_from_server
@@ -338,6 +337,7 @@ let callback (req: Http_types.request) outchan =
               (* reverse order: 1st server is the most important one *)
             (List.rev Http_getter_env.servers)
         in
+        xml_map#sync; rdf_map#sync; xsl_map#sync;
         return_html_msg log outchan)
     | "/getalluris" ->
         return_all_xml_uris
@@ -362,7 +362,8 @@ let callback (req: Http_types.request) outchan =
     | "/getempty" ->
         Http_daemon.respond ~body:Http_getter_const.empty_xml outchan
     | invalid_request ->
-        Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
+        Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
+    debug_print "Done!"
   with
   | Http_types.Param_not_found attr_name ->
       return_400 (sprintf "Parameter '%s' is missing" attr_name) outchan
@@ -378,6 +379,10 @@ in
 Http_getter_env.dump_env ();
 flush stdout;
 Unix.putenv "http_proxy" "";
-Http_daemon.start'
-  ~timeout:None ~port:Http_getter_env.port ~mode:`Thread callback
+Sys.catch_break true;
+try
+  Http_daemon.start'
+    ~timeout:None ~port:Http_getter_env.port ~mode:`Thread callback
+with Sys.Break ->
+  save_maps ()