clean_cache method added

[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 501b9d8390dd8692488a0d095ed87adeffd92077..48c82f8eaae356ba2f7f5218c35600b4dc1720b0 100644 (file)
--- a/helm/http_getter/http_getter.ml
+++ b/helm/http_getter/http_getter.ml
@@ -71,16 +71,21 @@ let parse_output_format (req: Http_types.request) =
 let parse_ls_uri =
   let parse_ls_RE = Pcre.regexp "^(\\w+):(.*)$" in
   let trailing_slash_RE = Pcre.regexp "/+$" in
+  let wrong_uri uri =
+    raise (Http_getter_bad_request ("Invalid /ls baseuri: " ^ uri))
+  in
   fun (req: Http_types.request) ->
     let baseuri = req#param "baseuri" in
-    let subs =
-      Pcre.extract ~rex:parse_ls_RE
-        (Pcre.replace ~rex:trailing_slash_RE  baseuri)
-    in
-    match (subs.(1), subs.(2)) with
-    | "cic", uri -> Cic uri
-    | "theory", uri -> Theory uri
-    | _ -> raise (Http_getter_bad_request ("Invalid /ls baseuri: " ^ baseuri))
+    try
+      let subs =
+        Pcre.extract ~rex:parse_ls_RE
+          (Pcre.replace ~rex:trailing_slash_RE  baseuri)
+      in
+      (match (subs.(1), subs.(2)) with
+      | "cic", uri -> Cic uri
+      | "theory", uri -> Theory uri
+      | _ -> wrong_uri baseuri)
+    with Not_found -> wrong_uri baseuri
 ;;
 
   (* global maps, shared by all threads *)
@@ -382,6 +387,9 @@ let callback (req: Http_types.request) outchan =
             register uri url;
             return_html_msg "Register done" outchan
         | _ -> assert false)
+    | "/clean_cache" ->
+        Http_getter_cache.clean ();
+        return_html_msg "Done." outchan
     | "/update" ->
         Http_getter_env.reload (); (* reload servers list from servers file *)
         let log = update_from_all_servers () in