]> matita.cs.unibo.it Git - helm.git/commitdiff
Added generation of HTML representation of the library.
authorWilmer Ricciotti <ricciott@cs.unibo.it>
Tue, 21 Jun 2011 14:58:49 +0000 (14:58 +0000)
committerWilmer Ricciotti <ricciott@cs.unibo.it>
Tue, 21 Jun 2011 14:58:49 +0000 (14:58 +0000)
matitaB/matita/Makefile
matitaB/matita/matitaAuthentication.ml
matitaB/matita/matitaFilesystem.ml
matitaB/matita/matitaFilesystem.mli
matitaB/matita/matitadaemon.ml

index d0219f43002e2235814944857e0324dcc8e2820a..ed24d2c6149a974bfcaf794ac30d7bc4e91d7db7 100644 (file)
@@ -67,8 +67,8 @@ WMLI =                                \
        matitaEngine.mli        \
        matitaExcPp.mli         \
        matitaInit.mli          \
-       matitaAuthentication.mli \
        matitaFilesystem.mli    \
+       matitaAuthentication.mli \
        $(NULL)
 MAINCMLI =                     \
        matitaclean.mli         \
@@ -95,17 +95,17 @@ ULEXDIR := $(shell $(OCAMLFIND) query ulex08)
 
 matitaScriptLexer.cmo: SYNTAXOPTIONS = -pp "camlp5o -I $(UTF8DIR) -I $(ULEXDIR) pa_extend.cmo pa_ulex.cma pa_unicode_macro.cma -loc loc"
 
-matitaAuthentication.cmi: matitaAuthentication.mli
+matitaFilesystem.cmi: matitaFilesystem.mli
        $(H)echo "  OCAMLC $<"
        $(H)$(OCAMLC) $(WPKGS) -c $<
-matitaAuthentication.cmo: matitaAuthentication.ml
+matitaFilesystem.cmo: matitaFilesystem.ml
        $(H)echo "  OCAMLC $<"
        $(H)$(OCAMLC) $(WPKGS) -c $<
 
-matitaFilesystem.cmi: matitaFilesystem.mli
+matitaAuthentication.cmi: matitaAuthentication.mli
        $(H)echo "  OCAMLC $<"
        $(H)$(OCAMLC) $(WPKGS) -c $<
-matitaFilesystem.cmo: matitaFilesystem.ml
+matitaAuthentication.cmo: matitaAuthentication.ml
        $(H)echo "  OCAMLC $<"
        $(H)$(OCAMLC) $(WPKGS) -c $<
 
index 7d6471df5b4848bade59340b548e2431e7cd4269..8b23cc948e72f0325e778d1c9bb48599db44ceec 100644 (file)
@@ -114,6 +114,7 @@ let add_user uid pw =
     let _ = lookup_user uid in
     raise (UsernameCollision uid)
   with Not_found -> 
+    MatitaFilesystem.checkout uid;
     user_tbl := (uid,(pw,None))::!user_tbl;
     serialize ()
 ;;
index 1809627ca0a2543c607daaa0479f68b7ae434aa1..fe67b256b714dcebfdc66eae1ab404125b7f3979 100644 (file)
@@ -23,6 +23,8 @@
  * http://helm.cs.unibo.it/
  *)
 
+exception SvnError of string;;
+
 let exec_process cmd =
   let (stdout, stdin, stderr) as chs = Unix.open_process_full cmd [||] in
   let outlines = ref [] in
@@ -50,8 +52,49 @@ let checkout user =
   let rt_dir = Helm_registry.get "matita.rt_base_dir" in
   let repo = Helm_registry.get "matita.weblib" in
 
-  let errno, outstr = 
-    exec_process ("svn co " ^ repo ^ " " ^ rt_dir ^ "/" ^ user ^ "/scripts")
+  let errno, outstr = exec_process 
+    ("svn co " ^ repo ^ " " ^ rt_dir ^ "/users/" ^ user ^ "/scripts")
+  in
+  if errno = 0 then ()
+  else raise (SvnError outstr)
+
+let html_of_library uid =
+  let i = ref 0 in
+  let newid () = incr i; ("node" ^ string_of_int !i) in
+
+  let branch text acc =
+    let id = newid () in
+    "<span class=\"trigger\" onClick=\"showBranch(" ^ id ^ ")\">\n" ^
+    "<img src=\"treeview/closed.gif\" id=\"I" ^ id ^ "\"/>\n" ^
+    text ^ "<br/></span>\n" ^
+    "<span class=\"branch\" id=\"" ^ id ^ "\">\n" ^
+    acc ^ "\n</span>"
   in
-  if errno = 0 then "checkout successful!"
-  else "checkout error!\n\n" ^ outstr
+  let leaf text link =
+    "<img src=\"treeview/doc.gif\"/>\n" ^
+    "<a href=\"" ^ link ^ "\">" ^ text ^ "</a><br/>"
+  in
+
+  let rec aux path =
+    let dirlist = Array.to_list (Sys.readdir path) in
+    let subdirs = List.filter Sys.is_directory dirlist in
+    let scripts = 
+      List.filter (fun x -> 
+        try
+          let i = String.rindex x '.' in
+          not (Sys.is_directory x) && (String.sub x i 3 = ".ma")
+        with Not_found | Invalid_argument _ -> false) dirlist in
+    let subdirtags = 
+      String.concat "\n" (List.map (fun x -> aux (path ^ "/" ^ x)) subdirs) in
+    let scripttags =
+      String.concat "\n" 
+       (List.map (fun x -> leaf x (path ^ "/" ^ x)) scripts)
+    in
+    branch (Filename.basename path) (subdirtags ^ "\n" ^ scripttags)
+  in
+
+  let basedir = (Helm_registry.get "matita.rt_base_dir") ^ "/lib/" ^ uid ^ "/" in
+  let res = aux basedir in
+  prerr_endline "BEGIN TREE";prerr_endline res;prerr_endline "END TREE";
+  res
+;;
index eba9d1dde941e6a6fb99aca59be75c03e476a7cd..e04500e284e0e7c8840a3b1debb12945db2ad8c6 100644 (file)
@@ -1 +1,5 @@
-val checkout : string -> string
+exception SvnError of string;;
+
+val checkout : string -> unit
+
+val html_of_library : string -> string
index 840442665e9c047806a9d05243587f3e345ad314..744034e060ba1c7c7f4c638584cbd865448a4861 100644 (file)
@@ -228,13 +228,22 @@ let register (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
   (try 
     MatitaAuthentication.add_user uid userpw;
     env#set_output_header_field "Location" "/index.html"
-   with MatitaAuthentication.UsernameCollision _ ->
-    cgi#set_header
-      ~cache:`No_cache 
-      ~content_type:"text/html; charset=\"utf-8\""
-      ();
-    cgi#out_channel#output_string
-      "<html><head></head><body>Error: User id collision!</body></html>");
+   with
+   | MatitaAuthentication.UsernameCollision _ ->
+      cgi#set_header
+       ~cache:`No_cache 
+       ~content_type:"text/html; charset=\"utf-8\""
+       ();
+     cgi#out_channel#output_string
+      "<html><head></head><body>Error: User id collision!</body></html>"
+   | MatitaFilesystem.SvnError msg ->
+      cgi#set_header
+       ~cache:`No_cache 
+       ~content_type:"text/html; charset=\"utf-8\""
+       ();
+     cgi#out_channel#output_string
+      ("<html><head></head><body><p>Error: Svn checkout failed!<p><p><textarea>"
+       ^ msg ^ "</textarea></p></body></html>"));
   cgi#out_channel#commit_work()
 ;;
 
@@ -242,17 +251,14 @@ 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
   
-  prerr_endline "1";
   assert (cgi#arguments <> []);
   let uid = cgi#argument_value "userid" in
   let userpw = cgi#argument_value "password" in
-  prerr_endline ("2: user = " ^ uid);
   let pw,_ = MatitaAuthentication.lookup_user uid in
-  prerr_endline "3";
 
   if pw = userpw then
    begin
-    prerr_endline "4";
+    let _ = MatitaFilesystem.html_of_library uid in
     let sid = MatitaAuthentication.create_session uid in
     (* let cookie = Netcgi.Cookie.make "session" (Uuidm.to_string sid) in
        cgi#set_header ~set_cookies:[cookie] (); *)
@@ -262,6 +268,7 @@ let login (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
    end
   else
    begin
+    prerr_endline ("ERROR: received " ^ userpw ^ "but the password is " ^ pw);
     cgi#set_header
       ~cache:`No_cache 
       ~content_type:"text/html; charset=\"utf-8\""
@@ -492,7 +499,6 @@ let start() =
                 ; "logout", do_logout ]
       () in
   MatitaInit.initialize_all ();
-  prerr_endline (MatitaFilesystem.checkout "ricciott");
   MatitaAuthentication.deserialize ();
   Netplex_main.startup
     parallelizer