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     | _ -> failwith ("bad size: "^l) in
 219   let rec read_diff_or_atat _ =
 220     let l = input_line i in
 221     let l = fix_date(fix_before_after l "a" !prefix_before) in
 222     let l = fix_date(fix_before_after l "b" !prefix_after) in
 223     match Str.split spaces l with
 224       "diff"::_ ->
 225         (if List.length !cur > 0
 226         then patches := List.rev !cur :: !patches);
 227         cur := [l];
 228         read_diff()
 229     | "@@"::min::pl::"@@"::rest ->
 230         let msize = get_size min in
 231         let psize = get_size pl in
 232         cur := l :: !cur;
 233         read_hunk msize psize
 234     | "\\"::_ -> cur := l :: !cur; read_diff_or_atat()
 235     | _ ->
 236         failwith
 237           "expected diff or @@ (diffstat information should not be present)"
 238   and read_diff _ =
 239     let l = input_line i in
 240     let l = fix_date(fix_before_after l "a" !prefix_before) in
 241     let l = fix_date(fix_before_after l "b" !prefix_after) in
 242     cur := l :: !cur;
 243     match Str.split spaces l with
 244       "+++"::_ -> read_diff_or_atat()
 245     | _ -> read_diff()
 246   and read_hunk msize psize =
 247     if msize = 0 && psize = 0
 248     then read_diff_or_atat()
 249     else
 250       let l = input_line i in
 251       cur := l :: !cur;
 252       match String.get l 0 with
 253         '-' -> read_hunk (msize - 1) psize
 254       | '+' -> read_hunk msize (psize - 1)
 255       | _ -> read_hunk (msize - 1) (psize - 1) in
 256   try read_diff_or_atat()
 257   with End_of_file -> List.rev ((List.rev !cur)::!patches)
 258
 259 (* ------------------------------------------------------------------------ *)
 260
 261 let resolve_maintainers patches =
 262   let maintainer_table = Hashtbl.create (List.length patches) in
 263   List.iter
 264     (function
 265         diff_line::rest ->
 266           (match Str.split (Str.regexp " a/") diff_line with
 267             [before;after] ->
 268               (match Str.split spaces after with
 269                 file::_ ->
 270                   let maintainers =
 271                     List.hd (cmd_to_list (maintainer_command file)) in
 272                   let subsystems =
 273                     cmd_to_list (subsystem_command file) in
 274                   let info = (subsystems,maintainers) in
 275                   let cell =
 276                     try Hashtbl.find maintainer_table info
 277                     with Not_found ->
 278                       let cell = ref [] in
 279                       Hashtbl.add maintainer_table info cell;
 280                       cell in
 281                   cell := (file,(diff_line :: rest)) :: !cell
 282               | _ -> failwith "filename not found")
 283           | _ ->
 284               failwith (Printf.sprintf "prefix a/ not found in %s" diff_line))
 285       | _ -> failwith "bad diff line")
 286     patches;
 287   maintainer_table
 288
 289 (* ------------------------------------------------------------------------ *)
 290
 291 let common_prefix l1 l2 =
 292   let rec loop = function
 293       ([],_) | (_,[]) -> []
 294     | (x::xs,y::ys) when x = y -> x :: (loop (xs,ys))
 295     | _ -> [] in
 296   match loop (l1,l2) with
 297     [] ->
 298       failwith
 299         (Printf.sprintf "found nothing in common for %s and %s"
 300            (String.concat "/" l1) (String.concat "/" l2))
 301   | res -> res
 302
 303 let merge_files the_rest = function
 304     [l] -> l
 305   | files ->
 306       let butlast l = if the_rest then l else List.rev(List.tl(List.rev l)) in
 307       match List.map (function s -> Str.split (Str.regexp "/") s) files with
 308         first::rest ->
 309           let rec loop res = function
 310               [] -> String.concat "/" res
 311             | x::rest -> loop (common_prefix res x) rest in
 312           loop (butlast first) rest
 313       | _ -> failwith "not possible"
 314
 315 (* ------------------------------------------------------------------------ *)
 316
 317 let print_all o l =
 318   List.iter (function x -> Printf.fprintf o "%s\n" x) l
 319
 320 let make_mail_header o date maintainers ctr number subject =
 321   Printf.fprintf o "From nobody %s\n" date;
 322   Printf.fprintf o "From: %s\n" !from;
 323   (match Str.split (Str.regexp_string ",") maintainers with
 324     [x] -> Printf.fprintf o "To: %s\n" x
 325   | x::xs ->
 326       Printf.fprintf o "To: %s\n" x;
 327       Printf.fprintf o "Cc: %s\n" (String.concat "," xs)
 328   | _ -> failwith "no maintainers");
 329   if number = 1
 330   then Printf.fprintf o "Subject: [PATCH] %s\n\n" subject
 331   else Printf.fprintf o "Subject: [PATCH %d/%d] %s\n\n" ctr number subject
 332
 333 let make_message_files subject cover message date maintainer_table
 334     patch front add_ext =
 335   let ctr = ref 0 in
 336   let elements =
 337     Hashtbl.fold
 338       (function (services,maintainers) ->
 339         function diffs ->
 340           function rest ->
 341             if services=[default_string]
 342             then
 343               (* if no maintainer, then one file per diff *)
 344               (List.map
 345                  (function (file,diff) ->
 346                    ctr := !ctr + 1;
 347                    (!ctr,true,maintainers,[file],[diff]))
 348                  (List.rev !diffs)) @
 349               rest
 350             else
 351               begin
 352                 ctr := !ctr + 1;
 353                 let (files,diffs) = List.split (List.rev !diffs) in
 354                 (!ctr,false,maintainers,files,diffs)::rest
 355               end)
 356       maintainer_table [] in
 357   let number = List.length elements in
 358   let generated =
 359     List.map
 360       (function (ctr,the_rest,maintainers,files,diffs) ->
 361         let output_file = add_ext(Printf.sprintf "%s%d" front ctr) in
 362         let o = open_out output_file in
 363         make_mail_header o date maintainers ctr number
 364           (Printf.sprintf "%s: %s" (merge_files the_rest files) subject);
 365         print_all o message;
 366         Printf.fprintf o "\n---\n";
 367         let (nm,o1) = Filename.open_temp_file "patch" "patch" in
 368         List.iter (print_all o1) (List.rev diffs);
 369         close_out o1;
 370         let diffstat =
 371           cmd_to_list
 372             (Printf.sprintf "diffstat -p1 < %s ; /bin/rm %s" nm nm) in
 373         List.iter (print_all o) [diffstat];
 374         Printf.fprintf o "\n";
 375         List.iter (print_all o) diffs;
 376         Printf.fprintf o "\n";
 377         close_out o;
 378         let (info,stat) =
 379           cmd_to_list_and_status
 380             (checkpatch_command ((Sys.getcwd())^"/"^output_file)) in
 381         (if not(stat = Unix.WEXITED 0)
 382         then (print_all stderr info; Printf.fprintf stderr "\n"));
 383         output_file)
 384       (List.rev elements) in
 385   let later = add_ext(Printf.sprintf "%s%d" front (number+1)) in
 386   if Sys.file_exists later
 387   then Printf.fprintf stderr "Warning: %s and other files may be left over from a previous run\n" later;
 388   generated
 389
 390 let make_cover_file n subject cover front date maintainer_table =
 391   match cover with
 392     None -> ()
 393   | Some cover ->
 394       let common_maintainers =
 395         let intersect l1 l2 =
 396           List.rev
 397             (List.fold_left
 398                (function i -> function cur ->
 399                  if List.mem cur l2 then cur :: i else i)
 400                [] l1) in
 401         let start = ref true in
 402         String.concat ","
 403           (Hashtbl.fold
 404              (function (services,maintainers) ->
 405                function diffs ->
 406                  function rest ->
 407                    let cur = Str.split (Str.regexp_string ",") maintainers in
 408                    if !start
 409                    then begin start := false; cur end
 410                    else intersect cur rest)
 411              maintainer_table []) in
 412       let output_file = Printf.sprintf "%s.cover" front in
 413       let o = open_out output_file in
 414       make_mail_header o date common_maintainers 0 n subject;
 415       print_all o cover;
 416       Printf.fprintf o "\n";
 417       close_out o
 418
 419 let mail_sender = "git send-email" (* use this when it works *)
 420 let mail_sender = "cocci-send-email.perl"
 421
 422 let generate_command front cover generated =
 423   let output_file = front^".cmd" in
 424   let o = open_out output_file in
 425   (match cover with
 426     None ->
 427       Printf.fprintf o
 428         "%s --auto-to --no-thread --from=\"%s\" %s $* %s\n"
 429         mail_sender !from !git_options
 430         (String.concat " " generated)
 431   | Some cover ->
 432       Printf.fprintf o
 433         "%s --auto-to --thread --from=\"%s\" %s $* %s\n"
 434         mail_sender !from !git_options
 435         (String.concat " " ((front^".cover") :: generated)));
 436   close_out o
 437
 438 let make_output_files subject cover message maintainer_table patch =
 439   let date = List.hd (cmd_to_list "date") in
 440   let front = safe_chop_extension patch in
 441   let add_ext =
 442     match safe_get_extension patch with
 443       Some ext -> (function s -> s ^ "." ^ ext)
 444     | None -> (function s -> s) in
 445   let generated =
 446     make_message_files subject cover message date maintainer_table
 447       patch front add_ext in
 448   make_cover_file (List.length generated) subject cover front date
 449     maintainer_table;
 450   generate_command front cover generated
 451
 452 (* ------------------------------------------------------------------------ *)
 453
 454 let parse_args l =
 455   let (other_args,files) =
 456     List.partition
 457       (function a -> String.length a > 1 && String.get a 0 = '-')
 458       l in
 459   match files with
 460     [file] -> (file,String.concat " " other_args)
 461   | _ -> failwith "Only one file allowed"
 462
 463 let _ =
 464   let (file,git_args) = parse_args (List.tl (Array.to_list Sys.argv)) in
 465   let message_file = (safe_chop_extension file)^".msg" in
 466   (* set up environment *)
 467   read_configs message_file;
 468   (if not (git_args = "") then git_options := !git_options^" "^git_args);
 469   (* get message information *)
 470   let (subject,cover,message) = get_template_information message_file in
 471   (* split patch *)
 472   let i = open_in file in
 473   let patches = split_patch i in
 474   close_in i;
 475   let maintainer_table = resolve_maintainers patches in
 476   make_output_files subject cover message maintainer_table file