X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=matitaB%2Fmatita%2Fmatitadaemon.ml;h=fc8c9684e87534819f855ba1786723c347738e2a;hb=06d5ff2316426acfb16a9cc9784d40ce19351771;hp=261811815d3c1705d41de529c789ac19cb9ad4a9;hpb=71204a8e8d1084c94adfbcf9264f71ab85f3621e;p=helm.git
diff --git a/matitaB/matita/matitadaemon.ml b/matitaB/matita/matitadaemon.ml
index 261811815..fc8c9684e 100644
--- a/matitaB/matita/matitadaemon.ml
+++ b/matitaB/matita/matitadaemon.ml
@@ -3,6 +3,7 @@ open Http_types;;
exception Emphasized_error of string
exception Disamb_error of string
+exception Generic_error of string
module Stack = Continuationals.Stack
@@ -41,7 +42,7 @@ let add_user_for_commit uid =
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 ->
@@ -146,7 +147,11 @@ let do_global_commit () =
(* 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 ***)
@@ -228,8 +233,8 @@ let eval_statement include_paths (* (buffer : GText.buffer) *) status (* script
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
@@ -478,6 +483,8 @@ let advance0 sid text =
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
@@ -569,7 +576,8 @@ let advance0 sid text =
| 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
@@ -592,7 +600,7 @@ let advance0 sid text =
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
@@ -625,7 +633,7 @@ let register (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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
@@ -656,7 +664,7 @@ let login (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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
@@ -681,7 +689,7 @@ let logout (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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
@@ -735,6 +743,10 @@ let save (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
cgi#out_channel#output_string "ok"
with
| File_already_exists ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
cgi#out_channel#output_string "cancelled"
| Sys_error _ ->
cgi # set_header
@@ -743,6 +755,10 @@ let save (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
~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 ("" ^ estr ^ ""));
cgi#out_channel#commit_work()
@@ -755,7 +771,8 @@ let initiate_commit (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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\""
@@ -765,6 +782,13 @@ let initiate_commit (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
cgi#out_channel#output_string ("" ^ out ^ " ");
cgi#out_channel#output_string ""
with
+ | Failure _ ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ "no commit privileges"
| Not_found _ ->
cgi # set_header
~status:`Internal_server_error
@@ -774,7 +798,7 @@ let initiate_commit (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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
@@ -808,6 +832,13 @@ let svn_update (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
cgi#out_channel#output_string ("" ^ details ^ " ");
cgi#out_channel#output_string "";
with
+ | Failure _ ->
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ "no commit privileges"
| Not_found _ ->
cgi # set_header
~status:`Internal_server_error
@@ -848,9 +879,16 @@ let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
();
cgi#out_channel#output_string body
with
+ | Generic_error text ->
+ let body = "" ^ text ^ "" 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 = "" ^ text ^ "" in
+ let body = "" ^ text ^ "" in
cgi # set_header
~cache:`No_cache
~content_type:"text/xml; charset=\"utf-8\""
@@ -863,6 +901,13 @@ let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
~content_type:"text/xml; charset=\"utf-8\""
();
cgi#out_channel#output_string body
+ | End_of_file _ ->
+ let body = "" 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
@@ -873,7 +918,7 @@ let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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 *)
@@ -934,7 +979,7 @@ let gotoBottom (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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";
@@ -971,7 +1016,7 @@ let gotoTop (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
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
@@ -1016,7 +1061,7 @@ let retract (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
;;
-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
@@ -1056,7 +1101,7 @@ let viewLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
;;
-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