tools/splitpatch.ml

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