1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
open OpamTypes
open OpamStd.Op
open OpamProcess.Job.Op
module type VCS = sig
val name: OpamUrl.backend
val exists: dirname -> bool
val init: dirname -> url -> unit OpamProcess.job
val fetch: ?cache_dir:dirname -> dirname -> url -> unit OpamProcess.job
val reset_tree: dirname -> url -> unit OpamProcess.job
val patch_applied: dirname -> url -> unit OpamProcess.job
val diff: dirname -> url -> filename option OpamProcess.job
val is_up_to_date: dirname -> url -> bool OpamProcess.job
val revision: dirname -> string option OpamProcess.job
val versioned_files: dirname -> string list OpamProcess.job
val vc_dir: dirname -> dirname
val current_branch: dirname -> string option OpamProcess.job
val is_dirty: dirname -> bool OpamProcess.job
end
module Make (VCS: VCS) = struct
let name = VCS.name
let fetch_repo_update repo_name ?cache_dir repo_root repo_url =
if VCS.exists repo_root then
OpamProcess.Job.catch (fun e -> Done (OpamRepositoryBackend.Update_err e))
@@ fun () ->
OpamRepositoryBackend.job_text repo_name "sync"
(VCS.fetch ?cache_dir repo_root repo_url)
@@+ fun () ->
OpamRepositoryBackend.job_text repo_name "diff"
(VCS.diff repo_root repo_url)
@@| function
| None -> OpamRepositoryBackend.Update_empty
| Some patch -> OpamRepositoryBackend.Update_patch patch
else
OpamProcess.Job.catch (fun e ->
OpamFilename.rmdir repo_root;
Done (OpamRepositoryBackend.Update_err e))
@@ fun () ->
OpamRepositoryBackend.job_text repo_name "init"
(VCS.init repo_root repo_url)
@@+ fun () ->
OpamRepositoryBackend.job_text repo_name "sync"
(VCS.fetch ?cache_dir repo_root repo_url)
@@+ fun () ->
let tmpdir = OpamFilename.Dir.(of_string (to_string repo_root ^".new")) in
OpamFilename.copy_dir ~src:repo_root ~dst:tmpdir;
OpamProcess.Job.catch (fun e -> OpamFilename.rmdir tmpdir; raise e)
@@ fun () ->
VCS.reset_tree tmpdir repo_url @@| fun () ->
OpamRepositoryBackend.Update_full tmpdir
let repo_update_complete dirname url =
VCS.patch_applied dirname url @@+ fun () ->
Done ()
let pull_url ?cache_dir dirname checksum url =
if checksum <> None then invalid_arg "VC pull_url doesn't allow checksums";
OpamProcess.Job.catch
(fun e ->
OpamConsole.error "Could not synchronize %s from %S:\n%s"
(OpamFilename.Dir.to_string dirname)
(OpamUrl.to_string url)
(match e with Failure fw -> fw | _ -> Printexc.to_string e);
Done (Not_available (OpamUrl.to_string url)))
@@ fun () ->
if VCS.exists dirname then
VCS.fetch ?cache_dir dirname url @@+ fun () ->
VCS.is_up_to_date dirname url @@+ function
| true -> Done (Up_to_date None)
| false ->
VCS.reset_tree dirname url @@+ fun () ->
Done (Result None)
else
(OpamFilename.mkdir dirname;
VCS.init dirname url @@+ fun () ->
VCS.fetch ?cache_dir dirname url @@+ fun () ->
VCS.reset_tree dirname url @@+ fun () ->
Done (Result None))
let revision repo_root =
VCS.revision repo_root @@+ fun r ->
Done (OpamStd.Option.map OpamPackage.Version.of_string r)
let sync_dirty repo_root repo_url =
match OpamUrl.local_dir repo_url with
| None -> pull_url repo_root None repo_url
| Some dir ->
VCS.versioned_files dir
@@+ fun files ->
let files =
List.map OpamFilename.(remove_prefix dir)
(OpamFilename.rec_files (VCS.vc_dir dir))
@ files
in
let stdout_file =
let f = OpamSystem.temp_file "rsync-files" in
let fd = open_out f in
List.iter (fun s -> output_string fd s; output_char fd '\n') files;
close_out fd;
f
in
let fset = OpamStd.String.Set.of_list files in
List.iter (fun f ->
let basename = OpamFilename.remove_prefix repo_root f in
if not (OpamFilename.(starts_with (VCS.vc_dir repo_root) f) ||
OpamStd.String.Set.mem basename fset)
then OpamFilename.remove f)
(OpamFilename.rec_files repo_root);
OpamLocal.rsync_dirs ~args:["--files-from"; stdout_file]
~exclude_vcdirs:false
repo_url repo_root
@@+ fun result ->
OpamSystem.remove stdout_file;
Done (match result with
| Up_to_date _ -> Up_to_date None
| Result _ -> Result None
| Not_available _ as na -> na)
end