From 08935b4293e1c78bbe2ac4b972dbe47023160919 Mon Sep 17 00:00:00 2001 From: Wilmer Ricciotti 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 + "\n" ^ + "\n" ^ + text ^ "
\n" ^ + "\n" ^ + acc ^ "\n" in - if errno = 0 then "checkout successful!" - else "checkout error!\n\n" ^ outstr + let leaf text link = + "\n" ^ + "" ^ text ^ "
" + 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 - "Error: User id collision!"); + with + | MatitaAuthentication.UsernameCollision _ -> + cgi#set_header + ~cache:`No_cache + ~content_type:"text/html; charset=\"utf-8\"" + (); + cgi#out_channel#output_string + "Error: User id collision!" + | MatitaFilesystem.SvnError msg -> + cgi#set_header + ~cache:`No_cache + ~content_type:"text/html; charset=\"utf-8\"" + (); + cgi#out_channel#output_string + ("

Error: Svn checkout failed!

")); 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