From: Luca Padovani Date: Fri, 17 Oct 2003 14:01:18 +0000 (+0000) Subject: * added daemon X-Git-Tag: V_0_2_2~49 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=e325d6831ba5bbad0c8892072ffdedf50aa10b39;p=helm.git * added daemon * fixed minor bugs --- diff --git a/helm/DEVEL/rdfly/Makefile b/helm/DEVEL/rdfly/Makefile index 133763e62..92fdb740e 100644 --- a/helm/DEVEL/rdfly/Makefile +++ b/helm/DEVEL/rdfly/Makefile @@ -1,5 +1,5 @@ BIN_DIR = /usr/local/bin -REQUIRES = postgres +REQUIRES = postgres http PREDICATES = OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -pp camlp4o OCAMLFIND = ocamlfind diff --git a/helm/DEVEL/rdfly/query.ml b/helm/DEVEL/rdfly/query.ml index 8e4ceb8ff..f63d780cb 100644 --- a/helm/DEVEL/rdfly/query.ml +++ b/helm/DEVEL/rdfly/query.ml @@ -1,16 +1,105 @@ module PG = Postgres -let db = +let open_db connection_string = try - new PG.connection "dbname='mowgli_test' user='helm' host='mowgli.cs.unibo.it'" + new PG.connection connection_string with PG.Error e as exc -> prerr_endline (PG.string_of_error e) ; raise exc -let res = db#exec "SELECT * FROM refObj WHERE source = 'cic:/Coq/Arith/Le/le_O_n.con';" +let extract_position s = + let sharp_pos = String.rindex s '#' + 1 in + String.sub s sharp_pos ((String.length s) - sharp_pos) + +let mk_new_msg () = ref [] + +let msg_output_string msg s = msg := s::!msg + +let msg_serialize msg = + List.fold_left (fun acc s -> s ^ acc) "" !msg + +let msg_output_header msg obj = + msg_output_string msg "\n\n" ; + msg_output_string msg ("\n \n") + +let msg_output_trailer msg = + msg_output_string msg " \n\n" + +let forward_metadata db obj = + let res = db#exec ("SELECT * FROM refObj WHERE source = '" ^ obj ^ "';") in + let msg = mk_new_msg () in + msg_output_header msg obj ; + for i = res#ntuples downto 1 do + let position = extract_position (res#getvalue (i - 1) 2) + and occurrence = res#getvalue (i - 1) 1 in + msg_output_string msg " \n \n" ; + msg_output_string msg (" " ^ position ^ "\n") ; + msg_output_string msg (" " ^ occurrence ^ "\n") ; + msg_output_string msg " \n \n" + done ; + msg_output_trailer msg ; + msg_serialize msg + +let backward_metadata db obj = + let res = db#exec ("SELECT * FROM refObj WHERE h_occurrence = '" ^ obj ^ "';") in + let msg = mk_new_msg () in + msg_output_header msg obj ; + for i = res#ntuples downto 1 do + let position = extract_position (res#getvalue (i - 1) 2) + and occurrence = res#getvalue (i - 1) 0 in + msg_output_string msg " \n \n" ; + msg_output_string msg (" " ^ position ^ "\n") ; + msg_output_string msg (" " ^ occurrence ^ "\n") ; + msg_output_string msg " \n \n" + done ; + msg_output_trailer msg ; + msg_serialize msg + +let debug_print s = prerr_endline ("[RDFly] " ^ s) + +let mk_return_fun contype msg outchan = + Http_daemon.respond + ~body:msg ~headers:["Content-Type", contype] outchan + +let return_html = mk_return_fun "text/html" +let return_xml = mk_return_fun "text/xml" +let return_400 body ch = Http_daemon.respond_error ~code:400 ~body ch +let return_html_error s = return_html ("" ^ s ^ "") + +let callback (req: Http_types.request) ch = + try + debug_print ("Connection from " ^ req#clientAddr) ; + debug_print ("Received request: " ^ req#path) ; + (match req#path with + | "/help" -> + return_html_error "yeah right..." ch + | "/get" -> + let obj = req#param "object" + and kind = req#param "kind" in + let db = open_db "dbname='mowgli' user='helm'" in + begin + match kind with + "forward" -> return_xml (forward_metadata db obj) ch + | "backward" -> return_xml (backward_metadata db obj) ch + | s -> return_html_error ("unsupported kind: " ^ s) ch + end ; + db#close + | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) ch) + with + | Http_types.Param_not_found attr_name -> + return_400 (Printf.sprintf "Parameter '%s' is missing" attr_name) ch + | exc -> + return_html_error ("Uncaught exception: " ^ (Printexc.to_string exc)) ch + +let main () = + Sys.catch_break true; + try + Http_daemon.start' + ~timeout:(Some 600) ~port:58088 callback + with Sys.Break -> () +in + +main () -let _ = - Printf.printf "# results: %d\n" (res#ntuples) ; - flush stdout