X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Finterface%2FxsltProcessor.ml;h=3d3690f395154b8c76bd680e7700c736db3a3039;hb=4ef40e8fb4de63f9699268b389f052007bc87f54;hp=ec3d9fdb05c8f4c18462e2ae7a183324f414fd43;hpb=952ad2bf8ea4bea5999570f0f592f84bf30acd3f;p=helm.git diff --git a/helm/interface/xsltProcessor.ml b/helm/interface/xsltProcessor.ml index ec3d9fdb0..3d3690f39 100644 --- a/helm/interface/xsltProcessor.ml +++ b/helm/interface/xsltProcessor.ml @@ -23,7 +23,61 @@ * http://cs.unibo.it/helm/. *) -let initialize = XsltProcessorHTTP.initialize +exception XsltProcessorCouldNotSend;; +exception XsltProcessorCouldNotReceive;; -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 () +;;