X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fgetter%2Fhttp_getter_env.ml;h=7a3891b98c63a803606b8d6c44867f558dff58d6;hb=7be6aeb94aa8da17732511a4844bd108976f947f;hp=764416cea0c5506cb6a71693887c1748b6d60b1d;hpb=aa0d60227b785da3355b31519ba11cb4fbd2c925;p=helm.git

diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml
index 764416cea..7a3891b98 100644
--- a/helm/ocaml/getter/http_getter_env.ml
+++ b/helm/ocaml/getter/http_getter_env.ml
@@ -35,7 +35,7 @@ open Http_getter_misc
 
 let version = Http_getter_const.version
 
-let prefix_RE = Pcre.regexp "^\\s*([^\\s]+)\\s+([^\\s]+)\\s*$"
+let prefix_RE = Pcre.regexp "^\\s*([^\\s]+)\\s+([^\\s]+)\\s*(.*)$"
 
 let cache_dir  = lazy (normalize_dir (Helm_registry.get "getter.cache_dir"))
 let dtd_dir = lazy (normalize_dir (Helm_registry.get "getter.dtd_dir"))
@@ -52,13 +52,24 @@ let dtd_base_urls  = lazy (
 let port            = lazy (
   Helm_registry.get_opt_default Helm_registry.int ~default:58081 "getter.port")
 
+let parse_prefix_attrs s =
+  List.fold_right
+    (fun s acc ->
+      match s with
+      | "ro" -> `Read_only :: acc
+      | "legacy" -> `Legacy :: acc
+      | s ->
+          Http_getter_logger.log ("ignoring unknown attribute: " ^ s);
+          acc)
+    (Pcre.split s) []
+
 let prefixes = lazy (
   let prefixes = Helm_registry.get_list Helm_registry.string "getter.prefix" in
   List.fold_left
     (fun acc prefix ->
       let subs = Pcre.extract ~rex:prefix_RE prefix in
       try
-        (subs.(1), subs.(2)) :: acc
+        (subs.(1), (subs.(2), parse_prefix_attrs subs.(3))) :: acc
       with Invalid_argument _ ->
         Http_getter_logger.log ("skipping invalid prefix: " ^ prefix);
         acc)
@@ -73,9 +84,10 @@ let my_own_url =
     host (if port = 80 then "" else (sprintf ":%d" port)))
 
 let env_to_string () =
-  let pp_prefix (uri_prefix, url_prefix) =
-    "    " ^ uri_prefix ^ " -- " ^ url_prefix
-  in
+  let pp_attr = function `Read_only -> "ro" | `Legacy -> "legacy" in
+  let pp_prefix (uri_prefix, (url_prefix, attrs)) =
+    sprintf "    %s -> %s [%s]" uri_prefix url_prefix
+      (String.concat "," (List.map pp_attr attrs)) in
   let pp_prefixes prefixes =
     match prefixes with
     | [] -> ""