]> matita.cs.unibo.it Git - helm.git/blob - helm/interface/xsltProcessor.ml
Requires and Provides now fixed
[helm.git] / helm / interface / xsltProcessor.ml
1 exception XsltProcessorCouldNotSend;;
2 exception XsltProcessorCouldNotReceive;;
3
4 let portserver = 12345;;
5 let portclient = 12346;;
6 let time_to_wait = 10;;
7
8 let rec process uri usecache mode =
9  let module U = Unix in
10   let uri = UriManager.string_of_uri uri in
11   let pid = string_of_int (U.getpid ())
12   and filename' =
13    let uri' = Str.replace_first (Str.regexp ".*:") "" uri in
14     Str.global_replace (Str.regexp "/") "_"
15      (Str.global_replace (Str.regexp "_") "__" uri')
16   in let tmpfile = "/tmp/helm_" ^ filename' ^ "_" ^ pid in
17    (* test if the cache can be used *)
18    let tmp_file_exists = Sys.file_exists tmpfile in
19     if usecache && tmp_file_exists then
20      tmpfile
21     else
22      let url = Configuration.getter_url ^ uri in
23       (* purge the cache if asked to *)
24       if not usecache && tmp_file_exists then
25         Sys.remove tmpfile ;
26       let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in
27       (* next function is for looping in case the server is not responding *)
28       let rec contact_server () =
29        let socketclient = U.socket U.PF_INET U.SOCK_DGRAM 0
30        and socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in
31         let bounded = ref false in
32          while not !bounded do
33           try
34            U.bind socketclient (U.ADDR_INET(U.inet_addr_any,portclient)) ;
35            bounded := true
36           with _ ->
37            print_endline "Port unavailable. Retrying..." ; flush stdout ;
38            U.sleep 5  (* wait hoping the inetaddr is released *)
39          done ;
40          let n =
41           U.sendto socketserver string_to_send 0 (String.length string_to_send)
42            [] (U.ADDR_INET(U.inet_addr_any,portserver))
43          in
44           if n = -1 then raise XsltProcessorCouldNotSend ;
45           U.close socketserver ;
46           let process_signal _ = U.close socketclient in
47           Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ;
48           (* if the server does not respond, repeat the query *)
49           ignore (U.alarm time_to_wait) ;
50           try
51            if U.recv socketclient "" 0 0 [] = -1 then
52             raise XsltProcessorCouldNotReceive ;
53            ignore (U.alarm 0) ; (* stop the bomb *)
54            Sys.set_signal Sys.sigalrm Sys.Signal_default ;
55            U.close socketclient ;
56            tmpfile
57           with
58            U.Unix_error(_,"recv",_) ->
59             print_endline "Xaland server not responding. Retrying..." ;
60             flush stdout;
61             contact_server ()
62         in
63          contact_server ()
64 ;;