open Ocvs_types
let print_DEBUG s = ()
let delete_file f =
try Unix.unlink f
with _ -> ()
let absolute_name f =
if Filename.is_relative f then
Filename.concat (Unix.getcwd()) f
else
f
let remove_n_first_lines n s =
let rec iter m acc =
if m = 0 then
acc
else
let index = String.index_from s acc '\n' in
iter (m-1) (index+1)
in
try
let index = iter n 0 in
String.sub s index ((String.length s) - index)
with
Not_found ->
""
let get_nth_line n s =
try
let l = Str.split (Str.regexp "\n") s in
List.nth l n
with _ ->
""
let partition_files_by_dir files =
let rec part (acc : (string * (string list ref)) list) l =
match l with
[] -> List.map (fun (d,lref) -> (d,!lref)) acc
| file :: q ->
let d = Filename.dirname file in
let f = Filename.basename file in
try
let lref = List.assoc d acc in
lref := f :: !lref;
part acc q
with
Not_found ->
part ((d, ref [f])::acc) q
in
part [] files
let input_file_as_string nom =
let chanin = open_in_bin nom in
let len = 1024 in
let s = String.create len in
let buf = Buffer.create len in
let rec iter () =
try
let n = input chanin s 0 len in
if n = 0 then
()
else
(
Buffer.add_substring buf s 0 n;
iter ()
)
with
End_of_file -> ()
in
iter ();
close_in chanin;
Buffer.contents buf
let analyse_status_file f =
try
let s = input_file_as_string f in
let l = Str.split
(Str.regexp_string "===================================================================\nFile: ")
s
in
let date = Unix.time () in
let f acc str =
try
let n1 = Str.search_forward (Str.regexp "[ \t]*Status:[ ]") str 0 in
let file = String.sub str 0 n1 in
let n2 = n1 + (String.length (Str.matched_string str)) in
let n3 = Str.search_forward (Str.regexp "\n") str n1 in
let status_string = String.sub str n2 (n3-n2) in
let cvs_info =
if status_string = "Unknown" or status_string = "Locally Added" then
{
cvs_file = file ;
cvs_status = Ocvs_types.status_of_string status_string ;
cvs_work_rev = "" ;
cvs_rep_rev = "" ;
cvs_date_string = "" ;
cvs_date = date
}
else if status_string = "Locally Removed" then
(
let len = String.length file in
let no_file = "no file " in
let len_no_file = String.length no_file in
let real_file =
if len <= len_no_file then
file
else
if String.sub file 0 len_no_file = no_file then
String.sub file len_no_file (len - len_no_file)
else
file
in
{
cvs_file = real_file ;
cvs_status = Ocvs_types.status_of_string status_string ;
cvs_work_rev = "" ;
cvs_rep_rev = "" ;
cvs_date_string = "" ;
cvs_date = date
}
)
else
(
print_DEBUG "after n3";
let n4 = Str.search_forward (Str.regexp "Working revision:\t\\([^\t\n]+\\)\t?") str n3 in
print_DEBUG "after n4";
let n5 = n4 + (String.length (Str.matched_string str)) in
let work_rev = Str.matched_group 1 str in
print_DEBUG ("after work_rev="^work_rev);
let n6 = Str.search_forward (Str.regexp "\n") str n5 in
print_DEBUG "after n6";
let _n7 = Str.search_forward (Str.regexp "Repository revision:\t\\([^\t]+\\)\t") str n6 in
print_DEBUG "after n7";
let rep_rev = Str.matched_group 1 str in
let cvs_info =
{
cvs_file = file ;
cvs_status = Ocvs_types.status_of_string (String.sub str n2 (n3-n2)) ;
cvs_work_rev = work_rev ;
cvs_rep_rev = rep_rev ;
cvs_date_string = String.sub str n5 (n6-n5) ;
cvs_date = date
}
in
cvs_info
)
in
acc @ [cvs_info]
with
Not_found ->
acc
in
List.fold_left f [] l
with
Sys_error s ->
raise (Ocvs_types.CvsFailure s)
let analyse_update_file f =
try
let s = input_file_as_string f in
let l = Str.split (Str.regexp "\n") s in
let f acc str =
try
let action = Ocvs_types.update_action_of_string (String.sub str 0 1) in
let file = String.sub str 2 ((String.length str) - 2) in
let info = (file, action) in
acc @ [info]
with
_ ->
acc
in
List.fold_left f [] l
with
Sys_error s ->
raise (Ocvs_types.CvsFailure s)
let status_dir dir =
let temp_file = Filename.temp_file "ocamlcvs" "status" in
let com = Printf.sprintf "cd %s ; cvs status %s -l . > %s"
(Filename.quote dir)
!Ocvs_config.status_options
temp_file
in
let n = Sys.command com in
if n = 0 then
(
let l = analyse_status_file temp_file in
delete_file temp_file ;
List.map
(fun ci -> { ci with
cvs_file = Filename.concat dir ci.cvs_file }
)
l
)
else
(
delete_file temp_file ;
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
)
let status_file file =
let dir = Filename.dirname file in
let f = Filename.basename file in
let temp_file = Filename.temp_file "ocamlcvs" "status" in
let com = Printf.sprintf "cd %s ; cvs status %s %s > %s"
(Filename.quote dir)
!Ocvs_config.status_options
(Filename.quote f)
temp_file
in
let n = Sys.command com in
if n = 0 then
(
let l = analyse_status_file temp_file in
delete_file temp_file ;
try
match l with
[] -> raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
| ci :: _ ->
{ ci with
cvs_file = file ;
}
with
Invalid_argument _ ->
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
)
else
(
delete_file temp_file ;
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
)
let status_files files =
let rec iter acc l =
match l with
[] -> acc
| file :: q ->
try
let i = status_file file in
iter (i :: acc) q
with
CvsFailure s ->
prerr_endline s;
iter acc q
in
List.rev (iter [] files)
let commit_files_in_dir ?(comment="") dir base_files =
let com =
Printf.sprintf "cd %s ; cvs commit %s -m %s %s"
(Filename.quote dir)
!Ocvs_config.commit_options
(Filename.quote comment)
(List.fold_left (fun acc -> fun f -> acc^" "^(Filename.quote f)^"") "" base_files)
in
let n = Sys.command com in
if n = 0 then
()
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
let commit_files ?(comment="") files =
let parts = partition_files_by_dir files in
let f (d,l) = commit_files_in_dir ~comment d l in
List.iter f parts
let commit_dir ?(comment="") dir =
let com = Printf.sprintf "cd %s ; cvs commit %s -m %s "
(Filename.quote dir)
!Ocvs_config.commit_options
(Filename.quote comment)
in
let n = Sys.command com in
if n = 0 then
()
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
let update_dir ?(recursive=true) dir =
let temp_file = Filename.temp_file "ocamlcvs" "update" in
let com = Printf.sprintf
"cd %s ; cvs update %s -d %s > %s"
(Filename.quote dir)
!Ocvs_config.update_options
(if recursive then "-R" else "-l")
temp_file
in
let n = Sys.command com in
if n = 0 then
(
let l = analyse_update_file temp_file in
delete_file temp_file ;
List.map
(fun (f, action) -> (Filename.concat dir f, action))
l
)
else
(
delete_file temp_file ;
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
)
let add_dir dir =
let parent = Filename.dirname dir in
let d = Filename.basename dir in
let com = Printf.sprintf "cd %s ; cvs add %s %s"
(Filename.quote parent)
!Ocvs_config.add_options
(Filename.quote d)
in
let n = Sys.command com in
if n = 0 then
()
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
let create_and_add_dir dir =
try
Unix.mkdir dir 0o755;
add_dir dir
with
Unix.Unix_error (e, s1, s2) ->
let s = Unix.error_message e in
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_mkdir dir s))
let add_files ?(binary=false) files =
match files with
[] ->
([], [])
| files ->
let f (acc_ok, acc_ko) file =
let d = Filename.dirname file in
let f = Filename.basename file in
let com = Printf.sprintf "cd %s ; cvs add %s %s %s"
(Filename.quote d)
!Ocvs_config.add_options
(if binary then "-kb " else "")
(Filename.quote f)
in
let n = Sys.command com in
if n = 0 then
(acc_ok @ [file], acc_ko)
else
(acc_ok, acc_ko @ [file])
in
List.fold_left f ([], []) files
let remove_files files =
match files with
[] ->
([], [])
| files ->
let f (acc_ok, acc_ko) file =
let d = Filename.dirname file in
let f = Filename.basename file in
let com = Printf.sprintf "cd %s ; cvs remove %s -f %s"
(Filename.quote d)
!Ocvs_config.remove_options
(Filename.quote f)
in
let n = Sys.command com in
if n = 0 then
(acc_ok @ [file], acc_ko)
else
(acc_ok, acc_ko @ [file])
in
List.fold_left f ([], []) files
let diff_file ?rev ?rev2 file =
let dir = Filename.dirname file in
let f = Filename.basename file in
let temp_file = Filename.temp_file "ocamlcvs" "diff" in
let com = "cd "^(Filename.quote dir)^" ; cvs -f diff "^
(match rev with
None -> ""
| Some r -> " -r "^(Ocvs_revision.string_of_revision_number r.rev_number)^" ")^
(match rev2 with
None -> ""
| Some r -> " -r "^(Ocvs_revision.string_of_revision_number r.rev_number)^" ")^
(Filename.quote f)^" > "^temp_file
in
begin
match Sys.command com with
0 -> ()
| n ->
delete_file temp_file;
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
end;
let s = input_file_as_string temp_file in
let s2 = remove_n_first_lines
(match rev with None -> 5 | Some _ -> 6)
s
in
try
let rcs_file =
try
let s_rcs = "RCS file: " in
let i1 = (Str.search_forward (Str.regexp_string s_rcs) s 0) + (String.length s_rcs) in
let i2 = String.index_from s i1 '\n' in
String.sub s i1 (i2 - i1)
with
Not_found ->
raise (Failure Ocvs_messages.error_rcs_archive)
in
let l = Odiff.from_string s2 in
delete_file temp_file ;
(l, rcs_file)
with
Failure s ->
delete_file temp_file ;
raise (Failure s)
let rcs_revision rev archive =
let temp_file = Filename.temp_file "ocamlcvs" "rcs" in
let com =
"co -p -r"^(Ocvs_revision.string_of_revision_number rev.rev_number)^" "^
(Filename.quote archive)^" > "^temp_file
in
let n = Sys.command com in
if n = 0 then
temp_file
else
(
delete_file temp_file ;
raise (Failure (Ocvs_messages.error_exec com))
)
let read_revisions file =
let s = input_file_as_string file in
let l = Str.split (Str.regexp "^----------------------------\n") s in
match l with
[] | [_] -> []
| _ :: lrev ->
let f str_rev =
let lines = Str.split (Str.regexp "\n") str_rev in
match lines with
l_number :: l_info :: l_coms ->
let number =
try
let n = String.index l_number ' ' in
let s = String.sub l_number (n+1) ((String.length l_number) - n - 1) in
List.map int_of_string (Str.split (Str.regexp "\\.") s)
with
Not_found -> []
| Invalid_argument s ->
prerr_endline s;
prerr_endline l_number ;
[]
in
let n = String.index l_info ' ' in
let n2 = String.index_from l_info n ';' in
let n3 = String.index_from l_info n2 ':' in
let n4 = String.index_from l_info n3 ';' in
let date = String.sub l_info (n + 1) (n2 - n - 1) in
let author = String.sub l_info (n3 + 1) (n4 - n3 - 1) in
let list_lines_coms =
match l_coms with
first_line :: q ->
if Str.string_match (Str.regexp "^branches:") first_line 0 then
q
else
l_coms
| _ -> l_coms
in
{
rev_number = number ;
rev_author = author ;
rev_date = date ;
rev_comment =
String.concat "\n"
(List.filter
(fun s ->
s <> ("==================================="^
"==========================================")
)
list_lines_coms
)
}
| _ ->
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_analyze_revision str_rev))
in
List.map f lrev
let revisions_file file =
let dir = Filename.dirname file in
let f = Filename.basename file in
let temp_file = Filename.temp_file "ocamlcvs" "log" in
let com = Printf.sprintf
"cd %s ; cvs log %s > %s"
(Filename.quote dir)
(Filename.quote f)
temp_file
in
let n = Sys.command com in
try
if n = 0 then
let revisions = read_revisions temp_file in
delete_file temp_file ;
revisions
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
with
Failure s ->
delete_file temp_file ;
raise (Ocvs_types.CvsFailure s)
let read_tags file =
let s = input_file_as_string file in
let l = Str.split (Str.regexp "^----------------------------$") s in
match l with
[] | [_] -> []
| preambule :: _ ->
try
print_DEBUG "Ocvs_commands.read_tags after preambule";
let s = "symbolic names:" in
let pos = Str.search_forward (Str.regexp ("^"^s^"$")) preambule 0 in
print_DEBUG "Ocvs_commands.read_tags after pos";
let pos2 = pos + (String.length s) + 1 in
let pos3 = Str.search_forward (Str.regexp "^keyword substitution:") preambule pos2 in
print_DEBUG "Ocvs_commands.read_tags after pos3";
let s2 = String.sub preambule pos2 (pos3 - pos2) in
let lines = Str.split (Str.regexp "\n") s2 in
let f_line acc line =
try
let pos = String.index line ':' in
let tag = String.sub line 1 (pos - 1) in
let revision = String.sub line (pos + 2) ((String.length line) - pos - 2) in
(tag, revision) :: acc
with
Not_found | Invalid_argument _ ->
acc
in
List.fold_left f_line [] lines
with
Not_found ->
[]
let tags_file file =
let dir = Filename.dirname file in
let f = Filename.basename file in
let temp_file = Filename.temp_file "ocamlcvs" "log" in
let com = Printf.sprintf
"cd %s ; cvs log %s > %s"
(Filename.quote dir)
(Filename.quote f)
temp_file
in
let n = Sys.command com in
try
if n = 0 then
let revisions = read_tags temp_file in
delete_file temp_file ;
revisions
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
with
Failure s ->
delete_file temp_file ;
raise (Ocvs_types.CvsFailure s)
let check_tag tag =
for i = 0 to (String.length tag) - 1 do
match tag.[i] with
'a' .. 'z'
| 'A' .. 'Z' -> ()
| '_' | '-' | '0' .. '9' when i > 0 -> ()
| _ -> raise (Tag_error i)
done
let file_has_tag tag file =
let tags = List.map fst (tags_file file) in
List.mem tag tags
let rec get_cvs_files dir =
let files = List.map (fun ci -> ci.cvs_file) (status_dir dir) in
let subdirs = List.map (Filename.concat dir) (Ocvs_misc.get_cvs_directories dir) in
List.iter prerr_endline subdirs;
let ll = List.map get_cvs_files subdirs in
List.flatten (files :: ll)
let tag_files f_confirm tag files =
match files with
[] -> ()
| _ ->
check_tag tag ;
let (ko, ok) = List.partition (file_has_tag tag) files in
let continue =
(ko = []) || f_confirm (Ocvs_messages.files_already_has_tag ko tag)
in
if continue then
let parts = partition_files_by_dir files in
let f_part (d,l) =
let com = Printf.sprintf
"cd %s; cvs tag -F -c %s %s"
(Filename.quote d)
tag
(List.fold_left (fun acc -> fun f -> acc^" "^(Filename.quote f)^"") "" l)
in
let n = Sys.command com in
if n = 0 then
()
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
in
List.iter f_part parts
else
()
let tag_dir ?(recursive=true) f_confirm tag dir =
check_tag tag ;
let files = get_cvs_files dir in
let (ko, ok) = List.partition (file_has_tag tag) files in
let continue =
(ko = []) || f_confirm (Ocvs_messages.files_already_has_tag ko tag)
in
if continue then
let com = Printf.sprintf
"cd %s ; cvs tag %s -F -c %s"
(Filename.quote dir)
(if recursive then "-R" else "-l")
tag
in
let n = Sys.command com in
if n = 0 then
()
else
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
else
()
let log file =
let dir = Filename.dirname file in
let f = Filename.basename file in
let temp_file = Filename.temp_file "ocamlcvs" "log" in
let com = Printf.sprintf "cd %s ; cvs log %s > %s"
(Filename.quote dir)
f
temp_file
in
let n = Sys.command com in
if n = 0 then
(
let s = input_file_as_string temp_file in
delete_file temp_file ;
s
)
else
(
delete_file temp_file ;
raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
)