fix

[helm.git] / helm / ocaml / getter / http_getter_env.ml

diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml
index 74e32c22f265ceabd16d0b2affb8a08148da573b..7a3891b98c63a803606b8d6c44867f558dff58d6 100644 (file)
--- 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 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"))
@@ -50,23 +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 ->
       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)
     [] 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
@@ -75,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
     | [] -> ""