tools/split_patch.ml

   1 (*
   2  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   3  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   4  * This file is part of Coccinelle.
   5  *
   6  * Coccinelle is free software: you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation, according to version 2 of the License.
   9  *
  10  * Coccinelle is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  17  *
  18  * The authors reserve the right to distribute this or future versions of
  19  * Coccinelle under other licenses.
  20  *)
  21
  22
  23 open Common
  24
  25 module CP = Classic_patch
  26
  27 (* ./split_patch ../demos/janitorings/patch-kzalloc-vnew3.patch /tmp/xx "0 -> NULL" ../bodymail.doc
  28 ./split_patch /tmp/badzero.patch /tmp/xx ../mailbody.doc ../kernel_dirs.meta
  29
  30 update: see  http://lwn.net/Articles/284469/
  31 for a script using git annotate to find automatically to who send
  32 a patch (by looking at authors of lines close concerning the patch I guess
  33 *)
  34
  35 (*****************************************************************************)
  36 (* Flags *)
  37 (*****************************************************************************)
  38
  39 let just_patch = ref false
  40 let verbose = ref true
  41
  42 let pr2 s =
  43   if !verbose then pr2 s
  44
  45 (*****************************************************************************)
  46 (* Helpers *)
  47 (*****************************************************************************)
  48
  49 let print_header_patch patch =
  50   patch +> List.iter (function CP.File (s, header, body) -> pr s)
  51
  52
  53 (*****************************************************************************)
  54 (* Grouping strategies *)
  55 (*****************************************************************************)
  56
  57 let group_patch_depth_2 patch =
  58   let patch_with_dir = patch +> List.map (function (CP.File (s,header,body)) ->
  59     Common.split "/" (Common.dirname s),
  60     (CP.File (s, header, body))
  61   )
  62   in
  63   let rec aux_patch xs =
  64     match xs with
  65     | [] -> []
  66     | (dir_elems,x)::xs ->
  67         let cond, base =
  68           if List.length dir_elems >= 2 then
  69             let base = Common.take 2 dir_elems in
  70             (fun dir_elems' ->
  71               List.length dir_elems' >= 2 && Common.take 2 dir_elems' = base),
  72             base
  73           else
  74             (fun dir_elems' -> dir_elems' = dir_elems),
  75             dir_elems
  76         in
  77
  78         let (yes, no) = xs +> Common.partition_either (fun (dir_elems', x) ->
  79           if cond dir_elems'
  80           then Left x
  81           else Right (dir_elems', x)
  82         ) in
  83         (Common.join "/" base, ["NOEMAIL"], (x::yes))::aux_patch no
  84   in
  85   aux_patch patch_with_dir
  86
  87
  88
  89 let group_patch_subsystem_info patch subinfo =
  90   let patch_with_dir = patch +> List.map (function (CP.File (s,header,body)) ->
  91     (Common.dirname s),     (CP.File (s, header, body))
  92   )
  93   in
  94   let index = Maintainers.mk_inverted_index_subsystem subinfo in
  95   let hash = Maintainers.subsystem_to_hash subinfo in
  96
  97   let rec aux_patch xs =
  98     match xs with
  99     | [] -> []
 100     | ((dir,patchitem)::xs) as xs' ->
 101         let leader =
 102           try Hashtbl.find index dir
 103           with Not_found -> failwith ("cant find leader for : " ^ dir)
 104         in
 105         let (emailsleader, subdirs) =
 106           try Hashtbl.find hash leader
 107           with Not_found -> failwith ("cant find subdirs of : " ^ leader)
 108         in
 109
 110         (match emailsleader with
 111         | ["NOEMAIL"] | [] | [""] -> pr2 ("no leader maintainer for: "^leader);
 112         | _ -> ()
 113         );
 114
 115         let emails = ref emailsleader in
 116         let allsubdirs = (leader, emailsleader)::subdirs in
 117
 118         let (yes, no) = xs' +> Common.partition_either (fun (dir',patchitem')->
 119           try (
 120             let emailsdir' = List.assoc dir' allsubdirs in
 121             emails := !emails $+$ emailsdir';
 122             Left patchitem'
 123           ) with Not_found -> Right (dir', patchitem')
 124          (*
 125           if List.mem dir' (leader::subdirs)
 126           then Left x
 127           else Right (dir', x)
 128          *)
 129         ) in
 130         (leader, !emails, yes)::aux_patch no
 131   in
 132   aux_patch patch_with_dir
 133
 134
 135 (*****************************************************************************)
 136 (* Split patch *)
 137 (*****************************************************************************)
 138 let i_to_s_padded i total =
 139   match i with
 140   | i when i < 10 && total >= 10 -> "0" ^ i_to_s i
 141   | i when i < 100 -> i_to_s i
 142   | i -> i_to_s i
 143
 144 let split_patch file prefix bodymail subinfofile =
 145   let patch = CP.parse_patch file in
 146
 147   let subsystem_info = Maintainers.parse_subsystem_info subinfofile in
 148   let minipatches = group_patch_subsystem_info patch subsystem_info in
 149   (* let minipatches = group_patch_depth_2 patch in *)
 150
 151   let total = List.length minipatches in
 152   let minipatches_indexed = Common.index_list_1 minipatches in
 153
 154   let (subject, bodymail_rest) =
 155     match Common.cat bodymail with
 156     | x::y::xs ->
 157         if x =~ "Subject: \\(.*\\)"
 158         then
 159           let subject = matched1 x in
 160           if y =~ "[-]+$"
 161           then
 162             subject, xs
 163           else failwith ("wrong format for mailbody in:" ^ bodymail)
 164         else failwith ("wrong format for mailbody in:" ^ bodymail)
 165     | _ -> failwith ("wrong format for mailbody in:" ^ bodymail)
 166   in
 167
 168   Common.command2_y_or_no ("rm -f " ^ prefix ^ "*");
 169
 170
 171   minipatches_indexed +> List.iter (fun ((dir,emails, minipatch), i) ->
 172     let numpatch = i_to_s_padded  i total in
 173     let tmpfile = prefix ^  numpatch ^ ".mail" in
 174     let patchfile = "/tmp/x.patch" in
 175     pr2 ("generating :" ^ tmpfile ^ " for " ^ dir);
 176
 177     CP.unparse_patch minipatch patchfile;
 178
 179     let emails =
 180       (match emails with
 181       | ["NOEMAIL"] | [] | [""] ->
 182           pr2 "no maintainer"; []
 183       | xs -> xs
 184       ) @ ["akpm@linux-foundation.org"]
 185     in
 186
 187
 188     if !just_patch
 189     then command2(sprintf "cat %s > %s" patchfile tmpfile)
 190     else begin
 191       Common.with_open_outfile tmpfile (fun (pr_no_nl, chan) ->
 192         let pr s = pr_no_nl (s ^ "\n") in
 193         pr "To: kernel-janitors@vger.kernel.org";
 194         pr (sprintf "Subject: [PATCH %s/%d] %s, for %s"
 195                numpatch total subject dir);
 196         pr ("Cc: " ^ (Common.join ", " (emails @ ["linux-kernel@vger.kernel.org"])));
 197         pr "BCC: padator@wanadoo.fr";
 198         pr "From: Yoann Padioleau <padator@wanadoo.fr>";
 199         pr "--text follows this line--";
 200
 201         pr "";
 202         bodymail_rest +> List.iter pr;
 203         pr "";
 204         pr "Signed-off-by: Yoann Padioleau <padator@wanadoo.fr>";
 205         emails +> List.iter (fun s ->
 206           pr ("Cc: " ^ s)
 207         );
 208         pr "---";
 209
 210         pr "";
 211       );
 212
 213       command2(sprintf "diffstat -p1 %s >> %s" patchfile tmpfile);
 214       command2(sprintf "echo >> %s" tmpfile);
 215       command2(sprintf "cat %s >> %s" patchfile tmpfile);
 216     end
 217   )
 218
 219
 220
 221 (*****************************************************************************)
 222 (* Test *)
 223 (*****************************************************************************)
 224
 225 let test_patch file =
 226   let patch = CP.parse_patch file in
 227   let groups = group_patch_depth_2 patch in
 228   groups +> List.iter (fun (dir, email, minipatch) ->
 229     print_header_patch minipatch;
 230     pr ""
 231   )
 232
 233
 234 (*****************************************************************************)
 235 (* Main entry point *)
 236 (*****************************************************************************)
 237
 238 let main () =
 239   begin
 240     let args = ref [] in
 241     let options = [
 242       "-just_patch", Arg.Set just_patch, "";
 243       "-no_verbose", Arg.Clear verbose, "";
 244     ] in
 245     let usage_msg =
 246       "Usage: " ^ basename Sys.argv.(0) ^
 247         " <patch> <prefix> <bodymailfile> <maintainerfile> [options]" ^ "\n"
 248       ^ "Options are:"
 249     in
 250
 251     Arg.parse (Arg.align options) (fun x -> args := x::!args) usage_msg;
 252     args := List.rev !args;
 253
 254     (match (!args) with
 255     | [patch] -> test_patch patch
 256     | [patch;prefix;bodymail;subinfofile] ->
 257         split_patch patch prefix bodymail subinfofile;
 258
 259         command2("rm -f /tmp/split_check*");
 260         let checkfile = "/tmp/split_check.all" in
 261         let checkprefix = "/tmp/split_check-xx" in
 262         save_excursion verbose (fun () ->
 263         save_excursion just_patch (fun () ->
 264           just_patch := true;
 265           verbose := false;
 266           split_patch patch checkprefix bodymail subinfofile;
 267         ));
 268         command2("cat /tmp/split_check*.mail > " ^ checkfile);
 269
 270         let diff = Common.cmd_to_list (sprintf "diff %s %s " patch checkfile)
 271         in
 272         let samesize = Common.filesize patch = Common.filesize checkfile in
 273         if (List.length diff <> 0)
 274         then
 275           if samesize
 276           then pr2 "diff but at least same size"
 277           else pr2 "PB: diff and not same size"
 278
 279     | _ -> Arg.usage (Arg.align options) usage_msg;
 280     )
 281   end
 282
 283 (*****************************************************************************)
 284 let _ =
 285   main ()
 286