assert false
with End_of_file ->
match (Unix.close_process_full chs) with
- | Unix.WEXITED errno ->
- let output = "std out =\n" ^ String.concat "\n" (List.rev !outlines) in
- let errors = "std err =\n" ^ String.concat "\n" (List.rev !errlines) in
- errno, output ^ "\n\n" ^ errors
+ | Unix.WEXITED errno -> errno, !outlines, !errlines
| _ -> assert false))
-(* this should be executed only for a freshly created user
- * so no CS is needed *)
+let string_of_output outlines errlines =
+ let output = "std out =\n" ^ String.concat "\n" (List.rev outlines) in
+ let errors = "std err =\n" ^ String.concat "\n" (List.rev errlines) in
+ output ^ "\n\n" ^ errors
+
+type svn_flag =
+| Add
+| Conflict
+| Modified
+| NotAdded
+| Delete
+| Update
+| Merge
+
+type matita_flag =
+| MUnversioned
+| MSynchronized
+| MAdd
+| MModified
+| MConflict
+
+let string_of_matita_flag = function
+| MUnversioned -> "unversioned"
+| MSynchronized -> "synchronized"
+| MAdd -> "new"
+| MModified -> "modified"
+| MConflict -> "conflict!"
+
+exception SvnAnomaly of string
+
+let stat_classify line =
+ let rec aux n acc =
+ match (line.[n], n) with
+ | _, n when n = 7 -> String.sub line 8 ((String.length line) - 8), acc
+ | ' ', _ -> aux (n+1) acc
+ | 'A',0 -> aux (n+1) (Add::acc)
+ | 'C',_ when n = 0 || n = 1 -> aux (n+1) (Conflict::acc)
+(* | 'D',0 -> aux (n+1) (Delete::acc) *)
+(* | 'I',0 -> aux (n+1) (Ignore::acc) *)
+ | 'M',_ when n = 0 || n = 1 -> aux (n+1) (Modified::acc)
+(* | 'R',0 -> aux (n+1) (Replaced::acc) *)
+(* | 'X',0 -> aux (n+1) (UnversionedDir::acc) *)
+ | '?',0 -> aux (n+1) (NotAdded::acc)
+(* | '!',0 -> aux (n+1) (Missing::acc) *)
+(* | '~',0 -> aux (n+1) (Obstructed::acc) *)
+(* | 'L',2 -> aux (n+1) (Lock::acc) *)
+(* | '+',3 -> aux (n+1) (History::acc) *)
+(* | 'S',4 -> aux (n+1) (SwitchedUrl::acc) *)
+(* | 'X',4 -> aux (n+1) (External::acc) *)
+(* | 'K',5 -> aux (n+1) (LockToken::acc) *)
+(* | 'C',6 -> aux (n+1) (TreeConflict::acc) *)
+ | _ -> raise (SvnAnomaly line)
+ in aux 0 []
+
+let stat_user user =
+ 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
+ ("svn stat " ^ rt_dir ^ "/users/" ^ user ^ "/")
+ in
+ let files, anomalies =
+ List.fold_left (fun (facc,eacc) line ->
+ try
+ (stat_classify line::facc), eacc
+ with
+ | SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
+ in
+ if errno = 0 then files, anomalies
+ else raise (SvnError ("Anomalies: " ^ (String.concat "\n" anomalies) ^ "\n\n" ^ (string_of_output outlines errlines)))
+;;
+
+(* update and checkout *)
+let up_classify line =
+ let rec aux n acc =
+ match (line.[n], n) with
+ | _, n when n = 4 -> String.sub line 5 ((String.length line) - 5), acc
+ | ' ', _ -> aux (n+1) acc
+ | 'A',_ when n = 0 || n = 1 -> aux (n+1) (Add::acc)
+ | 'C',_ when n = 0 || n = 1 -> aux (n+1) (Conflict::acc)
+ | 'D',_ when n = 0 || n = 1 -> aux (n+1) (Delete::acc)
+ | 'U',_ when n = 0 || n = 1 -> aux (n+1) (Update::acc)
+ | 'G',_ when n = 0 || n = 1 -> aux (n+1) (Merge::acc)
+(* | 'E',_ when n = 0 || n = 1 -> aux (n+1) (Exist::acc) *)
+ | _ -> raise (SvnAnomaly line)
+ in aux 0 []
+
+(* 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
- let errno, outstr = exec_process
+ let errno, outlines, errlines = exec_process
("svn co " ^ repo ^ " " ^ rt_dir ^ "/users/" ^ user ^ "/")
in
- if errno = 0 then ()
- else raise (SvnError outstr)
+ let files, anomalies =
+ List.fold_left (fun (facc,eacc) line ->
+ try
+ (up_classify line::facc), eacc
+ with
+ | SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
+ in
+ if errno = 0 then List.map (fun (f,_) -> f,MSynchronized) files
+ else raise (SvnError (string_of_output outlines errlines))
-let html_of_library uid =
+let html_of_library uid ft =
let i = ref 0 in
let newid () = incr i; ("node" ^ string_of_int !i) in
let id = newid () in
let name = Filename.basename lpath in
let name = if name <> "." then name else "cic:/matita" in
+ let lpath =
+ try
+ if String.sub lpath 0 2 <> "./" then lpath
+ else String.sub lpath 2 (String.length lpath - 2)
+ with Invalid_argument _ -> lpath
+ in
+ let flag =
+ try List.assoc lpath ft
+ with Not_found -> MSynchronized in
+ let szflag = string_of_matita_flag flag in
"<span class=\"trigger\" onClick=\"showBranch('" ^ id ^ "','" ^ lpath ^ "/')\">\n" ^
"<img src=\"treeview/closed.gif\" id=\"I" ^ id ^ "\"/>\n" ^
- name ^ "<br/></span>\n" ^
+ name ^ " " ^ szflag ^ "<br/></span>\n" ^
"<span class=\"branch\" id=\"" ^ id ^ "\">\n" ^
children ^ "\n</span>"
in
Mutex.unlock mutex;
;;
+let update_user user =
+ 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
+ ("svn up " ^ rt_dir ^ "/users/" ^ user ^ "/")
+ in
+ let files, anomalies =
+ List.fold_left (fun (facc,eacc) line ->
+ try
+ (up_classify line::facc), eacc
+ with
+ | SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
+ in
+ if errno = 0 then files, anomalies
+ else raise (SvnError (string_of_output outlines errlines))
+;;
+
(* 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 rt_dir = Helm_registry.get "matita.rt_base_dir" in
let repo = Helm_registry.get "matita.weblib" in
- let errno, outstr = exec_process
+ let errno, outlines, errlines = exec_process
("svn ci --message \"commit by user " ^ user ^ "\" " ^ rt_dir ^ "/users/" ^ user ^ "/")
in
if errno = 0 then ()
- else raise (SvnError outstr)
+ else raise (SvnError (string_of_output outlines errlines))
+;;
let do_global_commit () =
prerr_endline ("to be committed: " ^ String.concat " " !to_be_committed);
projects / helm.git / blobdiff