X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter_env.ml;fp=helm%2Fhttp_getter%2Fhttp_getter_env.ml;h=0000000000000000000000000000000000000000;hp=54269279535eaf0828818a2770672d0fa24375d4;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/http_getter/http_getter_env.ml b/helm/http_getter/http_getter_env.ml deleted file mode 100644 index 542692795..000000000 --- a/helm/http_getter/http_getter_env.ml +++ /dev/null @@ -1,177 +0,0 @@ -(* - * Copyright (C) 2003: - * Stefano Zacchiroli - * for the HELM Team http://helm.cs.unibo.it/ - * - * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science - * Department, University of Bologna, Italy. - * - * HELM is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * HELM is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with HELM; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, - * MA 02111-1307, USA. - * - * For details, see the HELM World-Wide-Web page, - * http://helm.cs.unibo.it/ - *) - -open Http_getter_types;; -open Printf;; -open Pxp_document;; -open Pxp_types;; -open Pxp_yacc;; - -let version = Http_getter_const.version - -type setting_src = - | Environment (* read setting from environment variables *) - | Conffile (* read setting from configuration file *) - | Both (* read setting from both; environment override config file *) - -let conf_file_tree = ref None - -let (conf_file, conf_dir) = - try - let conf_dir = - Pcre.replace ~pat:"/$" (Sys.getenv "HELM_CONFIGURATION_DIR") - in - (conf_dir ^ "/" ^ Http_getter_const.conffile, conf_dir) - with Not_found -> failwith "HELM_CONFIGURATION_DIR undefined" - -let safe_getenv ?(from = Both) var = - (let rec read_from_file () = - (match !conf_file_tree with - | None -> - conf_file_tree := - Some - (parse_wfcontent_entity - default_config (from_file conf_file) default_spec); - read_from_file () - | Some t -> - (try - Some (find_element (String.lowercase var) t)#data - with Not_found -> None)) - in - let read_from_env () = try Some (Sys.getenv var) with Not_found -> None in - let return_value name = function - | Some v -> v - | None -> failwith ("Setting " ^ name ^ " is not defined") - in - (match from with - | Environment -> return_value var (read_from_env ()) - | Conffile -> return_value var (read_from_file ()) - | Both -> - (match read_from_env () with - | None -> return_value var (read_from_file ()) - | v -> return_value var v))) - -let servers_file = safe_getenv "HTTP_GETTER_SERVERS_FILE" - - (* TODO BUG HERE: is commented lines are included in the servers file the - server index (used for example by the remove_server method) gets out of sync! - *) -let parse_servers () = - List.rev (Http_getter_misc.fold_file - (fun servers line -> - if Http_getter_misc.is_blank_line line then servers else line::servers) - [] - servers_file) -;; -let servers = ref (parse_servers ()) -let reload_servers () = servers := parse_servers () - -let cic_dbm = safe_getenv "HTTP_GETTER_CIC_DBM" -let nuprl_dbm = safe_getenv "HTTP_GETTER_NUPRL_DBM" -let rdf_dbm = safe_getenv "HTTP_GETTER_RDF_DBM" -let xsl_dbm = safe_getenv "HTTP_GETTER_XSL_DBM" -let xml_index = safe_getenv "HTTP_GETTER_XML_INDEXNAME" -let rdf_index = safe_getenv "HTTP_GETTER_RDF_INDEXNAME" -let xsl_index = safe_getenv "HTTP_GETTER_XSL_INDEXNAME" -let cic_dir = safe_getenv "HTTP_GETTER_CIC_DIR" -let nuprl_dir = safe_getenv "HTTP_GETTER_NUPRL_DIR" -let rdf_dir = safe_getenv "HTTP_GETTER_RDF_DIR" -let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR" - -let port = - let port = safe_getenv "HTTP_GETTER_PORT" in - try - int_of_string port - with Failure "int_of_string" -> - failwith ("Invalid port value: " ^ port) -let host = - 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 my_own_url = - sprintf - "http://%s%s" (* without trailing '/' *) - host - (if port = 80 then "" else (sprintf ":%d" port)) -let dtd_base_url = safe_getenv "HTTP_GETTER_DTD_BASE_URL" - -let cache_mode = - match String.lowercase (safe_getenv "HTTP_GETTER_CACHE_MODE") with - | "normal" -> Enc_normal - | "gz" -> Enc_gzipped - | mode -> failwith ("Invalid cache mode: " ^ mode) - -let reload () = - reload_servers () - -let env_to_string () = - sprintf -"HTTP Getter %s (the OCaml one!) - -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 -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 -conf_file:\t%s -conf_dir:\t%s -servers: -\t%s -" - version cic_dbm nuprl_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index - cic_dir nuprl_dir rdf_dir dtd_dir servers_file host port my_own_url - dtd_base_url - (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped") - conf_file conf_dir - (String.concat "\n\t" (* servers list prepended with server number *) - (List.map - (let idx = ref ~-1 in - fun server -> incr idx; sprintf "%3d: %s" !idx server) - !servers)) - -let add_server ?position url = - (match position with - | Some p -> Http_getter_misc.add_line ~fname:servers_file ~position:p url - | None -> Http_getter_misc.add_line ~fname:servers_file url); - reload_servers () - -let remove_server position = - Http_getter_misc.remove_line ~fname:servers_file position; - reload_servers () -