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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
open EzCompat
type t =
{ mutable hashes : string StringMap.t;
mutable modified : bool;
mutable files : (bool * string * string * int) list;
mutable to_add : StringSet.t;
mutable to_remove : StringSet.t ;
mutable skel_version : string option;
}
let load () =
let version = ref None in
let hashes =
if Sys.file_exists ".drom" then (
let map = ref StringMap.empty in
Array.iteri
(fun i line ->
try
if line <> "" && line.[0] <> '#' then
let digest, filename =
if String.contains line ':' then
EzString.cut_at line ':'
else
EzString.cut_at line ' '
in
if digest = "version" then
version := Some filename
else
let digest = Digest.from_hex digest in
map := StringMap.add filename digest !map
with exn ->
Printf.eprintf "Error loading .drom at line %d: %s\n%!"
(i+1) (Printexc.to_string exn);
Printf.eprintf " on line: %s\n%!" line;
exit 2
)
(EzFile.read_lines ".drom");
!map
) else
StringMap.empty
in
{ hashes;
files = [];
modified = false;
to_add = StringSet.empty;
to_remove = StringSet.empty;
skel_version = !version ;
}
let write t ~record ~perm file content =
t.files <- (record, file, content, perm) :: t.files;
t.modified <- true
let get t file = StringMap.find file t.hashes
let update ?(git = true) t file hash =
t.hashes <- StringMap.add file hash t.hashes;
if git then t.to_add <- StringSet.add file t.to_add;
t.modified <- true
let remove t file =
t.hashes <- StringMap.remove file t.hashes;
t.to_remove <- StringSet.add file t.to_remove;
t.modified <- true
let rename t src_file dst_file =
match get t src_file with
| exception Not_found -> ()
| digest ->
remove t src_file;
update t dst_file digest
let perm_equal p1 p2 =
( p1 lsr 6 ) land 7 = ( p2 lsr 6 ) land 7
let digest_content ?(perm=0o644) ~file content =
let content =
if Filename.check_suffix file ".sh" then
String.concat "" (EzString.split content '\r')
else
content
in
let perm = ( perm lsr 6 ) land 7 in
Digest.string (Printf.sprintf "%s.%d" content perm)
let digest_file file =
let content = EzFile.read_file file in
let perm = ( Unix.lstat file ). Unix.st_perm in
digest_content ~perm content
let save ?(git = true) t =
if t.modified then begin
List.iter
(fun (record, file, content, perm) ->
let dirname = Filename.dirname file in
if not (Sys.file_exists dirname) then EzFile.make_dir ~p:true dirname;
EzFile.write_file file content;
Unix.chmod file perm;
if record then update t file (digest_content ~file ~perm content))
t.files;
let b = Buffer.create 1000 in
Printf.bprintf b
"# Keep this file in your GIT repo to help drom track generated files\n";
Printf.bprintf b "# begin version\n%!";
Printf.bprintf b "version:%s\n%!" Version.version;
Printf.bprintf b "# end version\n%!";
StringMap.iter
(fun filename hash ->
if Sys.file_exists filename then begin
if filename = "." then begin
Printf.bprintf b "\n# hash of toml configuration files\n";
Printf.bprintf b "# used for generation of all files\n"
end else begin
Printf.bprintf b "\n# begin context for %s\n" filename;
Printf.bprintf b "# file %s\n" filename
end;
Printf.bprintf b "%s:%s\n" (Digest.to_hex hash) filename;
Printf.bprintf b "# end context for %s\n" filename
end)
t.hashes;
EzFile.write_file ".drom" (Buffer.contents b);
if git && Sys.file_exists ".git" then (
let to_remove = ref [] in
StringSet.iter
(fun file ->
if not (Sys.file_exists file) then to_remove := file :: !to_remove)
t.to_remove;
if !to_remove <> [] then Git.run ("rm" :: "-f" :: !to_remove);
let to_add = ref [] in
StringSet.iter
(fun file -> if Sys.file_exists file then to_add := file :: !to_add)
t.to_add;
Git.run ("add" :: ".drom" :: !to_add)
);
t.to_add <- StringSet.empty;
t.to_remove <- StringSet.empty;
t.modified <- false
end
let with_ctxt ?git f =
let t = load () in
begin
match t.skel_version with
| None -> ()
| Some version ->
if VersionCompare.compare version Version.version > 0 then begin
Printf.eprintf
"Error: you cannot update this project files:\n%!";
Printf.eprintf
" Your version: %s\n%!" Version.version;
Printf.eprintf
" Minimal version to update files: %s\n%!" version;
Printf.eprintf
" (to force acceptance, update the version line in .drom file)\n%!";
exit 2
end
end;
match f t with
| res ->
save ?git t;
res
| exception exn ->
let bt = Printexc.get_raw_backtrace () in
save t;
Printexc.raise_with_backtrace exn bt