helm/http_getter/http_getter_env.ml

   1 (*
   2  *  Copyright (C) 2000, 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 xsl_dir = safe_getenv "HTTP_GETTER_XSL_DIR"
  89 let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR"
  90
  91 let port =
  92   let port = safe_getenv "HTTP_GETTER_PORT" in
  93   try
  94     int_of_string port
  95   with Failure "int_of_string" ->
  96     failwith ("Invalid port value: " ^ port)
  97 let host =
  98   let buf = Buffer.create 20 in
  99   Shell.call ~stdout:(Shell.to_buffer buf) [Shell.cmd "hostname" ["-f"]];
 100   Pcre.replace ~pat:"\n+$" (Buffer.contents buf)
 101 let my_own_url =
 102   sprintf
 103     "http://%s%s/"
 104     host
 105     (if port = 80 then "" else (sprintf ":%d" port))
 106 let dtd_base_url = safe_getenv "HTTP_GETTER_DTD_BASE_URL"
 107
 108 let cache_mode =
 109   match String.lowercase (safe_getenv "HTTP_GETTER_CACHE_MODE") with
 110   | "normal" -> Enc_normal
 111   | "gz" -> Enc_gzipped
 112   | mode -> failwith ("Invalid cache mode: " ^ mode)
 113
 114 let dump_env () =
 115   printf
 116 "xml_dbm:\t%s
 117 rdf_dbm:\t%s
 118 xsl_dbm:\t%s
 119 xml_index:\t%s
 120 rdf_index:\t%s
 121 xsl_index:\t%s
 122 xml_dir:\t%s
 123 rdf_dir:\t%s
 124 xsl_dir:\t%s
 125 dtd_dir:\t%s
 126 servers_file:\t%s
 127 host:\t\t%s
 128 port:\t\t%d
 129 my_own_url:\t%s
 130 dtd_base_url:\t%s
 131 cache_mode:\t%s
 132 conf_file:\t%s
 133 conf_dir:\t%s
 134 servers:
 135 \t%s
 136 "
 137     xml_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index
 138     xml_dir rdf_dir xsl_dir dtd_dir servers_file host port
 139     my_own_url dtd_base_url
 140     (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped")
 141     conf_file conf_dir (String.concat "\n\t" servers);
 142   flush stdout
 143