X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matitaB%2Fmatita%2Fmatitadaemon.ml;h=fc8c9684e87534819f855ba1786723c347738e2a;hb=0fea4ed429678c3293027cfe76fdbe15cfa331cb;hp=1e5a0c70037b8308d27ae73fa3a10005601ffdba;hpb=c81b0e8dbfe80e2350e9322afa8316f39f98c3b3;p=helm.git

diff --git a/matitaB/matita/matitadaemon.ml b/matitaB/matita/matitadaemon.ml
index 1e5a0c700..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 ***)
@@ -213,6 +218,26 @@ let eval_statement include_paths (* (buffer : GText.buffer) *) status (* script
   in
   
   match ast with
+  | GrafiteAst.Executable (_,
+      GrafiteAst.NCommand (_,
+        GrafiteAst.NObj (loc, astobj,_))) ->
+          let objname = NotationPt.name_of_obj astobj in
+          let status = 
+            MatitaEngine.eval_ast ~include_paths ~do_heavy_checks:false status ("",0,ast)
+          in
+          let new_parsed_text = Ulexing.from_utf8_string parsed_text in
+          let interpr = GrafiteDisambiguate.get_interpr status#disambiguate_db in
+          let outstr = ref "" in
+          ignore (SmallLexer.mk_small_printer interpr outstr new_parsed_text);
+          let x, y = HExtlib.loc_of_floc floc in
+          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\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
   | GrafiteAst.Executable (_,
       GrafiteAst.NTactic (_,
         [GrafiteAst.NAuto (_, (l,a as auto_params))])) when is_auto auto_params
@@ -362,6 +387,7 @@ let retrieve (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
       ~content_type:"text/xml; charset=\"utf-8\""
       ();
     *)
+    let readonly = cgi # argument_value "readonly" in
     let filename = libdir uid ^ "/" ^ (cgi # argument_value "file") in
     (* prerr_endline ("reading file " ^ filename); *)
     let body = 
@@ -386,16 +412,23 @@ let retrieve (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
        with 
          Librarian.NoRootFor _ | Librarian.FileNotFound _ -> "",[] in
     include_paths := incpaths;
-    let status = (MatitaAuthentication.get_status sid)#set_baseuri baseuri in
-    let history = [status] in
-    MatitaAuthentication.set_status sid status;
-    MatitaAuthentication.set_history sid history;
+    if readonly <> "true" then
+       (let status = new MatitaEngine.status (Some uid) baseuri in
+        let history = [status] in
+        MatitaAuthentication.set_status sid status;
+        MatitaAuthentication.set_history sid history);
     cgi # set_header 
       ~cache:`No_cache 
       ~content_type:"text/xml; charset=\"utf-8\""
       ();
     cgi#out_channel#output_string body;
   with
+  | Sys_error _ -> 
+    cgi # set_header 
+      ~cache:`No_cache 
+      ~content_type:"text/xml; charset=\"utf-8\""
+      ();
+    cgi#out_channel#output_string "<error />"
   | Not_found _ -> 
     cgi # set_header
       ~status:`Internal_server_error
@@ -450,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
@@ -541,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
 
@@ -564,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
   
@@ -597,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
   
@@ -628,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 
@@ -653,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 
@@ -707,6 +743,10 @@ let save  (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     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
@@ -715,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 ("<response>" ^ estr ^ "</response>"));
   cgi#out_channel#commit_work()
@@ -727,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\""
@@ -737,6 +782,13 @@ let initiate_commit (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     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
@@ -746,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
@@ -780,6 +832,13 @@ let svn_update  (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     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
@@ -820,9 +879,16 @@ let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
       ();
     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\""
@@ -835,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 = "<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
@@ -845,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  *)
@@ -906,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";
@@ -943,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  
@@ -988,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
   
@@ -1028,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