X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matitaB%2Fmatita%2FmatitaFilesystem.ml;h=2686fff42991037c26ee03ee09a4f38388bee38e;hb=83fa6fc1317f18af956b194b996afae10ec859a7;hp=0170030a5e75be4829d2e83a5825eb8898f0fe19;hpb=563dafd0155ff31215d3f7b813379fa6d50404f1;p=helm.git diff --git a/matitaB/matita/matitaFilesystem.ml b/matitaB/matita/matitaFilesystem.ml index 0170030a5..2686fff42 100644 --- a/matitaB/matita/matitaFilesystem.ml +++ b/matitaB/matita/matitaFilesystem.ml @@ -25,6 +25,10 @@ exception SvnError of string;; +let mutex = Mutex.create ();; + +let to_be_committed = ref [];; + let exec_process cmd = let (stdout, stdin, stderr) as chs = Unix.open_process_full cmd [||] in let outlines = ref [] in @@ -48,6 +52,8 @@ let exec_process cmd = errno, output ^ "\n\n" ^ errors | _ -> assert false)) +(* this should be executed only for a freshly created user + * so no CS is needed *) let checkout user = let rt_dir = Helm_registry.get "matita.rt_base_dir" in let repo = Helm_registry.get "matita.weblib" in @@ -62,39 +68,90 @@ 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 basedir = (Helm_registry.get "matita.rt_base_dir") ^ "/users/" ^ uid in + + let branch lpath children = let id = newid () in - "\n" ^ + let name = Filename.basename lpath in + let name = if name <> "." then name else "cic:/matita" in + "\n" ^ "\n" ^ - text ^ "
\n" ^ + name ^ "
\n" ^ "\n" ^ - acc ^ "\n" + children ^ "\n" in - let leaf text link = + let leaf lpath = "\n" ^ - "" ^ text ^ "
" + "" ^ + (Filename.basename lpath) ^ "
" in let rec aux path = - let dirlist = Array.to_list (Sys.readdir path) in - let subdirs = List.filter (fun x -> Sys.is_directory (path ^ "/" ^ x)) dirlist in + let lpath filename = path ^ "/" ^ filename in + let gpath filename = basedir ^ "/" ^ path ^ "/" ^ filename in + let dirlist = + List.filter (fun x -> String.sub x 0 1 <> ".") + (Array.to_list (Sys.readdir (basedir ^ "/" ^ path))) in + let subdirs = List.filter (fun x -> Sys.is_directory (gpath x)) dirlist in let scripts = List.filter (fun x -> try let i = String.rindex x '.' in - not (Sys.is_directory (path ^ "/" ^ x)) && (String.sub x i 3 = ".ma") + let len = String.length x - i in + not (Sys.is_directory (gpath x)) && + (String.sub x 0 1 <> ".") && (String.sub x i len = ".ma") with Not_found | Invalid_argument _ -> false) dirlist in let subdirtags = - String.concat "\n" (List.map (fun x -> aux (path ^ "/" ^ x)) subdirs) in + String.concat "\n" (List.map (fun x -> aux (lpath x)) subdirs) in let scripttags = String.concat "\n" - (List.map (fun x -> leaf x (path ^ "/" ^ x)) scripts) + (List.map (fun x -> leaf (lpath x)) scripts) in - branch (Filename.basename path) (subdirtags ^ "\n" ^ scripttags) + branch path (subdirtags ^ "\n" ^ scripttags) in - let basedir = (Helm_registry.get "matita.rt_base_dir") ^ "/users/" ^ uid ^ "/" in - let res = aux basedir in + let res = aux "." in prerr_endline "BEGIN TREE";prerr_endline res;prerr_endline "END TREE"; res ;; + +let reset_lib () = + let to_be_removed = (Helm_registry.get "matita.rt_base_dir") ^ "/users/*" in + ignore (Sys.command ("rm -rf " ^ to_be_removed)) +;; + +(* adds a user to the commit queue; concurrent instances possible, so we + * enclose the update in a CS + *) +let add_user uid = + Mutex.lock mutex; + to_be_committed := uid::List.filter (fun x -> x <> uid) !to_be_committed; + Mutex.unlock mutex; +;; + +(* this function and the next one should only be called by the server itself (or + * the admin) at a scheduled time, so no concurrent instances and no CS needed + * also, svn should already be safe as far as concurrency is concerned *) +let commit 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 ci --message \"commit by user " ^ user ^ "\" " ^ rt_dir ^ "/users/" ^ user ^ "/") + in + if errno = 0 then () + else raise (SvnError outstr) + +let do_global_commit () = + prerr_endline ("to be committed: " ^ String.concat " " !to_be_committed); + List.fold_left + (fun acc u -> + try + commit u; + acc + with + | SvnError outstr -> + prerr_endline outstr; + u::acc) + [] (List.rev !to_be_committed) +;;