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