added support for repository attributes

diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml
index 764416cea0c5506cb6a71693887c1748b6d60b1d..7a3891b98c63a803606b8d6c44867f558dff58d6 100644 (file)
--- 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
     | [] -> ""

diff --git a/helm/ocaml/getter/http_getter_env.mli b/helm/ocaml/getter/http_getter_env.mli
index fa90d354a8b6c7d69518402f51c444a3dcf94420..6a0f0f50a31cf09b2ab226dd8c554069d6d8f548 100644 (file)
--- a/helm/ocaml/getter/http_getter_env.mli
+++ b/helm/ocaml/getter/http_getter_env.mli
@@ -23,6 +23,8 @@
  * http://helm.cs.unibo.it/
  *)
 
+open Http_getter_types
+
   (** {2 general information} *)
 
 val version       : string        (* getter version *)
@@ -34,7 +36,8 @@ val cache_dir     : string lazy_t         (* cache root *)
 val dtd_dir       : string lazy_t         (* DTDs' root directory *)
 val port          : int lazy_t            (* port on which getter listens *)
 val dtd_base_urls : string list lazy_t    (* base URLs for document patching *)
-val prefixes      : (string * string) list lazy_t (* prefix map uri -> url *)
+val prefixes      : (string * (string * prefix_attr list)) list lazy_t
+                                          (* prefix map uri -> url + attrs *)
 
   (* {2 derived data} *)
 

diff --git a/helm/ocaml/getter/http_getter_storage.ml b/helm/ocaml/getter/http_getter_storage.ml
index 9d1378caaad8b3c98881c25cd13f773b02f548fc..fc6f415ac31ce68c0897113c0db026e018e6bb40 100644 (file)
--- a/helm/ocaml/getter/http_getter_storage.ml
+++ b/helm/ocaml/getter/http_getter_storage.ml
@@ -59,38 +59,50 @@ let path_of_file_url url =
 let prefix_map = lazy (
   let map_w_length =
     List.map
-      (fun (uri_prefix, url_prefix) ->
+      (fun (uri_prefix, (url_prefix, attrs)) ->
         let uri_prefix = normalize_dir uri_prefix in
         let url_prefix = normalize_dir url_prefix in
         let regexp = Pcre.regexp ("^(" ^ Pcre.quote uri_prefix ^ ")") in
-        (regexp, String.length uri_prefix, uri_prefix, url_prefix))
+        (regexp, String.length uri_prefix, uri_prefix, url_prefix, attrs))
       (Lazy.force Http_getter_env.prefixes)
   in
-  let decreasing_length (_, len1, _, _) (_, len2, _, _) = compare len2 len1 in
+  let decreasing_length (_, len1, _, _, _) (_, len2, _, _, _) =
+    compare len2 len1 in
   List.map
-    (fun (regexp, len, uri_prefix, url_prefix) ->
-      (regexp, strip_trailing_slash uri_prefix, url_prefix))
+    (fun (regexp, len, uri_prefix, url_prefix, attrs) ->
+      (regexp, strip_trailing_slash uri_prefix, url_prefix, attrs))
     (List.fast_sort decreasing_length map_w_length))
 
-let resolve_prefix uri =
+let lookup uri =
   let matches =
-    List.filter (fun (rex, _, _) -> Pcre.pmatch ~rex uri)
-      (Lazy.force prefix_map)
-  in
-  match matches with
-  | (rex, _, url_prefix) :: _ -> Pcre.replace_first ~rex ~templ:url_prefix uri
-  | [] -> raise (Unresolvable_URI uri)
+    List.filter (fun (rex, _, _, _) -> Pcre.pmatch ~rex uri)
+      (Lazy.force prefix_map) in
+  if matches = [] then raise (Unresolvable_URI uri);
+  matches
+
+let resolve_prefix uri =
+  match lookup uri with
+  | (rex, _, url_prefix, _) :: _ ->
+      Pcre.replace_first ~rex ~templ:url_prefix uri
+  | [] -> assert false
 
 let resolve_prefixes uri =
-  let matches =
-    List.filter (fun (rex, _, _) -> Pcre.pmatch ~rex uri)
-      (Lazy.force prefix_map)
-  in
-  if matches = [] then raise (Unresolvable_URI uri);
+  let matches = lookup uri in
   List.map
-    (fun (rex, _, url_prefix) -> Pcre.replace_first ~rex ~templ:url_prefix uri)
+    (fun (rex, _, url_prefix, _) ->
+      Pcre.replace_first ~rex ~templ:url_prefix uri)
     matches
 
+let get_attrs uri =
+  match lookup uri with
+  | (_, _, _, attrs) :: _ -> attrs
+  | [] -> assert false
+
+let is_legacy uri = List.exists ((=) `Legacy) (get_attrs uri)
+
+let is_read_only uri =
+  is_legacy uri || List.exists ((=) `Read_only) (get_attrs uri)
+
 let exists_http _ url =
   Http_getter_wget.exists (url ^ gz_suffix) || Http_getter_wget.exists url
 
@@ -249,7 +261,7 @@ let ls uri_prefix =
 (*   prerr_endline ("Http_getter_storage.ls " ^ uri_prefix); *)
   let direct_results = ls_single uri_prefix in
   List.fold_left
-    (fun results (_, uri_prefix', _) ->
+    (fun results (_, uri_prefix', _, _) ->
       if Filename.dirname uri_prefix' = strip_trailing_slash uri_prefix then
         (Filename.basename uri_prefix' ^ "/") :: results
       else

diff --git a/helm/ocaml/getter/http_getter_storage.mli b/helm/ocaml/getter/http_getter_storage.mli
index 5dd997843f1c1486be490f8bd02a7a428b2c7f25..24fc329c9f03316218de44352e7217007b425991 100644 (file)
--- a/helm/ocaml/getter/http_getter_storage.mli
+++ b/helm/ocaml/getter/http_getter_storage.mli
@@ -63,5 +63,9 @@ val remove: string -> unit
 val exists: string -> bool
 val resolve: string -> string
 
+(* val get_attrs: string -> Http_getter_types.prefix_attr list *)
+val is_read_only: string -> bool
+val is_legacy: string -> bool
+
 val clean_cache: unit -> unit
 

diff --git a/helm/ocaml/getter/http_getter_types.ml b/helm/ocaml/getter/http_getter_types.ml
index f84ea85a934979ce5bc09fb3e2acd36f3ed50512..fb0c30e83e18a54a9c9987a491906e7a21eda9e1 100644 (file)
--- a/helm/ocaml/getter/http_getter_types.ml
+++ b/helm/ocaml/getter/http_getter_types.ml
@@ -68,3 +68,5 @@ type uri =
 
 module StringSet = Set.Make (String)
 
+type prefix_attr = [ `Read_only | `Legacy ]
+