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 portserver = 12345;;
  30 let portclient = 12346;;
  31 let time_to_wait = 10;;
  32
  33 let rec process uri usecache mode =
  34  let module U = Unix in
  35   let uri = UriManager.string_of_uri uri in
  36   let pid = string_of_int (U.getpid ())
  37   and filename' =
  38    let uri' = Str.replace_first (Str.regexp ".*:") "" uri in
  39     Str.global_replace (Str.regexp "/") "_"
  40      (Str.global_replace (Str.regexp "_") "__" uri')
  41   in let tmpfile = "/tmp/helm_" ^ filename' ^ "_" ^ pid in
  42    (* test if the cache can be used *)
  43    let tmp_file_exists = Sys.file_exists tmpfile in
  44     if usecache && tmp_file_exists then
  45      tmpfile
  46     else
  47      let url = Configuration.getter_url ^ uri in
  48       (* purge the cache if asked to *)
  49       if not usecache && tmp_file_exists then
  50         Sys.remove tmpfile ;
  51       (* let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in *)
  52       let string_to_send = "apply " ^ url ^ " " ^ tmpfile ^
  53        match mode with
  54           "cic" -> " C1 C2"
  55         | "theory" -> " T1 T2"
  56       in
  57       (* next function is for looping in case the server is not responding *)
  58        let socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in
  59         let rec contact_server () =
  60          let n =
  61           U.sendto socketserver string_to_send 0 (String.length string_to_send)
  62            [] (U.ADDR_INET(U.inet_addr_any,portserver))
  63          in
  64           if n = -1 then raise XsltProcessorCouldNotSend ;
  65           let process_signal _ = () in
  66           Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ;
  67           (* if the server does not respond, repeat the query *)
  68           ignore (U.alarm time_to_wait) ;
  69           try
  70            if U.recv socketserver "" 0 0 [] = -1 then
  71             raise XsltProcessorCouldNotReceive ;
  72            ignore (U.alarm 0) ; (* stop the bomb *)
  73            Sys.set_signal Sys.sigalrm Sys.Signal_default ;
  74            U.close socketserver ;
  75            tmpfile
  76           with
  77            U.Unix_error(_,"recv",_) ->
  78             print_endline "Xaland server not responding. Retrying..." ;
  79             flush stdout;
  80             contact_server ()
  81         in
  82          contact_server ()
  83 ;;