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