From 6bbeb650abc3a94e76d683aa47b2e46254d495d1 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Mon, 9 Jan 2006 13:50:58 +0000 Subject: [PATCH] added support for repository attributes --- helm/ocaml/getter/http_getter_env.ml | 22 +++++++--- helm/ocaml/getter/http_getter_env.mli | 5 ++- helm/ocaml/getter/http_getter_storage.ml | 50 ++++++++++++++--------- helm/ocaml/getter/http_getter_storage.mli | 4 ++ helm/ocaml/getter/http_getter_types.ml | 2 + 5 files changed, 58 insertions(+), 25 deletions(-) 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 | [] -> "" diff --git a/helm/ocaml/getter/http_getter_env.mli b/helm/ocaml/getter/http_getter_env.mli index fa90d354a..6a0f0f50a 100644 --- 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 9d1378caa..fc6f415ac 100644 --- 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 5dd997843..24fc329c9 100644 --- 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 f84ea85a9..fb0c30e83 100644 --- 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 ] + -- 2.39.2