From 08935b4293e1c78bbe2ac4b972dbe47023160919 Mon Sep 17 00:00:00 2001
From: Wilmer Ricciotti <ricciott@cs.unibo.it>
Date: Tue, 21 Jun 2011 14:58:49 +0000
Subject: [PATCH] Added generation of HTML representation of the library.

---
 matitaB/matita/Makefile                | 10 ++---
 matitaB/matita/matitaAuthentication.ml |  1 +
 matitaB/matita/matitaFilesystem.ml     | 51 ++++++++++++++++++++++++--
 matitaB/matita/matitaFilesystem.mli    |  6 ++-
 matitaB/matita/matitadaemon.ml         | 30 +++++++++------
 5 files changed, 76 insertions(+), 22 deletions(-)

diff --git a/matitaB/matita/Makefile b/matitaB/matita/Makefile
index d0219f430..ed24d2c61 100644
--- a/matitaB/matita/Makefile
+++ b/matitaB/matita/Makefile
@@ -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 $<
 
diff --git a/matitaB/matita/matitaAuthentication.ml b/matitaB/matita/matitaAuthentication.ml
index 7d6471df5..8b23cc948 100644
--- a/matitaB/matita/matitaAuthentication.ml
+++ b/matitaB/matita/matitaAuthentication.ml
@@ -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 ()
 ;;
diff --git a/matitaB/matita/matitaFilesystem.ml b/matitaB/matita/matitaFilesystem.ml
index 1809627ca..fe67b256b 100644
--- a/matitaB/matita/matitaFilesystem.ml
+++ b/matitaB/matita/matitaFilesystem.ml
@@ -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
+;;
diff --git a/matitaB/matita/matitaFilesystem.mli b/matitaB/matita/matitaFilesystem.mli
index eba9d1dde..e04500e28 100644
--- a/matitaB/matita/matitaFilesystem.mli
+++ b/matitaB/matita/matitaFilesystem.mli
@@ -1 +1,5 @@
-val checkout : string -> string
+exception SvnError of string;;
+
+val checkout : string -> unit
+
+val html_of_library : string -> string
diff --git a/matitaB/matita/matitadaemon.ml b/matitaB/matita/matitadaemon.ml
index 840442665..744034e06 100644
--- a/matitaB/matita/matitadaemon.ml
+++ b/matitaB/matita/matitadaemon.ml
@@ -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
-- 
2.39.2