+++ /dev/null
-(*
- * Copyright (C) 2003-2004:
- * Stefano Zacchiroli <zack@cs.unibo.it>
- * 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 Printf
-open Pxp_document
-open Pxp_types
-open Pxp_yacc
-
-open Http_getter_types
-
-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"
-
-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))
- []
- servers_file)
-
-let _servers = ref (load_servers ())
-let servers () = !_servers
-
-let save_servers () =
- let oc = open_out servers_file in
- List.iter (fun (_,server) -> output_string oc (server ^ "\n")) (servers ());
- close_out oc
-let reload_servers () = _servers := load_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" (* (position * server) list *)
- (List.map (fun (pos, server) -> sprintf "%3d: %s" pos server)
- (servers ())))
-
-let add_server ?position url =
- (match position with
- | None ->
- _servers := !_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
- _servers := add_after p !_servers
- | Some _ -> assert false);
- save_servers ();
- reload_servers ()
-
-let remove_server position =
- _servers := List.remove_assoc position !_servers;
- save_servers ();
- reload_servers ()
-