exception Emphasized_error of string
exception Disamb_error of string
+exception Generic_error of string
module Stack = Continuationals.Stack
Mutex.unlock mutex;
;;
-let do_global_commit () =
+let do_global_commit (* () *) uid =
prerr_endline ("to be committed: " ^ String.concat " " !to_be_committed);
List.fold_left
(fun out u ->
(* XXX: at the moment, we don't keep track of the order in which users have
scheduled their commits, but we should, otherwise we will get a
"first come, random served" policy *)
- "" (* (List.rev !to_be_committed) *) (MatitaAuthentication.get_users ())
+ "" (* (List.rev !to_be_committed) *)
+ (* replace [uid] to commit all users:
+ (MatitaAuthentication.get_users ())
+ *)
+ [uid]
;;
(*** from matitaScript.ml ***)
let pre = Netconversion.ustring_sub `Enc_utf8 0 x !outstr in
let post = Netconversion.ustring_sub `Enc_utf8 x
(Netconversion.ustring_length `Enc_utf8 !outstr - x) !outstr in
- outstr := Printf.sprintf
- "%s\005input type=\"radio\" class=\"anchor\" id=\"%s\" /\006%s" pre objname post;
+ outstr := Printf.sprintf
+ "%s\005img class=\"anchor\" src=\"icons/tick.png\" id=\"%s\" /\006%s" pre objname post;
prerr_endline ("baseuri after advance = " ^ status#baseuri);
(* prerr_endline ("parser output: " ^ !outstr); *)
(status,!outstr, unparsed_txt'),parsed_text_len
let status = status#reset_disambiguate_db () in
let (st,new_statements,new_unparsed),parsed_len =
let rec do_exc = function
+ | MatitaEngine.EnrichedWithStatus (e,_) -> do_exc e
+ | NCicTypeChecker.TypeCheckerFailure s -> raise (Generic_error (Lazy.force s))
| HExtlib.Localized (floc,e) ->
let x, y = HExtlib.loc_of_floc floc in
let pre = Netconversion.ustring_sub `Enc_utf8 0 x text in
| GrafiteDisambiguate.Error l -> raise (Disamb_error (xml_of_disamb_error l))
(* | End_of_file -> ... *)
| e ->
- prerr_endline ("matitadaemon *** Unhandled exception " ^ Printexc.to_string e);
+ (* prerr_endline ("matitadaemon *** Unhandled exception " ^ Printexc.to_string e); *)
+ prerr_endline ("matitadaemon *** Unhandled exception " ^ snd (MatitaExcPp.to_string e));
raise e
in
Netencoding.Html.encode ~in_enc:`Enc_utf8 ~prefer_name:false
() (html_of_matita new_statements), new_unparsed, st
-let register (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let register (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let _env = cgi#environment in
cgi#out_channel#commit_work()
;;
-let login (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let login (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
cgi#out_channel#commit_work()
;;
-let logout (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let logout (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
(try
exception File_already_exists;;
-let save (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let save (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
(try
cgi#out_channel#output_string "<response>ok</response>"
with
| File_already_exists ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
cgi#out_channel#output_string "<response>cancelled</response>"
| Sys_error _ ->
cgi # set_header
~content_type:"text/xml; charset=\"utf-8\""
()
| e ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
let estr = Printexc.to_string e in
cgi#out_channel#output_string ("<response>" ^ estr ^ "</response>"));
cgi#out_channel#commit_work()
let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
let sid = HExtlib.unopt sid in
MatitaAuthentication.probe_commit_priv sid;
- let out = do_global_commit () in
+ let uid = MatitaAuthentication.user_of_session sid in
+ let out = do_global_commit (* () *) uid in
cgi # set_header
~cache:`No_cache
~content_type:"text/xml; charset=\"utf-8\""
cgi#out_channel#output_string ("<details>" ^ out ^ "</details>");
cgi#out_channel#output_string "</commit>"
with
+ | Failure _ ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ "<commit><error>no commit privileges</error></commit>"
| Not_found _ ->
cgi # set_header
~status:`Internal_server_error
cgi#out_channel#commit_work()
;;
-let svn_update (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let svn_update (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
cgi#out_channel#output_string ("<details>" ^ details ^ "</details>");
cgi#out_channel#output_string "</update>";
with
+ | Failure _ ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ "<commit><error>no commit privileges</error></commit>"
| Not_found _ ->
cgi # set_header
~status:`Internal_server_error
();
cgi#out_channel#output_string body
with
+ | Generic_error text ->
+ let body = "<response><error>" ^ text ^ "</error></response>" in
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string body
| Emphasized_error text ->
(* | MultiPassDisambiguator.DisambiguationError (offset,errorll) -> *)
- let body = "<response><error>" ^ text ^ "</error></response>" in
+ let body = "<response><localized>" ^ text ^ "</localized></response>" in
cgi # set_header
~cache:`No_cache
~content_type:"text/xml; charset=\"utf-8\""
~content_type:"text/xml; charset=\"utf-8\""
();
cgi#out_channel#output_string body
+ | End_of_file _ ->
+ let body = "<response><parsed length=\"0\"></parsed></response>" in
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string body
| Not_found _ ->
cgi # set_header
~status:`Internal_server_error
cgi#out_channel#commit_work()
;;
-let gotoBottom (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let gotoBottom (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
(* (try *)
cgi#out_channel#commit_work()
;;
-let gotoTop (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let gotoTop (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
prerr_endline "executing goto Top";
cgi#out_channel#commit_work()
;;
-let retract (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let retract (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
(try
;;
-let viewLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let viewLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
let env = cgi#environment in
;;
-let resetLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+let resetLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
MatitaAuthentication.reset ();
cgi # set_header