-(* Copyright (C) 2000, HELM Team.
+(* Copyright (C) 2002, HELM Team.
*
* This file is part of HELM, an Hypertextual, Electronic
* Library of Mathematics, developed at the Computer Science
* http://cs.unibo.it/helm/.
*)
-let main () =
- let usage_msg =
- "
-usage: proofChecker[.opt]
-The proof-checker reads from the stdin one URI at a time and proof-checks it.
-
-List of options:"
- in
- Arg.parse []
- (fun _ ->
- begin
- prerr_string "Error: no options expected.\n" ;
- Arg.usage [] usage_msg ;
- exit (-1)
- end
- ) usage_msg ;
+open Printf;;
+
+let default_port = 48084;;
+
+let port =
try
- while true do
- begin
- try
- CicTypeChecker.typecheck (UriManager.uri_of_string (read_line ()))
- with
- End_of_file -> raise End_of_file
- | e ->
- print_newline() ;
- flush stdout ;
- raise e
- end ;
- print_endline "END"
- done
+ int_of_string (Sys.getenv "PROOF_CHECKER_PORT")
with
- End_of_file -> ()
-;;
+ | Not_found -> default_port
+ | Failure "int_of_string" ->
+ prerr_endline "Warning: invalid port, reverting to default";
+ default_port
+in
+
+let (html_preamble, html_postamble) =
+ ((fun uri ->
+ (sprintf
+"<html>
+<head>
+ <title>Proof-Checking %s</title>
+</head>
+<body bgcolor=\"white\">
+<h1>Proof-Checking %s:</h1>
+"
+ uri uri)),
+("<h1>Done.</h1>
+</body>
+</html>
+END
+"))
+in
+
+let bad_request outchan =
+ printf "INVALID REQUEST !!!!!\n\n";
+ flush stdout;
+ Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan;
+ flush outchan
+in
+
+let callback req outchan =
+ match req#path with
+ | "/proofCheck" ->
+ begin
+ Logger.log_callback :=
+ (Logger.log_to_html
+ ~print_and_flush:(fun s -> fprintf outchan "%s" s; flush outchan));
+ try
+ let uri = req#param "uri" in
+ printf "Request to proof-check \"%s\"..." uri;
+ flush stdout;
+ fprintf outchan "%s" (html_preamble uri);
+ flush outchan;
+ (try
+ CicTypeChecker.typecheck (UriManager.uri_of_string uri);
+ with e ->
+ fprintf outchan "%s\n" (Printexc.to_string e);
+ flush outchan);
+ fprintf outchan "%s" html_postamble;
+ flush outchan;
+ printf " done\n\n";
+ flush stdout
+ with Not_found -> (* 'uri' argument not found *)
+ bad_request outchan
+ end
+ | req -> bad_request outchan
+
+in
+
+CicCooking.init();
+printf "Proof Checker started and listening on port %d\n" port;
+flush stdout;
+Http_daemon.start' ~port callback;
+printf "Proof Checker is terminating, bye!\n"
-CicCooking.init() ;
-main ();;
projects / helm.git / blobdiff