Release coccinelle-0.2.4rc6
[bpt/coccinelle.git] / tools / splitpatch.ml
1 (*
2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
7 *
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
11 *
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
19 *
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
22 *)
23
24
25 (* split patch per file *)
26
27 (* ------------------------------------------------------------------------ *)
28 (* The following are a reminder of what this information should look like.
29 These values are not used. See the README file for information on how to
30 create a .splitpatch file in your home directory. *)
31
32 let from = ref "email@xyz.org"
33 let git_tree = ref "/var/linuxes/linux-next"
34 let git_options = ref "--cc=kernel-janitors@vger.kernel.org --suppress-cc=self"
35 let prefix_before = ref (Some "/var/linuxes/linux-next")
36 let prefix_after = ref (Some "/var/julia/linuxcopy")
37
38 (* ------------------------------------------------------------------------ *)
39 (* misc *)
40
41 let process_output_to_list2 = fun command ->
42 let chan = Unix.open_process_in command in
43 let res = ref ([] : string list) in
44 let rec process_otl_aux () =
45 let e = input_line chan in
46 res := e::!res;
47 process_otl_aux() in
48 try process_otl_aux ()
49 with End_of_file ->
50 let stat = Unix.close_process_in chan in (List.rev !res,stat)
51 let cmd_to_list command =
52 let (l,_) = process_output_to_list2 command in l
53 let process_output_to_list = cmd_to_list
54 let cmd_to_list_and_status = process_output_to_list2
55
56 let safe_chop_extension s = try Filename.chop_extension s with _ -> s
57
58 let safe_get_extension s =
59 match List.rev (Str.split (Str.regexp_string ".") s) with
60 ext::_::rest -> Some (String.concat "." (List.rev rest))
61 | _ -> None
62
63 (* ------------------------------------------------------------------------ *)
64 (* set configuration variables *)
65
66 let from_from_template template =
67 let signed_offs =
68 cmd_to_list (Printf.sprintf "grep Signed-off-by: %s" template) in
69 match signed_offs with
70 x::xs -> String.concat " " (Str.split (Str.regexp "[ \t]+") x)
71 | _ -> failwith "No Signed-off-by in template file"
72
73 let from_from_gitconfig path =
74 let config = path^"/.git/config" in
75 if Sys.file_exists config
76 then
77 let i = open_in config in
78 let rec inner_loop _ =
79 let l = input_line i in
80 match Str.split (Str.regexp "[ \t]+") l with
81 "from"::"="::f -> from := String.concat " " f
82 | _ ->
83 if String.length l >= 1 && String.get l 0 = '['
84 then ()
85 else inner_loop() in
86 let rec outer_loop _ =
87 let l = input_line i in
88 if l = "[sendemail]"
89 then inner_loop()
90 else outer_loop() in
91 (try outer_loop() with Not_found -> ());
92 close_in i
93
94 let read_configs template =
95 let temporary_git_tree = ref None in
96 git_options := "";
97 prefix_before := None;
98 prefix_after := None;
99 (* get information in message template, lowest priority *)
100 from := from_from_template template;
101 (* get information in git config *)
102 let rec loop = function
103 "/" -> ()
104 | path ->
105 if Sys.file_exists ".git"
106 then
107 begin temporary_git_tree := Some path; from_from_gitconfig path end
108 else loop (Filename.dirname path) in
109 loop (Sys.getcwd());
110 (* get information from .splitpatch *)
111 let home = List.hd(cmd_to_list "ls -d ~") in
112 let config = home^"/.splitpatch" in
113 (if Sys.file_exists config
114 then
115 let i = open_in config in
116 let rec loop _ =
117 let l = input_line i in
118 (* bounded split doesn't split at = in value part *)
119 (match Str.bounded_split (Str.regexp "[ \t]*=[ \t]*") l 2 with
120 ["from";s] -> from := s
121 | ["git_tree";s] -> temporary_git_tree := Some s
122 | ["git_options";s] -> git_options := s
123 | ["prefix_before";s] -> prefix_before := Some s
124 | ["prefix_after";s] -> prefix_after := Some s
125 | _ -> Printf.fprintf stderr "unknown line: %s\n" l);
126 loop() in
127 try loop() with End_of_file -> close_in i);
128 match !temporary_git_tree with
129 None -> failwith "Unable to find Linux source tree"
130 | Some g -> git_tree := g
131
132 (* ------------------------------------------------------------------------ *)
133
134 let maintainer_command file =
135 Printf.sprintf
136 "cd %s; scripts/get_maintainer.pl --separator , --nogit -f %s"
137 !git_tree file
138
139 let subsystem_command file =
140 Printf.sprintf
141 "cd %s; scripts/get_maintainer.pl --nogit --subsystem -f %s | grep -v @"
142 !git_tree file
143
144 let checkpatch_command file =
145 Printf.sprintf "cd %s; scripts/checkpatch.pl %s" !git_tree file
146
147 let default_string = "THE REST" (* split by file *)
148
149 (* ------------------------------------------------------------------------ *)
150 (* ------------------------------------------------------------------------ *)
151 (* Template file processing *)
152
153 let read_up_to_dashes i =
154 let lines = ref [] in
155 let rec loop _ =
156 let l = input_line i in
157 if l = "---"
158 then ()
159 else begin lines := l :: !lines; loop() end in
160 (try loop() with End_of_file -> ());
161 let lines =
162 match !lines with
163 ""::lines -> List.rev lines (* drop last line if blank *)
164 | lines -> List.rev lines in
165 match lines with
166 ""::lines -> lines (* drop first line if blank *)
167 | _ -> lines
168
169 let get_template_information file =
170 let i = open_in file in
171 (* subject *)
172 let subject = read_up_to_dashes i in
173 match subject with
174 [subject] ->
175 let cover = read_up_to_dashes i in
176 let message = read_up_to_dashes i in
177 if message = []
178 then (subject,None,cover)
179 else (subject,Some cover,message)
180 | _ ->
181 failwith
182 ("Subject must be exactly one line "^
183 (string_of_int (List.length subject)))
184
185 (* ------------------------------------------------------------------------ *)
186 (* ------------------------------------------------------------------------ *)
187 (* Patch processing *)
188
189 let spaces = Str.regexp "[ \t]+"
190
191 let fix_before_after l prefix = function
192 Some old_prefix ->
193 (match Str.split spaces l with
194 ("diff"|"+++"|"---")::_ ->
195 (match Str.split (Str.regexp old_prefix) l with
196 [a;b] ->
197 (match Str.split_delim (Str.regexp ("[ \t]"^prefix)) a with
198 [_;""] -> a^b (* prefix is already there *)
199 | _ -> a^prefix^b)
200 | _ -> l)
201 | _ -> l)
202 | _ -> l
203
204 let fix_date l =
205 match Str.split spaces l with
206 (("+++"|"---") as a)::path::rest -> Printf.sprintf "%s %s" a path
207 | _ -> l
208
209 (* ------------------------------------------------------------------------ *)
210
211 let is_diff = Str.regexp "diff "
212 let split_patch i =
213 let patches = ref [] in
214 let cur = ref [] in
215 let get_size l =
216 match Str.split_delim (Str.regexp ",") l with
217 [_;size] -> int_of_string size
218 | [_] -> 1
219 | _ -> failwith ("bad size: "^l) in
220 let rec read_diff_or_atat _ =
221 let l = input_line i in
222 let l = fix_date(fix_before_after l "a" !prefix_before) in
223 let l = fix_date(fix_before_after l "b" !prefix_after) in
224 match Str.split spaces l with
225 "diff"::_ ->
226 (if List.length !cur > 0
227 then patches := List.rev !cur :: !patches);
228 cur := [l];
229 read_diff()
230 | "@@"::min::pl::"@@"::rest ->
231 let msize = get_size min in
232 let psize = get_size pl in
233 cur := l :: !cur;
234 read_hunk msize psize
235 | "\\"::_ -> cur := l :: !cur; read_diff_or_atat()
236 | _ ->
237 failwith
238 "expected diff or @@ (diffstat information should not be present)"
239 and read_diff _ =
240 let l = input_line i in
241 let l = fix_date(fix_before_after l "a" !prefix_before) in
242 let l = fix_date(fix_before_after l "b" !prefix_after) in
243 cur := l :: !cur;
244 match Str.split spaces l with
245 "+++"::_ -> read_diff_or_atat()
246 | _ -> read_diff()
247 and read_hunk msize psize =
248 if msize = 0 && psize = 0
249 then read_diff_or_atat()
250 else
251 let l = input_line i in
252 cur := l :: !cur;
253 match String.get l 0 with
254 '-' -> read_hunk (msize - 1) psize
255 | '+' -> read_hunk msize (psize - 1)
256 | _ -> read_hunk (msize - 1) (psize - 1) in
257 try read_diff_or_atat()
258 with End_of_file -> List.rev ((List.rev !cur)::!patches)
259
260 (* ------------------------------------------------------------------------ *)
261
262 let resolve_maintainers patches =
263 let maintainer_table = Hashtbl.create (List.length patches) in
264 List.iter
265 (function
266 diff_line::rest ->
267 (match Str.split (Str.regexp " a/") diff_line with
268 [before;after] ->
269 (match Str.split spaces after with
270 file::_ ->
271 let maintainers =
272 List.hd (cmd_to_list (maintainer_command file)) in
273 let subsystems =
274 cmd_to_list (subsystem_command file) in
275 let info = (subsystems,maintainers) in
276 let cell =
277 try Hashtbl.find maintainer_table info
278 with Not_found ->
279 let cell = ref [] in
280 Hashtbl.add maintainer_table info cell;
281 cell in
282 cell := (file,(diff_line :: rest)) :: !cell
283 | _ -> failwith "filename not found")
284 | _ ->
285 failwith (Printf.sprintf "prefix a/ not found in %s" diff_line))
286 | _ -> failwith "bad diff line")
287 patches;
288 maintainer_table
289
290 (* ------------------------------------------------------------------------ *)
291
292 let common_prefix l1 l2 =
293 let rec loop = function
294 ([],_) | (_,[]) -> []
295 | (x::xs,y::ys) when x = y -> x :: (loop (xs,ys))
296 | _ -> [] in
297 match loop (l1,l2) with
298 [] ->
299 failwith
300 (Printf.sprintf "found nothing in common for %s and %s"
301 (String.concat "/" l1) (String.concat "/" l2))
302 | res -> res
303
304 let merge_files the_rest = function
305 [l] -> l
306 | files ->
307 let butlast l = if the_rest then l else List.rev(List.tl(List.rev l)) in
308 match List.map (function s -> Str.split (Str.regexp "/") s) files with
309 first::rest ->
310 let rec loop res = function
311 [] -> String.concat "/" res
312 | x::rest -> loop (common_prefix res x) rest in
313 loop (butlast first) rest
314 | _ -> failwith "not possible"
315
316 (* ------------------------------------------------------------------------ *)
317
318 let print_all o l =
319 List.iter (function x -> Printf.fprintf o "%s\n" x) l
320
321 let make_mail_header o date maintainers ctr number subject =
322 Printf.fprintf o "From nobody %s\n" date;
323 Printf.fprintf o "From: %s\n" !from;
324 (match Str.split (Str.regexp_string ",") maintainers with
325 [x] -> Printf.fprintf o "To: %s\n" x
326 | x::xs ->
327 Printf.fprintf o "To: %s\n" x;
328 Printf.fprintf o "Cc: %s\n" (String.concat "," xs)
329 | _ -> failwith "no maintainers");
330 if number = 1
331 then Printf.fprintf o "Subject: [PATCH] %s\n\n" subject
332 else Printf.fprintf o "Subject: [PATCH %d/%d] %s\n\n" ctr number subject
333
334 let make_message_files subject cover message date maintainer_table
335 patch front add_ext =
336 let ctr = ref 0 in
337 let elements =
338 Hashtbl.fold
339 (function (services,maintainers) ->
340 function diffs ->
341 function rest ->
342 if services=[default_string]
343 then
344 (* if no maintainer, then one file per diff *)
345 (List.map
346 (function (file,diff) ->
347 ctr := !ctr + 1;
348 (!ctr,true,maintainers,[file],[diff]))
349 (List.rev !diffs)) @
350 rest
351 else
352 begin
353 ctr := !ctr + 1;
354 let (files,diffs) = List.split (List.rev !diffs) in
355 (!ctr,false,maintainers,files,diffs)::rest
356 end)
357 maintainer_table [] in
358 let number = List.length elements in
359 let generated =
360 List.map
361 (function (ctr,the_rest,maintainers,files,diffs) ->
362 let output_file = add_ext(Printf.sprintf "%s%d" front ctr) in
363 let o = open_out output_file in
364 make_mail_header o date maintainers ctr number
365 (Printf.sprintf "%s: %s" (merge_files the_rest files) subject);
366 print_all o message;
367 Printf.fprintf o "\n---\n";
368 let (nm,o1) = Filename.open_temp_file "patch" "patch" in
369 List.iter (print_all o1) (List.rev diffs);
370 close_out o1;
371 let diffstat =
372 cmd_to_list
373 (Printf.sprintf "diffstat -p1 < %s ; /bin/rm %s" nm nm) in
374 List.iter (print_all o) [diffstat];
375 Printf.fprintf o "\n";
376 List.iter (print_all o) diffs;
377 Printf.fprintf o "\n";
378 close_out o;
379 let (info,stat) =
380 cmd_to_list_and_status
381 (checkpatch_command ((Sys.getcwd())^"/"^output_file)) in
382 (if not(stat = Unix.WEXITED 0)
383 then (print_all stderr info; Printf.fprintf stderr "\n"));
384 output_file)
385 (List.rev elements) in
386 let later = add_ext(Printf.sprintf "%s%d" front (number+1)) in
387 if Sys.file_exists later
388 then Printf.fprintf stderr "Warning: %s and other files may be left over from a previous run\n" later;
389 generated
390
391 let make_cover_file n subject cover front date maintainer_table =
392 match cover with
393 None -> ()
394 | Some cover ->
395 let common_maintainers =
396 let intersect l1 l2 =
397 List.rev
398 (List.fold_left
399 (function i -> function cur ->
400 if List.mem cur l2 then cur :: i else i)
401 [] l1) in
402 let start = ref true in
403 String.concat ","
404 (Hashtbl.fold
405 (function (services,maintainers) ->
406 function diffs ->
407 function rest ->
408 let cur = Str.split (Str.regexp_string ",") maintainers in
409 if !start
410 then begin start := false; cur end
411 else intersect cur rest)
412 maintainer_table []) in
413 let output_file = Printf.sprintf "%s.cover" front in
414 let o = open_out output_file in
415 make_mail_header o date common_maintainers 0 n subject;
416 print_all o cover;
417 Printf.fprintf o "\n";
418 close_out o
419
420 let mail_sender = "git send-email" (* use this when it works *)
421 let mail_sender = "cocci-send-email.perl"
422
423 let generate_command front cover generated =
424 let output_file = front^".cmd" in
425 let o = open_out output_file in
426 (match cover with
427 None ->
428 Printf.fprintf o
429 "%s --auto-to --no-thread --from=\"%s\" %s $* %s\n"
430 mail_sender !from !git_options
431 (String.concat " " generated)
432 | Some cover ->
433 Printf.fprintf o
434 "%s --auto-to --thread --from=\"%s\" %s $* %s\n"
435 mail_sender !from !git_options
436 (String.concat " " ((front^".cover") :: generated)));
437 close_out o
438
439 let make_output_files subject cover message maintainer_table patch =
440 let date = List.hd (cmd_to_list "date") in
441 let front = safe_chop_extension patch in
442 let add_ext =
443 match safe_get_extension patch with
444 Some ext -> (function s -> s ^ "." ^ ext)
445 | None -> (function s -> s) in
446 let generated =
447 make_message_files subject cover message date maintainer_table
448 patch front add_ext in
449 make_cover_file (List.length generated) subject cover front date
450 maintainer_table;
451 generate_command front cover generated
452
453 (* ------------------------------------------------------------------------ *)
454
455 let parse_args l =
456 let (other_args,files) =
457 List.partition
458 (function a -> String.length a > 1 && String.get a 0 = '-')
459 l in
460 match files with
461 [file] -> (file,String.concat " " other_args)
462 | _ -> failwith "Only one file allowed"
463
464 let _ =
465 let (file,git_args) = parse_args (List.tl (Array.to_list Sys.argv)) in
466 let message_file = (safe_chop_extension file)^".msg" in
467 (* set up environment *)
468 read_configs message_file;
469 (if not (git_args = "") then git_options := !git_options^" "^git_args);
470 (* get message information *)
471 let (subject,cover,message) = get_template_information message_file in
472 (* split patch *)
473 let i = open_in file in
474 let patches = split_patch i in
475 close_in i;
476 let maintainer_table = resolve_maintainers patches in
477 make_output_files subject cover message maintainer_table file