PXP_DIR = $(OCAML_ROOT)/site-lib/pxp
NETSTRING_DIR = $(OCAML_ROOT)/site-lib/netstring
+XSTR_DIR = $(OCAML_ROOT)/site-lib/xstr
+NETCLIENT_DIR = $(OCAML_ROOT)/site-lib/netclient
#OCAMLC = ocamlc -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I mlmathview
#OCAMLOPT = ocamlopt -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I mlgtk_devel -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I mlmathview
-OCAMLC = ocamlc -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR)
-OCAMLOPT = ocamlopt -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR)
+OCAMLC = ocamlc -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I $(XSTR_DIR) -I $(NETCLIENT_DIR)
+OCAMLOPT = ocamlopt -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I $(XSTR_DIR) -I $(NETCLIENT_DIR)
OCAMLDEP = ocamldep
all: experiment reduction fix_params mmlinterface
pxp_lex_iso88591.cmxa pxp_lex_utf8.cmxa pxp_engine.cmxa \
pxp_utf8.cmx
+XSTRLIBS = xstr.cma
+
+XSTRLIBSOPT = xstr.cmxa
+
+NETCLIENTLIBS = netclient.cma
+
+NETCLIENTLIBSOPT = netclient.cmxa
DEPOBJS = experiment.ml cicCache.ml cicCache.mli cicPp.ml cicPp.mli \
cicParser.ml cicParser.mli cicParser2.ml cicParser2.mli \
- cicParser3.ml cicParser3.mli cic.ml getter.ml getter.mli \
+ cicParser3.ml cicParser3.mli cic.ml clientHTTP.ml getter.ml getter.mli \
gtkInterface.ml cicReduction.ml cicReduction.mli cicTypeChecker.ml \
cicTypeChecker.mli reduction.ml tgtkInterface.ml theory.ml \
theoryParser.ml theoryParser2.ml theoryPp.ml theoryTypeChecker.ml \
fix_params.ml cic2Xml.ml xml.ml uriManager.ml uriManager.mli \
cicSubstitution.ml cicSubstitution.mli \
mmlinterface.ml configuration.ml styleConfiguration.ml \
- xsltProcessor.ml deannotate.ml cicXPath.ml pxpUriResolver.ml \
+ xsltProcessorHTTP.ml xsltProcessor.ml deannotate.ml cicXPath.ml pxpUriResolver.ml \
annotationParser.ml annotationParser2.ml annotation2Xml.ml \
cicAnnotationHinter.ml
-MMLINTERFACEOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \
- pxpUriResolver.cmo \
+MMLINTERFACEOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \
+ pxpUriResolver.cmo styleConfiguration.cmo \
cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \
cicSubstitution.cmo annotationParser2.cmo \
annotationParser.cmo cicCache.cmo cicCooking.cmo cicPp.cmo \
cicReduction.cmo cicTypeChecker.cmo \
xml.cmo \
- xsltProcessor.cmo cic2Xml.cmo annotation2Xml.cmo \
+ xsltProcessorHTTP.cmo xsltProcessor.cmo cic2Xml.cmo annotation2Xml.cmo \
cicXPath.cmo theory.cmo theoryParser2.cmo theoryParser.cmo \
theoryCache.cmo theoryTypeChecker.cmo \
cicAnnotationHinter.cmo mmlinterface.cmo
-MMLINTERFACEOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \
- pxpUriResolver.cmx \
+MMLINTERFACEOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \
+ pxpUriResolver.cmx styleConfiguration.cmx \
cicParser3.cmx cicParser2.cmx cicParser.cmx \
deannotate.cmx cicSubstitution.cmx annotationParser2.cmx \
annotationParser.cmx cicCache.cmx \
cicCooking.cmx cicPp.cmx cicReduction.cmx \
cicTypeChecker.cmx \
- xml.cmx xsltProcessor.cmx \
+ xml.cmx xsltProcessorHTTP.cmx xsltProcessor.cmx \
cic2Xml.cmx annotation2Xml.cmx cicXPath.cmx \
theory.cmx theoryParser2.cmx theoryParser.cmx \
theoryCache.cmx theoryTypeChecker.cmx \
cicAnnotationHinter.cmx mmlinterface.cmx
-FIX_PARAMSOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \
- pxpUriResolver.cmo \
+FIX_PARAMSOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \
+ pxpUriResolver.cmo styleConfiguration.cmo \
cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \
cicSubstitution.cmo annotationParser2.cmo \
annotationParser.cmo cicCache.cmo cicPp.cmo xml.cmo \
cic2Xml.cmo cicFindParameters.cmo fix_params.cmo
-FIX_PARAMSOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \
- pxpUriResolver.cmx \
+FIX_PARAMSOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \
+ pxpUriResolver.cmx styleConfiguration.cmx \
cicParser3.cmx cicParser2.cmx cicParser.cmx deannotate.cmx \
cicSubstitution.cmx annotationParser2.cmx \
annotationParser.cmx cicCache.cmx cicPp.cmx xml.cmx \
cic2Xml.cmx cicFindParameters.cmx fix_params.cmx
-REDUCTIONOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \
- pxpUriResolver.cmo \
+REDUCTIONOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \
+ pxpUriResolver.cmo styleConfiguration.cmo \
cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \
cicSubstitution.cmo annotationParser2.cmo annotationParser.cmo \
cicCache.cmo cicPp.cmo cicCooking.cmo \
cicReduction.cmo cicTypeChecker.cmo reduction.cmo
-REDUCTIONOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \
- pxpUriResolver.cmx \
+REDUCTIONOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \
+ pxpUriResolver.cmx styleConfiguration.cmx \
cicParser3.cmx cicParser2.cmx cicParser.cmx deannotate.cmx \
cicSubstitution.cmx annotationParser2.cmx \
annotationParser.cmx cicCache.cmx cicPp.cmx cicCooking.cmx \
cicReduction.cmx cicTypeChecker.cmx reduction.cmx
-EXPERIMENTOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \
- pxpUriResolver.cmo \
+EXPERIMENTOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \
+ pxpUriResolver.cmo styleConfiguration.cmo \
cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \
cicSubstitution.cmo annotationParser2.cmo \
annotationParser.cmo cicCache.cmo cicPp.cmo experiment.cmo
-EXPERIMENTOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \
- pxpUriResolver.cmx \
+EXPERIMENTOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \
+ pxpUriResolver.cmx styleConfiguration.cmx \
cicParser3.cmx cicParser2.cmx cicParser.cmx deannotate.cmx \
cicSubstitution.cmx annotationParser2.cmx \
annotationParser.cmx cicCache.cmx cicPp.cmx experiment.cmx
$(OCAMLDEP) $(DEPOBJS) > .depend
mmlinterface: $(MMLINTERFACEOBJS)
- $(OCAMLC) -custom -o mmlinterface str.cma unix.cma $(PXPLIBS) dbm.cma \
+ $(OCAMLC) -custom -o mmlinterface str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \
lablgtk.cma gtkInit.cmo \
$(MINIDOM_DIR)/minidom.cmo \
$(MINIDOM_DIR)/ominidom.cmo \
-cclib -lmldbm -cclib -lndbm
mmlinterface.opt: $(MMLINTERFACEOPTOBJS)
- $(OCAMLOPT) -o mmlinterface.opt str.cmxa $(PXPLIBSOPT) unix.cmxa \
+ $(OCAMLOPT) -o mmlinterface.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) unix.cmxa \
dbm.cmxa lablgtk.cmxa gtkInit.cmx \
$(MINIDOM_DIR)/minidom.cmx \
$(MINIDOM_DIR)/ominidom.cmx \
-cclib -lmldbm -cclib -lndbm
fix_params: $(FIX_PARAMSOBJS)
- $(OCAMLC) -custom -o fix_params str.cma $(PXPLIBS) dbm.cma \
+ $(OCAMLC) -custom -o fix_params str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \
$(FIX_PARAMSOBJS) -cclib -lstr -cclib -lmldbm -cclib -lndbm
fix_params.opt: $(FIX_PARAMSOPTOBJS)
- $(OCAMLOPT) -o fix_params.opt str.cmxa $(PXPLIBSOPT) dbm.cmxa \
+ $(OCAMLOPT) -o fix_params.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) dbm.cmxa \
$(FIX_PARAMSOPTOBJS) -cclib -lstr -cclib -lmldbm \
-cclib -lndbm
reduction: $(REDUCTIONOBJS)
- $(OCAMLC) -custom -o reduction str.cma $(PXPLIBS) dbm.cma \
+ $(OCAMLC) -custom -o reduction str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \
$(REDUCTIONOBJS) -cclib -lstr -cclib -lmldbm -cclib -lndbm
reduction.opt: $(REDUCTIONOPTOBJS)
- $(OCAMLOPT) -o reduction.opt str.cmxa $(PXPLIBSOPT) dbm.cmxa \
+ $(OCAMLOPT) -o reduction.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) dbm.cmxa \
$(REDUCTIONOPTOBJS) -cclib -lstr -cclib -lmldbm \
-cclib -lndbm
experiment: $(EXPERIMENTOBJS)
- $(OCAMLC) -custom -o experiment str.cma $(PXPLIBS) dbm.cma \
+ $(OCAMLC) -custom -o experiment str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \
$(EXPERIMENTOBJS) -cclib -lstr -cclib -lmldbm -cclib -lndbm
experiment.opt: $(EXPERIMENTOPTOBJS)
- $(OCAMLOPT) -o experiment.opt str.cmxa $(PXPLIBSOPT) dbm.cmxa \
+ $(OCAMLOPT) -o experiment.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) dbm.cmxa \
$(EXPERIMENTOPTOBJS) -cclib -lstr -cclib -lmldbm \
-cclib -lndbm
--- /dev/null
+(* Copyright (C) 2000, HELM Team.
+ *
+ * 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://cs.unibo.it/helm/.
+ *)
+
+let send cmd =
+ ignore (Http_client.Convenience.http_get cmd)
+
+let get uri =
+ Http_client.Convenience.http_get uri
+
+let get_and_save uri dest_filename =
+ let reply = get uri
+ and out_channel = open_out dest_filename in
+ output_string out_channel reply ;
+ close_out out_channel
+
+let get_and_save_to_tmp uri =
+ let flat_string s s' c =
+ let cs = String.copy s in
+ for i = 0 to (String.length s) - 1 do
+ if String.contains s' s.[i] then cs.[i] <- c
+ done ;
+ cs
+ in
+ let tmp_file = Configuration.tmp_dir ^ "/" ^ (flat_string uri ".-=:;!?/&" '_') in
+ get_and_save uri tmp_file ;
+ tmp_file
+
(* *)
(******************************************************************************)
+exception MalformedDir of string
+
(* this should be the only hard coded constant *)
let filename =
let prefix =
with
Not_found -> "@HELM_CONFIGURATION_DIR@"
in
+ if prefix.[(String.length prefix) - 1] = '/' then
+ raise (MalformedDir prefix) ;
prefix ^ "/configuration.xml";;
exception Warnings;;
* configuration.xml file and its name into the shell environment.
* The shell variable, if present, has precedence over configuration.xml
*)
-let read_configuration_var xml_name env_name =
+let read_configuration_var_env xml_name env_name =
try
- Sys.getenv env_name
+ try
+ Sys.getenv env_name
+ with
+ Not_found -> Hashtbl.find vars xml_name
with
- Not_found -> Hashtbl.find vars xml_name
+ Not_found ->
+ Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
+ flush stdout ;
+ raise Not_found
-let helm_dir = Hashtbl.find vars "helm_dir";;
-let dtd_dir = Hashtbl.find vars "dtd_dir";;
-let style_dir = read_configuration_var "style_dir" "HELM_STYLE_DIR";;
-let servers_file = Hashtbl.find vars "servers_file";;
-let uris_dbm = Hashtbl.find vars "uris_dbm";;
-let dest = Hashtbl.find vars "dest";;
-let indexname = Hashtbl.find vars "indexname";;
-let tmpdir = Hashtbl.find vars "tmpdir";;
-let helm_dir = Hashtbl.find vars "helm_dir";;
-let getter_url = Hashtbl.find vars "getter_url";;
-let processor_url = read_configuration_var "processor_url" "HELM_PROCESSOR_URL"
+let read_configuration_var xml_name =
+ try
+ Hashtbl.find vars xml_name
+ with
+ Not_found ->
+ Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
+ flush stdout ;
+ raise Not_found
+
+let helm_dir = read_configuration_var "helm_dir";;
+let dtd_dir = read_configuration_var "dtd_dir";;
+let style_dir = read_configuration_var_env "style_dir" "HELM_STYLE_DIR"
+let servers_file = read_configuration_var "servers_file";;
+let uris_dbm = read_configuration_var "uris_dbm";;
+let dest = read_configuration_var "dest";;
+let indexname = read_configuration_var "indexname";;
+let tmp_dir = read_configuration_var "tmp_dir"
+let helm_dir = read_configuration_var "helm_dir";;
+let getter_url = read_configuration_var "getter_url";;
+let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL"
let _ = Hashtbl.clear vars;;
+
let read_index url =
let module C = Configuration in
- if Sys.command ("helm_wget " ^ C.tmpdir ^ " " ^ url ^ "/\"" ^
+ if Sys.command ("helm_wget " ^ C.tmp_dir ^ " " ^ url ^ "/\"" ^
C.indexname ^ "\"") <> 0
then
raise (ErrorGetting url) ;
- let tmpfilename = C.tmpdir ^ "/" ^ C.indexname in
+ let tmpfilename = C.tmp_dir ^ "/" ^ C.indexname in
let fd = open_in tmpfilename in
let uris = ref [] in
try
fn
;;
-let raw_get uri =
- let msg = new Http_client.get uri in
- msg#get_req_body
+let raw_get = ClientHTTP.get_and_save
(* get : uri -> filename *)
(* If uri is the URI of an annotation, the annotated object is processed *)
(* *)
(******************************************************************************)
+(* raw_get : uri -> dest_file -> () *)
+val raw_get : string -> string -> unit
+
(* get : uri -> filename *)
(* If uri is the URI of an annotation, the annotated object is processed *)
val get : UriManager.uri -> string
(* MAIN *)
let _ =
+ (* first of all initialize the processor by requiring the desired stylesheets *)
+ XsltProcessor.initialize () ;
build_uri_tree () ;
let output = GMathView.math_view ~width:400 ~height:380 ()
and label = GMisc.label ~text:"???" () in
(* *)
(******************************************************************************)
-let resolve =
- function
- "http://localhost:8081/getdtd?uri=cic.dtd" ->
- Configuration.dtd_dir ^ "/cic.dtd"
- | "http://localhost:8081/getdtd?uri=maththeory.dtd" ->
- Configuration.dtd_dir ^ "/maththeory.dtd"
- | "http://localhost:8081/getdtd?uri=annotations.dtd" ->
- Configuration.dtd_dir ^ "/annotations.dtd"
- | s -> s
+let resolve s =
+ let starts_with s s' =
+ if String.length s < String.length s' then
+ false
+ else
+ (String.sub s 0 (String.length s')) = s'
+ in
+ if starts_with s "http:" then
+ ClientHTTP.get_and_save_to_tmp s
+ else
+ s
;;
let url_syntax =
Sys.getenv "HELM_STYLECONFIGURATION_PATH"
with
Not_found ->
- let tmp_filename = C.tmpdir ^ "/style-configuration.xml" in
- if Sys.file_exists tmp_filename then tmp_filename
- else begin
- let styleconf = Getter.raw_get "getstyleconf" in
- let out_channel = open_out tmp_filename in
- output_string out_channel styleconf;
- close_out out_channel;
- tmp_filename
- end
+ let xml = "style-configuration.xml" in
+ let tmp_xml = Configuration.tmp_dir ^ "/" ^ xml in
+ let request_xml = Configuration.getter_url ^ "getstyleconf?uri=" ^ xml in
+ Getter.raw_get request_xml tmp_xml ;
+ tmp_xml
exception Warnings;;
let module Y = Pxp_yacc in
try
let config = {Y.default_config with Y.warner = new warner} in
- Y.parse_document_entity config (Y.from_file filename) Y.default_spec
+ Y.parse_document_entity config (PxpUriResolver.from_file filename) Y.default_spec
with
e ->
print_endline (Pxp_types.string_of_exn e) ;
Pxp_document.T_element "style" ->
let key =
try
- n#attribute "key"
+ match n#attribute "key" with
+ Pxp_types.Value s -> s
+ | _ -> raise Impossible
with
Not_found -> n#data
- Hashtbl.add styles key n#data
+ in
+ Hashtbl.add styles key n#data
| Pxp_document.T_element "apply" ->
let keys = List.map
(function n ->
match n#node_type with
- Pxp_document.T_element "style-ref" -> n#attribute "key"
+ Pxp_document.T_element "style-ref" ->
+ begin
+ match n#attribute "key" with
+ Pxp_types.Value s -> s
+ | _ -> raise Impossible
+ end
| _ -> raise Impossible
)
n#sub_nodes
in
- Hashtbl.add applies (n#attribute "name") keys
+ let apply_name =
+ match n#attribute "name" with
+ Pxp_types.Value s -> s
+ | _ -> raise Impossible
+ in Hashtbl.add applies apply_name keys
| _ -> raise Impossible
)
((xml_document ())#root#sub_nodes)
;;
let style_of_key key =
- Hashtbl.lookup styles key
+ Hashtbl.find styles key
let key_list_of_mode_name name =
- Hashtbl.lookup applies name
+ Hashtbl.find applies name
+;;
+
* http://cs.unibo.it/helm/.
*)
-exception XsltProcessorCouldNotSend;;
-exception XsltProcessorCouldNotReceive;;
+let initialize = XsltProcessorHTTP.initialize
-let initialize l =
- List.iter
- (function (name,key) ->
- client_add (Configuration.getter_url ^ "getxslt?uri=" ^ name ^ "?key=" ^ key)
- )
+let process = XsltProcessorHTTP.process
-let portserver = 12345;;
-let portclient = 12346;;
-let time_to_wait = 10;;
-
-let rec process uri usecache mode =
- let module U = Unix in
- let uri = UriManager.string_of_uri uri in
- let pid = string_of_int (U.getpid ())
- and filename' =
- let uri' = Str.replace_first (Str.regexp ".*:") "" uri in
- Str.global_replace (Str.regexp "/") "_"
- (Str.global_replace (Str.regexp "_") "__" uri')
- in let tmpfile = "/tmp/helm_" ^ filename' ^ "_" ^ pid in
- (* test if the cache can be used *)
- let tmp_file_exists = Sys.file_exists tmpfile in
- if usecache && tmp_file_exists then
- tmpfile
- else
- let url = Configuration.getter_url ^ uri in
- (* purge the cache if asked to *)
- if not usecache && tmp_file_exists then
- Sys.remove tmpfile ;
- (* let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in *)
- let string_to_send = "apply " ^ url ^ " " ^ tmpfile ^
- match mode with
- "cic" -> " C1 C2"
- | "theory" -> " T1 T2"
- in
- (* next function is for looping in case the server is not responding *)
- let socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in
- let rec contact_server () =
- let n =
- U.sendto socketserver string_to_send 0 (String.length string_to_send)
- [] (U.ADDR_INET(U.inet_addr_any,portserver))
- in
- if n = -1 then raise XsltProcessorCouldNotSend ;
- let process_signal _ = () in
- Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ;
- (* if the server does not respond, repeat the query *)
- ignore (U.alarm time_to_wait) ;
- try
- if U.recv socketserver "" 0 0 [] = -1 then
- raise XsltProcessorCouldNotReceive ;
- ignore (U.alarm 0) ; (* stop the bomb *)
- Sys.set_signal Sys.sigalrm Sys.Signal_default ;
- U.close socketserver ;
- tmpfile
- with
- U.Unix_error(_,"recv",_) ->
- print_endline "Xaland server not responding. Retrying..." ;
- flush stdout;
- contact_server ()
- in
- contact_server ()
-;;
--- /dev/null
+(* Copyright (C) 2000, HELM Team.
+ *
+ * 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://cs.unibo.it/helm/.
+ *)
+
+let initialize () =
+ Printf.printf "Initializing the UWOBO servlet, please wait" ; flush stdout ;
+ Hashtbl.iter
+ (fun key uri ->
+ let string_to_send = (Configuration.processor_url ^ "add?xsluri=" ^ Configuration.getter_url ^ "getxslt?uri=" ^ uri ^ "&key=" ^ key)
+ in
+ print_char '.' ; flush stdout ;
+ ClientHTTP.send string_to_send
+ )
+ StyleConfiguration.styles ;
+ Printf.printf " ok\n" ; flush stdout
+;;
+
+let process uri usecache mode =
+ let uri = UriManager.string_of_uri uri in
+ let url = Configuration.getter_url ^ "get?uri=" ^ uri in
+ let key_list = StyleConfiguration.key_list_of_mode_name mode in
+ let string_to_send = Configuration.processor_url ^ "apply?xmluri=" ^ url ^
+ (List.fold_right
+ (fun key cmd -> "&key=" ^ key ^ cmd)
+ key_list
+ ""
+ )
+ in
+ ClientHTTP.get_and_save_to_tmp string_to_send
+;;
+
--- /dev/null
+(* Copyright (C) 2000, HELM Team.
+ *
+ * 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://cs.unibo.it/helm/.
+ *)
+
+exception XsltProcessorCouldNotSend;;
+exception XsltProcessorCouldNotReceive;;
+
+let initialize () =
+ Hashtbl.iter
+ (fun key uri ->
+ ignore (Sys.command ("uwobo-client add " ^ uri ^ " " ^ key))
+ )
+ StyleConfiguration.styles
+;;
+
+let _ = initialize () ;;
+
+let portserver = 12345;;
+let portclient = 12346;;
+let time_to_wait = 10;;
+
+let rec process uri usecache mode =
+ let module U = Unix in
+ let uri = UriManager.string_of_uri uri in
+ let pid = string_of_int (U.getpid ())
+ and filename' =
+ let uri' = Str.replace_first (Str.regexp ".*:") "" uri in
+ Str.global_replace (Str.regexp "/") "_"
+ (Str.global_replace (Str.regexp "_") "__" uri')
+ in let tmpfile = Configuration.tmp_dir ^ "/helm_" ^ filename' ^ "_" ^ pid in
+ (* test if the cache can be used *)
+ let tmp_file_exists = Sys.file_exists tmpfile in
+ if usecache && tmp_file_exists then
+ tmpfile
+ else
+ let url = Configuration.getter_url ^ uri in
+ (* purge the cache if asked to *)
+ if not usecache && tmp_file_exists then
+ Sys.remove tmpfile ;
+ (* let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in *)
+ let string_to_send = "apply " ^ url ^ " " ^ tmpfile ^
+ match mode with
+ "cic" -> " C1 C2"
+ | "theory" -> " T1 T2"
+ in
+ (* next function is for looping in case the server is not responding *)
+ let socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in
+ let rec contact_server () =
+ let n =
+ U.sendto socketserver string_to_send 0 (String.length string_to_send)
+ [] (U.ADDR_INET(U.inet_addr_any,portserver))
+ in
+ if n = -1 then raise XsltProcessorCouldNotSend ;
+ let process_signal _ = () in
+ Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ;
+ (* if the server does not respond, repeat the query *)
+ ignore (U.alarm time_to_wait) ;
+ try
+ if U.recv socketserver "" 0 0 [] = -1 then
+ raise XsltProcessorCouldNotReceive ;
+ ignore (U.alarm 0) ; (* stop the bomb *)
+ Sys.set_signal Sys.sigalrm Sys.Signal_default ;
+ U.close socketserver ;
+ tmpfile
+ with
+ U.Unix_error(_,"recv",_) ->
+ print_endline "Xaland server not responding. Retrying..." ;
+ flush stdout;
+ contact_server ()
+ in
+ contact_server ()
+;;
projects / helm.git / commitdiff