2 * Copyright (C) 2003-2004:
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/
34 open Http_getter_types
36 let version = Http_getter_const.version
39 | Environment (* read setting from environment variables *)
40 | Conffile (* read setting from configuration file *)
41 | Both (* read setting from both; environment override config file *)
43 let conf_file_tree = ref None
45 let (conf_file, conf_dir) =
48 Pcre.replace ~pat:"/$" (Sys.getenv "HELM_CONFIGURATION_DIR")
50 (conf_dir ^ "/" ^ Http_getter_const.conffile, conf_dir)
51 with Not_found -> failwith "HELM_CONFIGURATION_DIR undefined"
53 let safe_getenv ?(from = Both) var =
54 (let rec read_from_file () =
55 (match !conf_file_tree with
59 (parse_wfcontent_entity
60 default_config (from_file conf_file) default_spec);
64 Some (find_element (String.lowercase var) t)#data
65 with Not_found -> None))
67 let read_from_env () = try Some (Sys.getenv var) with Not_found -> None in
68 let return_value name = function
70 | None -> failwith ("Setting " ^ name ^ " is not defined")
73 | Environment -> return_value var (read_from_env ())
74 | Conffile -> return_value var (read_from_file ())
76 (match read_from_env () with
77 | None -> return_value var (read_from_file ())
78 | v -> return_value var v)))
80 let servers_file = safe_getenv "HTTP_GETTER_SERVERS_FILE"
84 List.rev (Http_getter_misc.fold_file
86 if Http_getter_misc.is_blank_line line then
89 (incr pos; (!pos, line) :: servers))
93 let _servers = ref (load_servers ())
94 let servers () = !_servers
97 let oc = open_out servers_file in
98 List.iter (fun (_,server) -> output_string oc (server ^ "\n")) (servers ());
100 let reload_servers () = _servers := load_servers ()
102 let cic_dbm = safe_getenv "HTTP_GETTER_CIC_DBM"
103 let nuprl_dbm = safe_getenv "HTTP_GETTER_NUPRL_DBM"
104 let rdf_dbm = safe_getenv "HTTP_GETTER_RDF_DBM"
105 let xsl_dbm = safe_getenv "HTTP_GETTER_XSL_DBM"
106 let xml_index = safe_getenv "HTTP_GETTER_XML_INDEXNAME"
107 let rdf_index = safe_getenv "HTTP_GETTER_RDF_INDEXNAME"
108 let xsl_index = safe_getenv "HTTP_GETTER_XSL_INDEXNAME"
109 let cic_dir = safe_getenv "HTTP_GETTER_CIC_DIR"
110 let nuprl_dir = safe_getenv "HTTP_GETTER_NUPRL_DIR"
111 let rdf_dir = safe_getenv "HTTP_GETTER_RDF_DIR"
112 let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR"
115 let port = safe_getenv "HTTP_GETTER_PORT" in
118 with Failure "int_of_string" ->
119 failwith ("Invalid port value: " ^ port)
121 let buf = Buffer.create 20 in
122 Shell.call ~stdout:(Shell.to_buffer buf) [Shell.cmd "hostname" ["-f"]];
123 Pcre.replace ~pat:"\n+$" (Buffer.contents buf)
126 "http://%s%s" (* without trailing '/' *)
128 (if port = 80 then "" else (sprintf ":%d" port))
129 let dtd_base_url = safe_getenv "HTTP_GETTER_DTD_BASE_URL"
132 match String.lowercase (safe_getenv "HTTP_GETTER_CACHE_MODE") with
133 | "normal" -> Enc_normal
134 | "gz" -> Enc_gzipped
135 | mode -> failwith ("Invalid cache mode: " ^ mode)
137 let reload () = reload_servers ()
139 let env_to_string () =
141 "HTTP Getter %s (the OCaml one!)
165 version cic_dbm nuprl_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index
166 cic_dir nuprl_dir rdf_dir dtd_dir servers_file host port my_own_url
168 (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped")
170 (String.concat "\n\t" (* (position * server) list *)
171 (List.map (fun (pos, server) -> sprintf "%3d: %s" pos server)
174 let add_server ?position url =
177 _servers := !_servers @ [-1, url];
178 | Some p when p > 0 ->
179 let rec add_after pos = function
181 | hd :: tl when p = 1 -> hd :: (-1, url) :: tl
182 | hd :: tl (* when p > 1 *) -> hd :: (add_after (pos - 1) tl)
184 _servers := add_after p !_servers
185 | Some _ -> assert false);
189 let remove_server position =
190 _servers := List.remove_assoc position !_servers;