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 servers =
  77   let cons hd tl = hd @ [ tl ] in
  78   Http_getter_misc.fold_file cons [] servers_file
  79
  80 let xml_dbm = safe_getenv "HTTP_GETTER_XML_DBM"
  81 let rdf_dbm = safe_getenv "HTTP_GETTER_RDF_DBM"
  82 let xsl_dbm = safe_getenv "HTTP_GETTER_XSL_DBM"
  83 let xml_index = safe_getenv "HTTP_GETTER_XML_INDEXNAME"
  84 let rdf_index = safe_getenv "HTTP_GETTER_RDF_INDEXNAME"
  85 let xsl_index = safe_getenv "HTTP_GETTER_XSL_INDEXNAME"
  86 let xml_dir = safe_getenv "HTTP_GETTER_XML_DIR"
  87 let rdf_dir = safe_getenv "HTTP_GETTER_RDF_DIR"
  88 let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR"
  89
  90 let port =
  91   let port = safe_getenv "HTTP_GETTER_PORT" in
  92   try
  93     int_of_string port
  94   with Failure "int_of_string" ->
  95     failwith ("Invalid port value: " ^ port)
  96 let host =
  97   let buf = Buffer.create 20 in
  98   Shell.call ~stdout:(Shell.to_buffer buf) [Shell.cmd "hostname" ["-f"]];
  99   Pcre.replace ~pat:"\n+$" (Buffer.contents buf)
 100 let my_own_url =
 101   sprintf
 102     "http://%s%s" (* without trailing '/' *)
 103     host
 104     (if port = 80 then "" else (sprintf ":%d" port))
 105 let dtd_base_url = safe_getenv "HTTP_GETTER_DTD_BASE_URL"
 106
 107 let cache_mode =
 108   match String.lowercase (safe_getenv "HTTP_GETTER_CACHE_MODE") with
 109   | "normal" -> Enc_normal
 110   | "gz" -> Enc_gzipped
 111   | mode -> failwith ("Invalid cache mode: " ^ mode)
 112
 113 let dump_env () =
 114   printf
 115 "xml_dbm:\t%s
 116 rdf_dbm:\t%s
 117 xsl_dbm:\t%s
 118 xml_index:\t%s
 119 rdf_index:\t%s
 120 xsl_index:\t%s
 121 xml_dir:\t%s
 122 rdf_dir:\t%s
 123 dtd_dir:\t%s
 124 servers_file:\t%s
 125 host:\t\t%s
 126 port:\t\t%d
 127 my_own_url:\t%s
 128 dtd_base_url:\t%s
 129 cache_mode:\t%s
 130 conf_file:\t%s
 131 conf_dir:\t%s
 132 servers:
 133 \t%s
 134 "
 135     xml_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index
 136     xml_dir rdf_dir dtd_dir servers_file host port
 137     my_own_url dtd_base_url
 138     (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped")
 139     conf_file conf_dir (String.concat "\n\t" servers);
 140   flush stdout
 141