X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fgetter%2Fhttp_getter_env.ml;h=c12709dcc562c652d41e09baac1547f44b033072;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=623be8aef0c9630841ac53ca78679370b33f84a1;hpb=902fa65340811cb467f9b929a1926445414ec336;p=helm.git diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml index 623be8aef..c12709dcc 100644 --- a/helm/ocaml/getter/http_getter_env.ml +++ b/helm/ocaml/getter/http_getter_env.ml @@ -27,61 +27,42 @@ *) open Printf -open Pxp_document -open Pxp_types -open Pxp_yacc open Http_getter_types +open Http_getter_misc let version = Http_getter_const.version -let servers_file = lazy (Helm_registry.get "getter.servers_file") -let cic_dbm = lazy (Helm_registry.get "getter.cic_dbm") -let nuprl_dbm = lazy (Helm_registry.get "getter.nuprl_dbm") -let rdf_dbm = lazy (Helm_registry.get "getter.rdf_dbm") -let xsl_dbm = lazy (Helm_registry.get "getter.xsl_dbm") -let xml_index = lazy (Helm_registry.get "getter.xml_indexname") -let rdf_index = lazy (Helm_registry.get "getter.rdf_indexname") -let xsl_index = lazy (Helm_registry.get "getter.xsl_indexname") -let cic_dir = lazy (Helm_registry.get "getter.cic_dir") -let nuprl_dir = lazy (Helm_registry.get "getter.nuprl_dir") -let rdf_dir = lazy (Helm_registry.get "getter.rdf_dir") -let dtd_dir = lazy (Helm_registry.get "getter.dtd_dir") -let dtd_base_url = lazy (Helm_registry.get "getter.dtd_base_url") -let port = lazy (Helm_registry.get_int "getter.port") - -let _servers = ref None - -let servers = - lazy - (match !_servers with - | None -> failwith "Getter not yet initialized: servers not available" - | Some servers -> servers) - -let load_servers () = - let pos = ref (-1) in - List.rev (Http_getter_misc.fold_file - (fun line servers -> - if Http_getter_misc.is_blank_line line then - servers - else - (incr pos; (!pos, line) :: servers)) - [] - (Lazy.force servers_file)) - -let reload_servers () = _servers := Some (load_servers ()) - -let save_servers () = - let oc = open_out (Lazy.force servers_file) in - List.iter (fun (_,server) -> output_string oc (server ^ "\n")) - (Lazy.force servers); - close_out oc - -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 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")) +let dtd_base_urls = lazy ( + let rex = Pcre.regexp "/*$" in + let raw_urls = + match + Helm_registry.get_list Helm_registry.string "getter.dtd_base_urls" + with + | [] -> ["http://helm.cs.unibo.it/dtd"; "http://mowgli.cs.unibo.it/dtd"] + | urls -> urls + in + List.map (Pcre.replace ~rex) raw_urls) +let port = lazy ( + Helm_registry.get_opt_default Helm_registry.int ~default:58081 "getter.port") + +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 + with Invalid_argument _ -> + Http_getter_logger.log ("skipping invalid prefix: " ^ prefix); + acc) + [] prefixes) + +let host = lazy (Http_getter_misc.backtick "hostname -f") let my_own_url = lazy @@ -89,72 +70,31 @@ let my_own_url = sprintf "http://%s%s" (* without trailing '/' *) host (if port = 80 then "" else (sprintf ":%d" port))) -let cache_mode = - lazy - (match String.lowercase (Helm_registry.get "getter.cache_mode") with - | "normal" -> Enc_normal - | "gz" -> Enc_gzipped - | mode -> failwith ("Invalid cache mode: " ^ mode)) - -let reload () = reload_servers () - let env_to_string () = + let pp_prefix (uri_prefix, url_prefix) = + " " ^ uri_prefix ^ " -- " ^ url_prefix + in + let pp_prefixes prefixes = + match prefixes with + | [] -> "" + | l -> "\n" ^ String.concat "\n" (List.map pp_prefix l) + in sprintf -"HTTP Getter %s (the OCaml one!) +"HTTP Getter %s -cic_dbm:\t%s -nuprl_dbm:\t%s -rdf_dbm:\t%s -xsl_dbm:\t%s -xml_index:\t%s -rdf_index:\t%s -xsl_index:\t%s -cic_dir:\t%s -nuprl_dir:\t%s -rdf_dir:\t%s +prefixes:%s dtd_dir:\t%s -servers_file:\t%s host:\t\t%s port:\t\t%d my_own_url:\t%s -dtd_base_url:\t%s -cache_mode:\t%s -servers: -\t%s +dtd_base_urls:\t%s +log_file:\t%s +log_level:\t%d " - version (Lazy.force cic_dbm) (Lazy.force nuprl_dbm) (Lazy.force rdf_dbm) - (Lazy.force xsl_dbm) (Lazy.force xml_index) - (Lazy.force rdf_index) (Lazy.force xsl_index) (Lazy.force cic_dir) - (Lazy.force nuprl_dir) (Lazy.force rdf_dir) - (Lazy.force dtd_dir) (Lazy.force servers_file) (Lazy.force host) - (Lazy.force port) (Lazy.force my_own_url) - (Lazy.force dtd_base_url) - (match Lazy.force cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped") - (String.concat "\n\t" (* (position * server) list *) - (List.map (fun (pos, server) -> sprintf "%3d: %s" pos server) - (Lazy.force servers))) - -let add_server ?position url = - let new_servers = - let servers = Lazy.force servers in - match position with - | None -> servers @ [-1, url]; - | Some p when p > 0 -> - let rec add_after pos = function - | [] -> [-1, url] - | hd :: tl when p = 1 -> hd :: (-1, url) :: tl - | hd :: tl (* when p > 1 *) -> hd :: (add_after (pos - 1) tl) - in - add_after p servers - | Some 0 -> (-1, url)::servers - | Some _ -> assert false - in - _servers := Some new_servers; - save_servers (); - reload_servers () - -let remove_server position = - _servers := Some (List.remove_assoc position (Lazy.force servers)); - save_servers (); - reload_servers () + version + (pp_prefixes (Lazy.force prefixes)) + (Lazy.force dtd_dir) (Lazy.force host) (Lazy.force port) + (Lazy.force my_own_url) (String.concat " " (Lazy.force dtd_base_urls)) + (match Http_getter_logger.get_log_file () with None -> "None" | Some f -> f) + (Http_getter_logger.get_log_level ())