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

diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml
index a73710632..7a3891b98 100644
--- a/helm/ocaml/getter/http_getter_env.ml
+++ b/helm/ocaml/getter/http_getter_env.ml
@@ -26,6 +26,8 @@
  *  http://helm.cs.unibo.it/
  *)
 
+(* $Id$ *)
+
 open Printf
 
 open Http_getter_types
@@ -33,7 +35,7 @@ open Http_getter_misc
 
 let version = Http_getter_const.version
 
-let blanks_RE = Pcre.regexp "\\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"))
@@ -50,22 +52,30 @@ 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 ->
-      match Pcre.split ~rex:blanks_RE prefix with
-      | [uri_prefix; url_prefix] -> (uri_prefix, url_prefix) :: acc
-      | _ ->
-          Http_getter_logger.log ("skipping invalid prefix: " ^ prefix);
-          acc)
+      let subs = Pcre.extract ~rex:prefix_RE prefix in
+      try
+        (subs.(1), (subs.(2), parse_prefix_attrs subs.(3))) :: acc
+      with Invalid_argument _ ->
+        Http_getter_logger.log ("skipping invalid prefix: " ^ prefix);
+        acc)
     [] prefixes)
 
-let host =
-  lazy
-    (let buf = Buffer.create 20 in
-    Shell.call ~stdout:(Shell.to_buffer buf) [Shell.cmd "hostname" ["-f"]];
-    Pcre.replace ~pat:"\n+$" (Buffer.contents buf))
+let host = lazy (Http_getter_misc.backtick "hostname -f")
 
 let my_own_url =
   lazy
@@ -74,11 +84,14 @@ 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
     | [] -> ""
-    | l -> "\n" ^ String.concat "\n" (List.map pp_prefix l) ^ "\n"
+    | l -> "\n" ^ String.concat "\n" (List.map pp_prefix l)
   in
   sprintf
 "HTTP Getter %s