X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2Focaml%2Fgetter%2Fhttp_getter_env.ml;fp=helm%2Focaml%2Fgetter%2Fhttp_getter_env.ml;h=0000000000000000000000000000000000000000;hp=a7fe6be91d14701a69e0a150b31488a370e9c870;hb=1696761e4b8576e8ed81caa905fd108717019226;hpb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1 diff --git a/helm/ocaml/getter/http_getter_env.ml b/helm/ocaml/getter/http_getter_env.ml deleted file mode 100644 index a7fe6be91..000000000 --- a/helm/ocaml/getter/http_getter_env.ml +++ /dev/null @@ -1,169 +0,0 @@ -(* - * Copyright (C) 2003-2004: - * Stefano Zacchiroli - * 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 - -let servers_file = lazy (Helm_registry.get "getter.servers_file") -let cic_dbm = lazy (Helm_registry.get "getter.cic_dbm") -let nuprl_dbm = lazy (Helm_registry.get "getter.nuprl_dbm") -let rdf_dbm = lazy (Helm_registry.get "getter.rdf_dbm") -let xsl_dbm = lazy (Helm_registry.get "getter.xsl_dbm") -let xml_index = lazy (Helm_registry.get "getter.xml_indexname") -let rdf_index = lazy (Helm_registry.get "getter.rdf_indexname") -let xsl_index = lazy (Helm_registry.get "getter.xsl_indexname") -let cic_dir = lazy (Helm_registry.get "getter.cic_dir") -let nuprl_dir = lazy (Helm_registry.get "getter.nuprl_dir") -let rdf_dir = lazy (Helm_registry.get "getter.rdf_dir") -let dtd_dir = lazy (Helm_registry.get "getter.dtd_dir") -let dtd_base_urls = lazy ( - let rex = Pcre.regexp "/*$" in - let raw_urls = Helm_registry.get_string_list "getter.dtd_base_urls" in - List.map (Pcre.replace ~rex) raw_urls) -let port = lazy (Helm_registry.get_int "getter.port") - -let _servers = ref None - -let servers = - function () -> - (match !_servers with - | None -> failwith "Getter not yet initialized: servers not available" - | Some servers -> servers) - -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)) - [] - (Lazy.force servers_file)) - -let reload_servers () = _servers := Some (load_servers ()) - -let save_servers () = - let oc = open_out (Lazy.force servers_file) in - List.iter (fun (_,server) -> output_string oc (server ^ "\n")) - (servers ()); - close_out oc - -let host = - lazy - (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 = - lazy - (let (host, port) = (Lazy.force host, Lazy.force port) in - sprintf "http://%s%s" (* without trailing '/' *) - host (if port = 80 then "" else (sprintf ":%d" port))) - -let cache_mode = - lazy - (match String.lowercase (Helm_registry.get "getter.cache_mode") with - | "normal" -> `Normal - | "gz" -> `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_urls:\t%s -cache_mode:\t%s -servers: -\t%s -log_file:\t%s -log_level:\t%d -" - version (Lazy.force cic_dbm) (Lazy.force nuprl_dbm) (Lazy.force rdf_dbm) - (Lazy.force xsl_dbm) (Lazy.force xml_index) - (Lazy.force rdf_index) (Lazy.force xsl_index) (Lazy.force cic_dir) - (Lazy.force nuprl_dir) (Lazy.force rdf_dir) - (Lazy.force dtd_dir) (Lazy.force servers_file) (Lazy.force host) - (Lazy.force port) (Lazy.force my_own_url) - (String.concat " " (Lazy.force dtd_base_urls)) - (match Lazy.force cache_mode with - | `Normal -> "Normal" - | `Gzipped -> "GZipped") - (String.concat "\n\t" (* (position * server) list *) - (List.map (fun (pos, server) -> sprintf "%3d: %s" pos server) - (servers ()))) - (match Http_getter_logger.get_log_file () with None -> "None" | Some f -> f) - (Http_getter_logger.get_log_level ()) - -let add_server ?position url = - let new_servers = - let servers = servers () in - match position with - | None -> 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 - add_after p servers - | Some 0 -> (-1, url)::servers - | Some _ -> assert false - in - _servers := Some new_servers; - save_servers (); - reload_servers () - -let remove_server position = - _servers := Some (List.remove_assoc position (servers ())); - save_servers (); - reload_servers () -