exception SvnError of string;;
+(* disable for debugging *)
+let prerr_endline _ = ()
+
let exec_process cmd =
let (stdout, stdin, stderr) as chs = Unix.open_process_full cmd [||] in
let outlines = ref [] in
exception SvnAnomaly of string
-let stat_classify line =
+let stat_classify line uid =
+ let basedir = (Helm_registry.get "matita.rt_base_dir") ^ "/users/" ^ uid ^ "/" in
let rec aux n acc =
match (line.[n], n) with
- | _, n when n = 7 -> String.sub line 8 ((String.length line) - 8), acc
+ | _, n when n = 7 ->
+ let fn = String.sub line 8 ((String.length line) - 8) in
+ let prefix_len = String.length basedir in
+ let fn_len = String.length fn in
+ if String.sub fn 0 prefix_len = basedir
+ then String.sub fn prefix_len (fn_len - prefix_len), acc
+ else fn, acc
| ' ', _ -> aux (n+1) acc
| 'A',0 -> aux (n+1) (Add::acc)
| 'C',_ when n = 0 || n = 1 -> aux (n+1) (Conflict::acc)
let files, anomalies =
List.fold_left (fun (facc,eacc) line ->
try
- (stat_classify line::facc), eacc
+ (stat_classify line user::facc), eacc
with
| SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
in
let rt_dir = Helm_registry.get "matita.rt_base_dir" in
let repo = Helm_registry.get "matita.weblib" in
- let errno, outlines, errlines = exec_process
+ let errno, outlines, errlines =
+ prerr_endline
+ ("svn co --non-interactive " ^ repo ^ " " ^ rt_dir ^ "/users/" ^ user ^ "/");
+ exec_process
("svn co --non-interactive " ^ repo ^ " " ^ rt_dir ^ "/users/" ^ user ^ "/")
in
let files, anomalies =
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 subdirs = List.sort String.compare subdirs in
(* only .ma scripts, hidden files excluded *)
let scripts =
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 scripts = List.sort String.compare scripts in
let subdirtags =
String.concat "\n" (List.map (fun x -> aux (normalize_qfn (lpath x ^ "/"))) subdirs) in
let scripttags =
;;
let add_files user files =
- let rt_dir = Helm_registry.get "matita.rt_base_dir" in
- let _repo = Helm_registry.get "matita.weblib" in
-
- let files = String.concat " "
- (List.map ((^) (rt_dir ^ "/users/" ^ user ^ "/")) files) in
-
- let errno, outlines, errlines =
- if files <> "" then
- exec_process ("svn add --non-interactive " ^ files)
- else 0,[],[]
- in
- if errno = 0 then
- "BEGIN ADD - " ^ user ^ ":\n" ^ (string_of_output outlines errlines) ^ "END ADD - " ^ user ^ "\n\n"
- else raise (SvnError (string_of_output outlines errlines))
+ if (List.length files > 0) then
+ (let rt_dir = Helm_registry.get "matita.rt_base_dir" in
+ let _repo = Helm_registry.get "matita.weblib" in
+
+ let files = String.concat " "
+ (List.map ((^) (rt_dir ^ "/users/" ^ user ^ "/")) files) in
+
+ let errno, outlines, errlines =
+ if files <> "" then
+ exec_process ("svn add --non-interactive " ^ files)
+ else 0,[],[]
+ in
+ if errno = 0 then
+ "BEGIN ADD - " ^ user ^ ":\n" ^ (string_of_output outlines errlines) ^ "END ADD - " ^ user ^ "\n\n"
+ else raise (SvnError (string_of_output outlines errlines)))
+ else ("ADD - nothing to do for " ^ user ^ "\n")
;;
(* this function 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 files =
- let rt_dir = Helm_registry.get "matita.rt_base_dir" in
- let _repo = Helm_registry.get "matita.weblib" in
-
- let files = String.concat " "
- (List.map ((^) (rt_dir ^ "/users/" ^ user ^ "/")) files) in
-
- let errno, outlines, errlines = exec_process
- ("svn ci --non-interactive --message \"commit by user " ^ user ^ "\" " ^ files)
- in
- if errno = 0 then
- "BEGIN COMMIT - " ^ user ^ ":\n" ^ (string_of_output outlines errlines) ^ "END COMMIT - " ^ user ^ "\n\n"
- else raise (SvnError (string_of_output outlines errlines))
+ if (List.length files > 0) then
+ (let rt_dir = Helm_registry.get "matita.rt_base_dir" in
+ let _repo = Helm_registry.get "matita.weblib" in
+
+ let files = String.concat " "
+ (List.map ((^) (rt_dir ^ "/users/" ^ user ^ "/")) files) in
+
+ let errno, outlines, errlines = exec_process
+ ("svn ci --non-interactive --message \"commit by user " ^ user ^ "\" " ^ files)
+ in
+ if errno = 0 then
+ "BEGIN COMMIT - " ^ user ^ ":\n" ^ (string_of_output outlines errlines) ^ "END COMMIT - " ^ user ^ "\n\n"
+ else raise (SvnError (string_of_output outlines errlines)))
+ else ("COMMIT nothing to do for " ^ user ^ "\n")
;;