3 * Stefano Zacchiroli <zack@cs.unibo.it>
4 * for the HELM Team http://helm.cs.unibo.it/
6 * This file is part of HELM, an Hypertextual, Electronic
7 * Library of Mathematics, developed at the Computer Science
8 * Department, University of Bologna, Italy.
10 * HELM is free software; you can redistribute it and/or
11 * modify it under the terms of the GNU General Public License
12 * as published by the Free Software Foundation; either version 2
13 * of the License, or (at your option) any later version.
15 * HELM is distributed in the hope that it will be useful,
16 * but WITHOUT ANY WARRANTY; without even the implied warranty of
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 * GNU General Public License for more details.
20 * You should have received a copy of the GNU General Public License
21 * along with HELM; if not, write to the Free Software
22 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
25 * For details, see the HELM World-Wide-Web page,
26 * http://helm.cs.unibo.it/
29 open Http_getter_types;;
35 let version = Http_getter_const.version
38 | Environment (* read setting from environment variables *)
39 | Conffile (* read setting from configuration file *)
40 | Both (* read setting from both; environment override config file *)
42 let conf_file_tree = ref None
44 let (conf_file, conf_dir) =
47 Pcre.replace ~pat:"/$" (Sys.getenv "HELM_CONFIGURATION_DIR")
49 (conf_dir ^ "/" ^ Http_getter_const.conffile, conf_dir)
50 with Not_found -> failwith "HELM_CONFIGURATION_DIR undefined"
52 let safe_getenv ?(from = Both) var =
53 (let rec read_from_file () =
54 (match !conf_file_tree with
58 (parse_wfcontent_entity
59 default_config (from_file conf_file) default_spec);
63 Some (find_element (String.lowercase var) t)#data
64 with Not_found -> None))
66 let read_from_env () = try Some (Sys.getenv var) with Not_found -> None in
67 let return_value name = function
69 | None -> failwith ("Setting " ^ name ^ " is not defined")
72 | Environment -> return_value var (read_from_env ())
73 | Conffile -> return_value var (read_from_file ())
75 (match read_from_env () with
76 | None -> return_value var (read_from_file ())
77 | v -> return_value var v)))
79 let servers_file = safe_getenv "HTTP_GETTER_SERVERS_FILE"
80 let parse_servers () =
81 (let cons hd tl = hd @ [ tl ] in
82 Http_getter_misc.fold_file cons [] servers_file)
83 let servers = ref (parse_servers ())
84 let reload_servers () = servers := parse_servers ()
86 let cic_dbm = safe_getenv "HTTP_GETTER_CIC_DBM"
87 let nuprl_dbm = safe_getenv "HTTP_GETTER_NUPRL_DBM"
88 let rdf_dbm = safe_getenv "HTTP_GETTER_RDF_DBM"
89 let xsl_dbm = safe_getenv "HTTP_GETTER_XSL_DBM"
90 let xml_index = safe_getenv "HTTP_GETTER_XML_INDEXNAME"
91 let rdf_index = safe_getenv "HTTP_GETTER_RDF_INDEXNAME"
92 let xsl_index = safe_getenv "HTTP_GETTER_XSL_INDEXNAME"
93 let cic_dir = safe_getenv "HTTP_GETTER_CIC_DIR"
94 let nuprl_dir = safe_getenv "HTTP_GETTER_NUPRL_DIR"
95 let rdf_dir = safe_getenv "HTTP_GETTER_RDF_DIR"
96 let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR"
99 let port = safe_getenv "HTTP_GETTER_PORT" in
102 with Failure "int_of_string" ->
103 failwith ("Invalid port value: " ^ port)
105 let buf = Buffer.create 20 in
106 Shell.call ~stdout:(Shell.to_buffer buf) [Shell.cmd "hostname" ["-f"]];
107 Pcre.replace ~pat:"\n+$" (Buffer.contents buf)
110 "http://%s%s" (* without trailing '/' *)
112 (if port = 80 then "" else (sprintf ":%d" port))
113 let dtd_base_url = safe_getenv "HTTP_GETTER_DTD_BASE_URL"
116 match String.lowercase (safe_getenv "HTTP_GETTER_CACHE_MODE") with
117 | "normal" -> Enc_normal
118 | "gz" -> Enc_gzipped
119 | mode -> failwith ("Invalid cache mode: " ^ mode)
126 "HTTP Getter %s (the OCaml one!)
150 version cic_dbm nuprl_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index
151 cic_dir nuprl_dir rdf_dir dtd_dir servers_file host port my_own_url
153 (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped")
154 conf_file conf_dir (String.concat "\n\t" !servers);