helm/interface/xsltProcessor.ml

   1 (* Copyright (C) 2000, HELM Team.
   2  *
   3  * This file is part of HELM, an Hypertextual, Electronic
   4  * Library of Mathematics, developed at the Computer Science
   5  * Department, University of Bologna, Italy.
   6  *
   7  * HELM is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License
   9  * as published by the Free Software Foundation; either version 2
  10  * of the License, or (at your option) any later version.
  11  *
  12  * HELM is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with HELM; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://cs.unibo.it/helm/.
  24  *)
  25
  26 exception XsltProcessorCouldNotSend;;
  27 exception XsltProcessorCouldNotReceive;;
  28
  29 let initialize l =
  30  List.iter
  31   (function (name,key) ->
  32     client_add (Configuration.getter_url ^ "getxslt?uri=" ^ name ^ "?key=" ^ key)
  33   )
  34
  35 let portserver = 12345;;
  36 let portclient = 12346;;
  37 let time_to_wait = 10;;
  38
  39 let rec process uri usecache mode =
  40  let module U = Unix in
  41   let uri = UriManager.string_of_uri uri in
  42   let pid = string_of_int (U.getpid ())
  43   and filename' =
  44    let uri' = Str.replace_first (Str.regexp ".*:") "" uri in
  45     Str.global_replace (Str.regexp "/") "_"
  46      (Str.global_replace (Str.regexp "_") "__" uri')
  47   in let tmpfile = "/tmp/helm_" ^ filename' ^ "_" ^ pid in
  48    (* test if the cache can be used *)
  49    let tmp_file_exists = Sys.file_exists tmpfile in
  50     if usecache && tmp_file_exists then
  51      tmpfile
  52     else
  53      let url = Configuration.getter_url ^ uri in
  54       (* purge the cache if asked to *)
  55       if not usecache && tmp_file_exists then
  56         Sys.remove tmpfile ;
  57       (* let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in *)
  58       let string_to_send = "apply " ^ url ^ " " ^ tmpfile ^
  59        match mode with
  60           "cic" -> " C1 C2"
  61         | "theory" -> " T1 T2"
  62       in
  63       (* next function is for looping in case the server is not responding *)
  64        let socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in
  65         let rec contact_server () =
  66          let n =
  67           U.sendto socketserver string_to_send 0 (String.length string_to_send)
  68            [] (U.ADDR_INET(U.inet_addr_any,portserver))
  69          in
  70           if n = -1 then raise XsltProcessorCouldNotSend ;
  71           let process_signal _ = () in
  72           Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ;
  73           (* if the server does not respond, repeat the query *)
  74           ignore (U.alarm time_to_wait) ;
  75           try
  76            if U.recv socketserver "" 0 0 [] = -1 then
  77             raise XsltProcessorCouldNotReceive ;
  78            ignore (U.alarm 0) ; (* stop the bomb *)
  79            Sys.set_signal Sys.sigalrm Sys.Signal_default ;
  80            U.close socketserver ;
  81            tmpfile
  82           with
  83            U.Unix_error(_,"recv",_) ->
  84             print_endline "Xaland server not responding. Retrying..." ;
  85             flush stdout;
  86             contact_server ()
  87         in
  88          contact_server ()
  89 ;;