-
Notifications
You must be signed in to change notification settings - Fork 1
/
buildlog.ml
271 lines (252 loc) · 6.86 KB
/
buildlog.ml
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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
let buildlog_index = "buildlog.index"
let conf_file = "buildlog.conf"
type dict_t = {
branch: string;
index: (string * string) list
}
let rebuild_index manifest repo branch =
let path = manifest ^ "/carbon/" ^ branch ^ "/daily" in
let dir = Unix.opendir path in
let rec read_manifest ac =
try
let name = Unix.readdir dir in
match name with
| "." | ".." -> read_manifest ac
| build ->
let file = open_in (path ^ "/" ^ build ^ "/manifest") in
let rec loop () =
let line = input_line file in
Scanf.sscanf line "%s %s %s" (fun _ repo' hash ->
if repo' = repo then
hash
else
loop ()
)
in
try
let hash = loop () in
close_in file;
let ac =
if not (List.mem_assoc hash ac) then
(hash, build) :: ac
else if (int_of_string (List.assoc hash ac)) > (int_of_string build) then begin
let ac = List.remove_assoc hash ac in
(hash, build) :: ac
end else
ac
in
read_manifest ac
with End_of_file ->
close_in file;
read_manifest ac
with End_of_file ->
Unix.closedir dir;
ac
in
let index = read_manifest [] in
let index = List.sort (fun (_, b) (_, b') -> compare (int_of_string b) (int_of_string b')) index in
let index, _ = List.fold_left (fun (ac, prev) (h, b) ->
match prev with
| None -> (h, b) :: ac, Some h
| Some h' ->
let cmd = Printf.sprintf "git log %s..%s --pretty=oneline" h' h in
let input = Unix.open_process_in cmd in
let rec loop ac =
try
let line = input_line input in
let h = String.sub line 0 40 in
loop ((h, b) :: ac)
with End_of_file ->
ac
in
let extra =
try
ignore (input_line input);
loop []
with End_of_file -> []
in
ignore (Unix.close_process_in input);
(h, b) :: extra @ ac, Some h
) ([], None) index in
let out = open_out (branch ^ "-" ^ buildlog_index) in
List.iter (fun (h, b) -> Printf.fprintf out "%s %s\n" h b) index;
close_out out;
{branch = branch; index = index}
let read_index branch =
let file = open_in (branch ^ "-" ^ buildlog_index) in
let rec loop ac =
try
Scanf.fscanf file "%s %s\n" (fun hash build ->
loop ((hash, build) :: ac)
)
with End_of_file ->
ac
in
let index = loop [] in
close_in file;
{branch = branch; index = index}
let string_of_info commit dict =
let print =
Printf.sprintf "First %s build: %s" dict.branch
in
if List.mem_assoc commit dict.index then
print (List.assoc commit dict.index)
else
print "none"
let is_in_range range build =
match range with
| None, None -> true
| Some b, None -> build >= b
| None, Some b -> build <= b && build > -1
| Some b, Some b' -> build >= b && build <= b'
let output_log dicts out commit log =
match commit with
| None -> ()
| Some commit' ->
let info = List.map (string_of_info commit') dicts in
let output = (List.hd log) :: info @ (List.tl log) in
List.iter (fun line -> output_string out (line ^ "\n")) output
let check_range dicts range commit =
match commit with
| None -> false
| Some commit ->
let dicts =
match range with
| _, _, None -> dicts
| _, _, Some branch ->
try [List.find (fun dict -> dict.branch = branch) dicts]
with Not_found -> []
in
let builds = List.map (fun dict ->
if List.mem_assoc commit dict.index then
int_of_string (List.assoc commit dict.index)
else
-1
) dicts in
List.fold_left (fun a b ->
match range with
| x, y, _ -> is_in_range (x, y) b || a
) false builds
let process range dicts =
let out = Unix.open_process_out "less" in
let rec loop log commit =
let output () =
if log <> [] && check_range dicts range commit then
output_log dicts out commit (List.rev log)
in
try
let line = read_line () in
Scanf.sscanf line "%s %s" (fun a b ->
if a = "commit" then begin
output ();
loop [line] (Some b)
end else
loop (line :: log) commit
)
with End_of_file ->
output ();
Unix.close_process_out out
in
loop [] None
let split c s =
let rec loop ac s' =
try
let i = String.index s' c in
let a = String.sub s' 0 i in
let s' = String.sub s' (i + 1) (String.length s' - i - 1) in
loop (a :: ac) s'
with Not_found ->
s' :: ac
in
let words = loop [] s in
List.rev words
let read_conf () =
try
let file = open_in conf_file in
let rec read ac =
try
let line = input_line file in
let words = split ' ' line in
read ((List.hd words, List.tl words) :: ac)
with End_of_file -> ac
in
let conf = read [] in
close_in file ;
conf
with Sys_error _ -> []
let write_conf conf =
let file = open_out conf_file in
List.iter (fun (key, values) ->
output_string file (key ^ " " ^ (String.concat " " values) ^ "\n")
) conf;
close_out file
let make_range range =
try
let branch =
try
let i = String.index range '@' in
Some (String.sub range (i + 1) (String.length range - i - 1))
with Not_found -> None
in
Scanf.sscanf range "%[0-9]..%[0-9]" (fun a b ->
(try Some (int_of_string a) with _ -> None),
(try Some (int_of_string b) with _ -> None),
branch
)
with End_of_file -> None, None, None
let _ =
(* Parse command-line arguments *)
let rebuild = ref false in
let manifest = ref "" in
let repo = ref "" in
let branches = ref "" in
let range = ref "" in
Arg.parse [
"-rebuild", Arg.Set rebuild, "Rebuild the index";
"-manifest", Arg.Set_string manifest, "Path to manifests.hg";
"-repo", Arg.Set_string repo, "Name of the source repository";
"-branches", Arg.Set_string branches, "List of branches";
"-range", Arg.Set_string range, "Only show commits that entered the build in the given range (inclusive)";
]
(fun x -> Printf.printf "Ignoring argument: %s" x)
"Utility that links build numbers and repository logs";
let conf = read_conf () in
if conf = [] && not !rebuild
then begin
print_endline "No config file found. Please run the command with the -rebuild option:" ;
print_string "git log | buildlog -rebuild -manifest <path_to_manifests.hg> " ;
print_endline "-repo <xen-api.git|xen-api-libs.git> -branches trunk,boston" ;
exit 1
end ;
let manifest, conf =
if !manifest <> "" then begin
ignore (List.remove_assoc "manifest" conf);
!manifest, ("manifest", [!manifest]) :: conf
end else
List.hd (List.assoc "manifest" conf), conf
in
let repo, conf =
if !repo <> "" then begin
ignore (List.remove_assoc "repo" conf);
!repo, ("repo", [!repo]) :: conf
end else
List.hd (List.assoc "repo" conf), conf
in
let branches, conf =
if !branches <> "" then begin
ignore (List.remove_assoc "branches" conf);
let branches' = split ',' !branches in
branches', ("branches", branches') :: conf
end else
List.assoc "branches" conf, conf
in
write_conf conf;
let range' = make_range !range in
let dicts = List.map (fun branch ->
if !rebuild then
rebuild_index manifest repo branch
else
read_index branch
) branches
in
process range' dicts