helm/http_getter/http_getter_env.ml

   1 (*
   2  *  Copyright (C) 2003, HELM Team.
   3  *
   4  *  This file is part of HELM, an Hypertextual, Electronic
   5  *  Library of Mathematics, developed at the Computer Science
   6  *  Department, University of Bologna, Italy.
   7  *
   8  *  HELM is free software; you can redistribute it and/or
   9  *  modify it under the terms of the GNU General Public License
  10  *  as published by the Free Software Foundation; either version 2
  11  *  of the License, or (at your option) any later version.
  12  *
  13  *  HELM is distributed in the hope that it will be useful,
  14  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16  *  GNU General Public License for more details.
  17  *
  18  *  You should have received a copy of the GNU General Public License
  19  *  along with HELM; if not, write to the Free Software
  20  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  21  *  MA  02111-1307, USA.
  22  *
  23  *  For details, see the HELM World-Wide-Web page,
  24  *  http://cs.unibo.it/helm/.
  25  *)
  26
  27 open Http_getter_types;;
  28 open Printf;;
  29 open Pxp_document;;
  30 open Pxp_types;;
  31 open Pxp_yacc;;
  32
  33 type setting_src =
  34   | Environment (* read setting from environment variables *)
  35   | Conffile    (* read setting from configuration file *)
  36   | Both        (* read setting from both; environment override config file *)
  37
  38 let conf_file_tree = ref None
  39
  40 let (conf_file, conf_dir) =
  41   try
  42     let conf_dir =
  43       Pcre.replace ~pat:"/$" (Sys.getenv "HELM_CONFIGURATION_DIR")
  44     in
  45     (conf_dir ^ "/configuration.xml", conf_dir)
  46   with Not_found -> failwith "HELM_CONFIGURATION_DIR undefined"
  47
  48 let safe_getenv ?(from = Both) var =
  49   (let rec read_from_file () =
  50     (match !conf_file_tree with
  51     | None ->
  52         conf_file_tree :=
  53           Some
  54             (parse_wfcontent_entity
  55               default_config (from_file conf_file) default_spec);
  56         read_from_file ()
  57     | Some t ->
  58         (try
  59           Some (find_element (String.lowercase var) t)#data
  60         with Not_found -> None))
  61   in
  62   let read_from_env () = try Some (Sys.getenv var) with Not_found -> None in
  63   let return_value name = function
  64     | Some v -> v
  65     | None -> failwith ("Setting " ^ name ^ " is not defined")
  66   in
  67   (match from with
  68   | Environment -> return_value var (read_from_env ())
  69   | Conffile -> return_value var (read_from_file ())
  70   | Both ->
  71       (match read_from_env () with
  72       | None -> return_value var (read_from_file ())
  73       | v -> return_value var v)))
  74
  75 let servers_file = safe_getenv "HTTP_GETTER_SERVERS_FILE"
  76 let parse_servers () =
  77   (let cons hd tl = hd @ [ tl ] in
  78   Http_getter_misc.fold_file cons [] servers_file)
  79 let servers = ref (parse_servers ())
  80 let reload_servers () = servers := parse_servers ()
  81
  82 let xml_dbm = safe_getenv "HTTP_GETTER_XML_DBM"
  83 let rdf_dbm = safe_getenv "HTTP_GETTER_RDF_DBM"
  84 let xsl_dbm = safe_getenv "HTTP_GETTER_XSL_DBM"
  85 let xml_index = safe_getenv "HTTP_GETTER_XML_INDEXNAME"
  86 let rdf_index = safe_getenv "HTTP_GETTER_RDF_INDEXNAME"
  87 let xsl_index = safe_getenv "HTTP_GETTER_XSL_INDEXNAME"
  88 let xml_dir = safe_getenv "HTTP_GETTER_XML_DIR"
  89 let rdf_dir = safe_getenv "HTTP_GETTER_RDF_DIR"
  90 let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR"
  91
  92 let port =
  93   let port = safe_getenv "HTTP_GETTER_PORT" in
  94   try
  95     int_of_string port
  96   with Failure "int_of_string" ->
  97     failwith ("Invalid port value: " ^ port)
  98 let host =
  99   let buf = Buffer.create 20 in
 100   Shell.call ~stdout:(Shell.to_buffer buf) [Shell.cmd "hostname" ["-f"]];
 101   Pcre.replace ~pat:"\n+$" (Buffer.contents buf)
 102 let my_own_url =
 103   sprintf
 104     "http://%s%s" (* without trailing '/' *)
 105     host
 106     (if port = 80 then "" else (sprintf ":%d" port))
 107 let dtd_base_url = safe_getenv "HTTP_GETTER_DTD_BASE_URL"
 108
 109 let cache_mode =
 110   match String.lowercase (safe_getenv "HTTP_GETTER_CACHE_MODE") with
 111   | "normal" -> Enc_normal
 112   | "gz" -> Enc_gzipped
 113   | mode -> failwith ("Invalid cache mode: " ^ mode)
 114
 115 let reload () =
 116   reload_servers ()
 117
 118 let dump_env () =
 119   printf
 120 "xml_dbm:\t%s
 121 rdf_dbm:\t%s
 122 xsl_dbm:\t%s
 123 xml_index:\t%s
 124 rdf_index:\t%s
 125 xsl_index:\t%s
 126 xml_dir:\t%s
 127 rdf_dir:\t%s
 128 dtd_dir:\t%s
 129 servers_file:\t%s
 130 host:\t\t%s
 131 port:\t\t%d
 132 my_own_url:\t%s
 133 dtd_base_url:\t%s
 134 cache_mode:\t%s
 135 conf_file:\t%s
 136 conf_dir:\t%s
 137 servers:
 138 \t%s
 139 "
 140     xml_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index
 141     xml_dir rdf_dir dtd_dir servers_file host port
 142     my_own_url dtd_base_url
 143     (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped")
 144     conf_file conf_dir (String.concat "\n\t" !servers);
 145   flush stdout
 146