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