scripts/get_maintainer.pl

   1 #!/usr/bin/env perl
   2 # SPDX-License-Identifier: GPL-2.0
   3 #
   4 # (c) 2007, Joe Perches <joe@perches.com>
   5 #           created from checkpatch.pl
   6 #
   7 # Print selected MAINTAINERS information for
   8 # the files modified in a patch or for a file
   9 #
  10 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
  11 #        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
  12
  13 use warnings;
  14 use strict;
  15
  16 my $P = $0;
  17 my $V = '0.26';
  18
  19 use Getopt::Long qw(:config no_auto_abbrev);
  20 use Cwd;
  21 use File::Find;
  22 use File::Spec::Functions;
  23 use open qw(:std :encoding(UTF-8));
  24
  25 my $cur_path = fastgetcwd() . '/';
  26 my $lk_path = "./";
  27 my $email = 1;
  28 my $email_usename = 1;
  29 my $email_maintainer = 1;
  30 my $email_reviewer = 1;
  31 my $email_fixes = 1;
  32 my $email_list = 1;
  33 my $email_moderated_list = 1;
  34 my $email_subscriber_list = 0;
  35 my $email_git_penguin_chiefs = 0;
  36 my $email_git = 0;
  37 my $email_git_all_signature_types = 0;
  38 my $email_git_blame = 0;
  39 my $email_git_blame_signatures = 1;
  40 my $email_git_fallback = 1;
  41 my $email_git_min_signatures = 1;
  42 my $email_git_max_maintainers = 5;
  43 my $email_git_min_percent = 5;
  44 my $email_git_since = "1-year-ago";
  45 my $email_hg_since = "-365";
  46 my $interactive = 0;
  47 my $email_remove_duplicates = 1;
  48 my $email_use_mailmap = 1;
  49 my $output_multiline = 1;
  50 my $output_separator = ", ";
  51 my $output_roles = 0;
  52 my $output_rolestats = 1;
  53 my $output_substatus = undef;
  54 my $output_section_maxlen = 50;
  55 my $scm = 0;
  56 my $tree = 1;
  57 my $web = 0;
  58 my $bug = 0;
  59 my $subsystem = 0;
  60 my $status = 0;
  61 my $letters = "";
  62 my $keywords = 1;
  63 my $keywords_in_file = 0;
  64 my $sections = 0;
  65 my $email_file_emails = 0;
  66 my $from_filename = 0;
  67 my $pattern_depth = 0;
  68 my $self_test = undef;
  69 my $version = 0;
  70 my $help = 0;
  71 my $find_maintainer_files = 0;
  72 my $maintainer_path;
  73 my $vcs_used = 0;
  74
  75 my $exit = 0;
  76
  77 my @files = ();
  78 my @fixes = ();                 # If a patch description includes Fixes: lines
  79 my @range = ();
  80 my @keyword_tvi = ();
  81 my @file_emails = ();
  82
  83 my %commit_author_hash;
  84 my %commit_signer_hash;
  85
  86 my @penguin_chief = ();
  87 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
  88 #Andrew wants in on most everything - 2009/01/14
  89 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
  90
  91 my @penguin_chief_names = ();
  92 foreach my $chief (@penguin_chief) {
  93     if ($chief =~ m/^(.*):(.*)/) {
  94         my $chief_name = $1;
  95         my $chief_addr = $2;
  96         push(@penguin_chief_names, $chief_name);
  97     }
  98 }
  99 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
 100
 101 # Signature types of people who are either
 102 #       a) responsible for the code in question, or
 103 #       b) familiar enough with it to give relevant feedback
 104 my @signature_tags = ();
 105 push(@signature_tags, "Signed-off-by:");
 106 push(@signature_tags, "Reviewed-by:");
 107 push(@signature_tags, "Acked-by:");
 108
 109 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 110
 111 # rfc822 email address - preloaded methods go here.
 112 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
 113 my $rfc822_char = '[\\000-\\377]';
 114
 115 # VCS command support: class-like functions and strings
 116
 117 my %VCS_cmds;
 118
 119 my %VCS_cmds_git = (
 120     "execute_cmd" => \&git_execute_cmd,
 121     "available" => '(which("git") ne "") && (-e ".git")',
 122     "find_signers_cmd" =>
 123         "git log --no-color --follow --since=\$email_git_since " .
 124             '--numstat --no-merges ' .
 125             '--format="GitCommit: %H%n' .
 126                       'GitAuthor: %an <%ae>%n' .
 127                       'GitDate: %aD%n' .
 128                       'GitSubject: %s%n' .
 129                       '%b%n"' .
 130             " -- \$file",
 131     "find_commit_signers_cmd" =>
 132         "git log --no-color " .
 133             '--numstat ' .
 134             '--format="GitCommit: %H%n' .
 135                       'GitAuthor: %an <%ae>%n' .
 136                       'GitDate: %aD%n' .
 137                       'GitSubject: %s%n' .
 138                       '%b%n"' .
 139             " -1 \$commit",
 140     "find_commit_author_cmd" =>
 141         "git log --no-color " .
 142             '--numstat ' .
 143             '--format="GitCommit: %H%n' .
 144                       'GitAuthor: %an <%ae>%n' .
 145                       'GitDate: %aD%n' .
 146                       'GitSubject: %s%n"' .
 147             " -1 \$commit",
 148     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 149     "blame_file_cmd" => "git blame -l \$file",
 150     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 151     "blame_commit_pattern" => "^([0-9a-f]+) ",
 152     "author_pattern" => "^GitAuthor: (.*)",
 153     "subject_pattern" => "^GitSubject: (.*)",
 154     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
 155     "file_exists_cmd" => "git ls-files \$file",
 156     "list_files_cmd" => "git ls-files \$file",
 157 );
 158
 159 my %VCS_cmds_hg = (
 160     "execute_cmd" => \&hg_execute_cmd,
 161     "available" => '(which("hg") ne "") && (-d ".hg")',
 162     "find_signers_cmd" =>
 163         "hg log --date=\$email_hg_since " .
 164             "--template='HgCommit: {node}\\n" .
 165                         "HgAuthor: {author}\\n" .
 166                         "HgSubject: {desc}\\n'" .
 167             " -- \$file",
 168     "find_commit_signers_cmd" =>
 169         "hg log " .
 170             "--template='HgSubject: {desc}\\n'" .
 171             " -r \$commit",
 172     "find_commit_author_cmd" =>
 173         "hg log " .
 174             "--template='HgCommit: {node}\\n" .
 175                         "HgAuthor: {author}\\n" .
 176                         "HgSubject: {desc|firstline}\\n'" .
 177             " -r \$commit",
 178     "blame_range_cmd" => "",            # not supported
 179     "blame_file_cmd" => "hg blame -n \$file",
 180     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 181     "blame_commit_pattern" => "^([ 0-9a-f]+):",
 182     "author_pattern" => "^HgAuthor: (.*)",
 183     "subject_pattern" => "^HgSubject: (.*)",
 184     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
 185     "file_exists_cmd" => "hg files \$file",
 186     "list_files_cmd" => "hg manifest -R \$file",
 187 );
 188
 189 my $conf = which_conf(".get_maintainer.conf");
 190 if (-f $conf) {
 191     my @conf_args;
 192     open(my $conffile, '<', "$conf")
 193         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 194
 195     while (<$conffile>) {
 196         my $line = $_;
 197
 198         $line =~ s/\s*\n?$//g;
 199         $line =~ s/^\s*//g;
 200         $line =~ s/\s+/ /g;
 201
 202         next if ($line =~ m/^\s*#/);
 203         next if ($line =~ m/^\s*$/);
 204
 205         my @words = split(" ", $line);
 206         foreach my $word (@words) {
 207             last if ($word =~ m/^#/);
 208             push (@conf_args, $word);
 209         }
 210     }
 211     close($conffile);
 212     unshift(@ARGV, @conf_args) if @conf_args;
 213 }
 214
 215 my @ignore_emails = ();
 216 my $ignore_file = which_conf(".get_maintainer.ignore");
 217 if (-f $ignore_file) {
 218     open(my $ignore, '<', "$ignore_file")
 219         or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
 220     while (<$ignore>) {
 221         my $line = $_;
 222
 223         $line =~ s/\s*\n?$//;
 224         $line =~ s/^\s*//;
 225         $line =~ s/\s+$//;
 226         $line =~ s/#.*$//;
 227
 228         next if ($line =~ m/^\s*$/);
 229         if (rfc822_valid($line)) {
 230             push(@ignore_emails, $line);
 231         }
 232     }
 233     close($ignore);
 234 }
 235
 236 if ($#ARGV > 0) {
 237     foreach (@ARGV) {
 238         if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
 239             die "$P: using --self-test does not allow any other option or argument\n";
 240         }
 241     }
 242 }
 243
 244 if (!GetOptions(
 245                 'email!' => \$email,
 246                 'git!' => \$email_git,
 247                 'git-all-signature-types!' => \$email_git_all_signature_types,
 248                 'git-blame!' => \$email_git_blame,
 249                 'git-blame-signatures!' => \$email_git_blame_signatures,
 250                 'git-fallback!' => \$email_git_fallback,
 251                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
 252                 'git-min-signatures=i' => \$email_git_min_signatures,
 253                 'git-max-maintainers=i' => \$email_git_max_maintainers,
 254                 'git-min-percent=i' => \$email_git_min_percent,
 255                 'git-since=s' => \$email_git_since,
 256                 'hg-since=s' => \$email_hg_since,
 257                 'i|interactive!' => \$interactive,
 258                 'remove-duplicates!' => \$email_remove_duplicates,
 259                 'mailmap!' => \$email_use_mailmap,
 260                 'm!' => \$email_maintainer,
 261                 'r!' => \$email_reviewer,
 262                 'n!' => \$email_usename,
 263                 'l!' => \$email_list,
 264                 'fixes!' => \$email_fixes,
 265                 'moderated!' => \$email_moderated_list,
 266                 's!' => \$email_subscriber_list,
 267                 'multiline!' => \$output_multiline,
 268                 'roles!' => \$output_roles,
 269                 'rolestats!' => \$output_rolestats,
 270                 'separator=s' => \$output_separator,
 271                 'subsystem!' => \$subsystem,
 272                 'status!' => \$status,
 273                 'substatus!' => \$output_substatus,
 274                 'scm!' => \$scm,
 275                 'tree!' => \$tree,
 276                 'web!' => \$web,
 277                 'bug!' => \$bug,
 278                 'letters=s' => \$letters,
 279                 'pattern-depth=i' => \$pattern_depth,
 280                 'k|keywords!' => \$keywords,
 281                 'kf|keywords-in-file!' => \$keywords_in_file,
 282                 'sections!' => \$sections,
 283                 'fe|file-emails!' => \$email_file_emails,
 284                 'f|file' => \$from_filename,
 285                 'find-maintainer-files' => \$find_maintainer_files,
 286                 'mpath|maintainer-path=s' => \$maintainer_path,
 287                 'self-test:s' => \$self_test,
 288                 'v|version' => \$version,
 289                 'h|help|usage' => \$help,
 290                 )) {
 291     die "$P: invalid argument - use --help if necessary\n";
 292 }
 293
 294 if ($help != 0) {
 295     usage();
 296     exit 0;
 297 }
 298
 299 if ($version != 0) {
 300     print("${P} ${V}\n");
 301     exit 0;
 302 }
 303
 304 if (defined $self_test) {
 305     read_all_maintainer_files();
 306     self_test();
 307     exit 0;
 308 }
 309
 310 if (-t STDIN && !@ARGV) {
 311     # We're talking to a terminal, but have no command line arguments.
 312     die "$P: missing patchfile or -f file - use --help if necessary\n";
 313 }
 314
 315 $output_multiline = 0 if ($output_separator ne ", ");
 316 $output_rolestats = 1 if ($interactive);
 317 $output_roles = 1 if ($output_rolestats);
 318
 319 if (!defined $output_substatus) {
 320     $output_substatus = $email && $output_roles && -t STDOUT;
 321 }
 322
 323 if ($sections || $letters ne "") {
 324     $sections = 1;
 325     $email = 0;
 326     $email_list = 0;
 327     $scm = 0;
 328     $status = 0;
 329     $subsystem = 0;
 330     $web = 0;
 331     $bug = 0;
 332     $keywords = 0;
 333     $keywords_in_file = 0;
 334     $interactive = 0;
 335 } else {
 336     my $selections = $email + $scm + $status + $subsystem + $web + $bug;
 337     if ($selections == 0) {
 338         die "$P:  Missing required option: email, scm, status, subsystem, web or bug\n";
 339     }
 340 }
 341
 342 if ($email &&
 343     ($email_maintainer + $email_reviewer +
 344      $email_list + $email_subscriber_list +
 345      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 346     die "$P: Please select at least 1 email option\n";
 347 }
 348
 349 if ($tree && !top_of_kernel_tree($lk_path)) {
 350     die "$P: The current directory does not appear to be "
 351         . "a linux kernel source tree.\n";
 352 }
 353
 354 ## Read MAINTAINERS for type/value pairs
 355
 356 my @typevalue = ();
 357 my %keyword_hash;
 358 my @mfiles = ();
 359 my @self_test_info = ();
 360
 361 sub read_maintainer_file {
 362     my ($file) = @_;
 363
 364     open (my $maint, '<', "$file")
 365         or die "$P: Can't open MAINTAINERS file '$file': $!\n";
 366     my $i = 1;
 367     while (<$maint>) {
 368         my $line = $_;
 369         chomp $line;
 370
 371         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 372             my $type = $1;
 373             my $value = $2;
 374
 375             ##Filename pattern matching
 376             if ($type eq "F" || $type eq "X") {
 377                 $value =~ s@\.@\\\.@g;       ##Convert . to \.
 378                 $value =~ s/\*/\.\*/g;       ##Convert * to .*
 379                 $value =~ s/\?/\./g;         ##Convert ? to .
 380                 ##if pattern is a directory and it lacks a trailing slash, add one
 381                 if ((-d $value)) {
 382                     $value =~ s@([^/])$@$1/@;
 383                 }
 384             } elsif ($type eq "K") {
 385                 $keyword_hash{@typevalue} = $value;
 386             }
 387             push(@typevalue, "$type:$value");
 388         } elsif (!(/^\s*$/ || /^\s*\#/)) {
 389             push(@typevalue, $line);
 390         }
 391         if (defined $self_test) {
 392             push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
 393         }
 394         $i++;
 395     }
 396     close($maint);
 397 }
 398
 399 sub find_is_maintainer_file {
 400     my ($file) = $_;
 401     return if ($file !~ m@/MAINTAINERS$@);
 402     $file = $File::Find::name;
 403     return if (! -f $file);
 404     push(@mfiles, $file);
 405 }
 406
 407 sub find_ignore_git {
 408     return grep { $_ !~ /^\.git$/; } @_;
 409 }
 410
 411 read_all_maintainer_files();
 412
 413 sub read_all_maintainer_files {
 414     my $path = "${lk_path}MAINTAINERS";
 415     if (defined $maintainer_path) {
 416         $path = $maintainer_path;
 417         # Perl Cookbook tilde expansion if necessary
 418         $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex;
 419     }
 420
 421     if (-d $path) {
 422         $path .= '/' if ($path !~ m@/$@);
 423         if ($find_maintainer_files) {
 424             find( { wanted => \&find_is_maintainer_file,
 425                     preprocess => \&find_ignore_git,
 426                     no_chdir => 1,
 427                 }, "$path");
 428         } else {
 429             opendir(DIR, "$path") or die $!;
 430             my @files = readdir(DIR);
 431             closedir(DIR);
 432             foreach my $file (@files) {
 433                 push(@mfiles, "$path$file") if ($file !~ /^\./);
 434             }
 435         }
 436     } elsif (-f "$path") {
 437         push(@mfiles, "$path");
 438     } else {
 439         die "$P: MAINTAINER file not found '$path'\n";
 440     }
 441     die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0);
 442     foreach my $file (@mfiles) {
 443         read_maintainer_file("$file");
 444     }
 445 }
 446
 447 sub maintainers_in_file {
 448     my ($file) = @_;
 449
 450     return if ($file =~ m@\bMAINTAINERS$@);
 451
 452     if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) {
 453         open(my $f, '<', $file)
 454             or die "$P: Can't open $file: $!\n";
 455         my $text = do { local($/) ; <$f> };
 456         close($f);
 457
 458         my @poss_addr = $text =~ m$[\p{L}\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
 459         push(@file_emails, clean_file_emails(@poss_addr));
 460     }
 461 }
 462
 463 #
 464 # Read mail address map
 465 #
 466
 467 my $mailmap;
 468
 469 read_mailmap();
 470
 471 sub read_mailmap {
 472     $mailmap = {
 473         names => {},
 474         addresses => {}
 475     };
 476
 477     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 478
 479     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 480         or warn "$P: Can't open .mailmap: $!\n";
 481
 482     while (<$mailmap_file>) {
 483         s/#.*$//; #strip comments
 484         s/^\s+|\s+$//g; #trim
 485
 486         next if (/^\s*$/); #skip empty lines
 487         #entries have one of the following formats:
 488         # name1 <mail1>
 489         # <mail1> <mail2>
 490         # name1 <mail1> <mail2>
 491         # name1 <mail1> name2 <mail2>
 492         # (see man git-shortlog)
 493
 494         if (/^([^<]+)<([^>]+)>$/) {
 495             my $real_name = $1;
 496             my $address = $2;
 497
 498             $real_name =~ s/\s+$//;
 499             ($real_name, $address) = parse_email("$real_name <$address>");
 500             $mailmap->{names}->{$address} = $real_name;
 501
 502         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 503             my $real_address = $1;
 504             my $wrong_address = $2;
 505
 506             $mailmap->{addresses}->{$wrong_address} = $real_address;
 507
 508         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 509             my $real_name = $1;
 510             my $real_address = $2;
 511             my $wrong_address = $3;
 512
 513             $real_name =~ s/\s+$//;
 514             ($real_name, $real_address) =
 515                 parse_email("$real_name <$real_address>");
 516             $mailmap->{names}->{$wrong_address} = $real_name;
 517             $mailmap->{addresses}->{$wrong_address} = $real_address;
 518
 519         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 520             my $real_name = $1;
 521             my $real_address = $2;
 522             my $wrong_name = $3;
 523             my $wrong_address = $4;
 524
 525             $real_name =~ s/\s+$//;
 526             ($real_name, $real_address) =
 527                 parse_email("$real_name <$real_address>");
 528
 529             $wrong_name =~ s/\s+$//;
 530             ($wrong_name, $wrong_address) =
 531                 parse_email("$wrong_name <$wrong_address>");
 532
 533             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 534             $mailmap->{names}->{$wrong_email} = $real_name;
 535             $mailmap->{addresses}->{$wrong_email} = $real_address;
 536         }
 537     }
 538     close($mailmap_file);
 539 }
 540
 541 ## use the filenames on the command line or find the filenames in the patchfiles
 542
 543 if (!@ARGV) {
 544     push(@ARGV, "&STDIN");
 545 }
 546
 547 foreach my $file (@ARGV) {
 548     if ($file ne "&STDIN") {
 549         $file = canonpath($file);
 550         ##if $file is a directory and it lacks a trailing slash, add one
 551         if ((-d $file)) {
 552             $file =~ s@([^/])$@$1/@;
 553         } elsif (!(-f $file)) {
 554             die "$P: file '${file}' not found\n";
 555         }
 556     }
 557     if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) {
 558         warn "$P: file '$file' not found in version control $!\n";
 559     }
 560     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
 561         $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
 562         $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
 563         push(@files, $file);
 564         if ($file ne "MAINTAINERS" && -f $file && $keywords && $keywords_in_file) {
 565             open(my $f, '<', $file)
 566                 or die "$P: Can't open $file: $!\n";
 567             my $text = do { local($/) ; <$f> };
 568             close($f);
 569             foreach my $line (keys %keyword_hash) {
 570                 if ($text =~ m/$keyword_hash{$line}/x) {
 571                     push(@keyword_tvi, $line);
 572                 }
 573             }
 574         }
 575     } else {
 576         my $file_cnt = @files;
 577         my $lastfile;
 578
 579         open(my $patch, "< $file")
 580             or die "$P: Can't open $file: $!\n";
 581
 582         # We can check arbitrary information before the patch
 583         # like the commit message, mail headers, etc...
 584         # This allows us to match arbitrary keywords against any part
 585         # of a git format-patch generated file (subject tags, etc...)
 586
 587         my $patch_prefix = "";                  #Parsing the intro
 588
 589         while (<$patch>) {
 590             my $patch_line = $_;
 591             if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) {
 592                 my $filename = $1;
 593                 push(@files, $filename);
 594             } elsif (m/^rename (?:from|to) (\S+)\s*$/) {
 595                 my $filename = $1;
 596                 push(@files, $filename);
 597             } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) {
 598                 my $filename1 = $1;
 599                 my $filename2 = $2;
 600                 push(@files, $filename1);
 601                 push(@files, $filename2);
 602             } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) {
 603                 push(@fixes, $1) if ($email_fixes);
 604             } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 605                 my $filename = $1;
 606                 $filename =~ s@^[^/]*/@@;
 607                 $filename =~ s@\n@@;
 608                 $lastfile = $filename;
 609                 push(@files, $filename);
 610                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 611             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 612                 if ($email_git_blame) {
 613                     push(@range, "$lastfile:$1:$2");
 614                 }
 615             } elsif ($keywords) {
 616                 foreach my $line (keys %keyword_hash) {
 617                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 618                         push(@keyword_tvi, $line);
 619                     }
 620                 }
 621             }
 622         }
 623         close($patch);
 624
 625         if ($file_cnt == @files) {
 626             warn "$P: file '${file}' doesn't appear to be a patch.  "
 627                 . "Add -f to options?\n";
 628         }
 629         @files = sort_and_uniq(@files);
 630     }
 631 }
 632
 633 @file_emails = uniq(@file_emails);
 634 @fixes = uniq(@fixes);
 635
 636 my %email_hash_name;
 637 my %email_hash_address;
 638 my @email_to = ();
 639 my %hash_list_to;
 640 my @list_to = ();
 641 my @scm = ();
 642 my @web = ();
 643 my @bug = ();
 644 my @subsystem = ();
 645 my @status = ();
 646 my @substatus = ();
 647 my %deduplicate_name_hash = ();
 648 my %deduplicate_address_hash = ();
 649
 650 my @maintainers = get_maintainers();
 651 if (@maintainers) {
 652     @maintainers = merge_email(@maintainers);
 653     output(@maintainers);
 654 }
 655
 656 if ($scm) {
 657     @scm = uniq(@scm);
 658     output(@scm);
 659 }
 660
 661 if ($output_substatus) {
 662     @substatus = uniq(@substatus);
 663     output(@substatus);
 664 }
 665
 666 if ($status) {
 667     @status = uniq(@status);
 668     output(@status);
 669 }
 670
 671 if ($subsystem) {
 672     @subsystem = uniq(@subsystem);
 673     output(@subsystem);
 674 }
 675
 676 if ($web) {
 677     @web = uniq(@web);
 678     output(@web);
 679 }
 680
 681 if ($bug) {
 682     @bug = uniq(@bug);
 683     output(@bug);
 684 }
 685
 686 exit($exit);
 687
 688 sub self_test {
 689     my @lsfiles = ();
 690     my @good_links = ();
 691     my @bad_links = ();
 692     my @section_headers = ();
 693     my $index = 0;
 694
 695     @lsfiles = vcs_list_files($lk_path);
 696
 697     for my $x (@self_test_info) {
 698         $index++;
 699
 700         ## Section header duplication and missing section content
 701         if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
 702             $x->{line} =~ /^\S[^:]/ &&
 703             defined $self_test_info[$index] &&
 704             $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
 705             my $has_S = 0;
 706             my $has_F = 0;
 707             my $has_ML = 0;
 708             my $status = "";
 709             if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
 710                 print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
 711             } else {
 712                 push(@section_headers, $x->{line});
 713             }
 714             my $nextline = $index;
 715             while (defined $self_test_info[$nextline] &&
 716                    $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
 717                 my $type = $1;
 718                 my $value = $2;
 719                 if ($type eq "S") {
 720                     $has_S = 1;
 721                     $status = $value;
 722                 } elsif ($type eq "F" || $type eq "N") {
 723                     $has_F = 1;
 724                 } elsif ($type eq "M" || $type eq "R" || $type eq "L") {
 725                     $has_ML = 1;
 726                 }
 727                 $nextline++;
 728             }
 729             if (!$has_ML && $status !~ /orphan|obsolete/i) {
 730                 print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
 731             }
 732             if (!$has_S) {
 733                 print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
 734             }
 735             if (!$has_F) {
 736                 print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
 737             }
 738         }
 739
 740         next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
 741
 742         my $type = $1;
 743         my $value = $2;
 744
 745         ## Filename pattern matching
 746         if (($type eq "F" || $type eq "X") &&
 747             ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
 748             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 749             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 750             $value =~ s/\?/\./g;         ##Convert ? to .
 751             ##if pattern is a directory and it lacks a trailing slash, add one
 752             if ((-d $value)) {
 753                 $value =~ s@([^/])$@$1/@;
 754             }
 755             if (!grep(m@^$value@, @lsfiles)) {
 756                 print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
 757             }
 758
 759         ## Link reachability
 760         } elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
 761                  $value =~ /^https?:/ &&
 762                  ($self_test eq "" || $self_test =~ /\blinks\b/)) {
 763             next if (grep(m@^\Q$value\E$@, @good_links));
 764             my $isbad = 0;
 765             if (grep(m@^\Q$value\E$@, @bad_links)) {
 766                 $isbad = 1;
 767             } else {
 768                 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
 769                 if ($? == 0) {
 770                     push(@good_links, $value);
 771                 } else {
 772                     push(@bad_links, $value);
 773                     $isbad = 1;
 774                 }
 775             }
 776             if ($isbad) {
 777                 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
 778             }
 779
 780         ## SCM reachability
 781         } elsif ($type eq "T" &&
 782                  ($self_test eq "" || $self_test =~ /\bscm\b/)) {
 783             next if (grep(m@^\Q$value\E$@, @good_links));
 784             my $isbad = 0;
 785             if (grep(m@^\Q$value\E$@, @bad_links)) {
 786                 $isbad = 1;
 787             } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
 788                 print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
 789             } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
 790                 my $url = $1;
 791                 my $branch = "";
 792                 $branch = $3 if $3;
 793                 my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
 794                 if ($? == 0) {
 795                     push(@good_links, $value);
 796                 } else {
 797                     push(@bad_links, $value);
 798                     $isbad = 1;
 799                 }
 800             } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
 801                 my $url = $1;
 802                 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
 803                 if ($? == 0) {
 804                     push(@good_links, $value);
 805                 } else {
 806                     push(@bad_links, $value);
 807                     $isbad = 1;
 808                 }
 809             }
 810             if ($isbad) {
 811                 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
 812             }
 813         }
 814     }
 815 }
 816
 817 sub ignore_email_address {
 818     my ($address) = @_;
 819
 820     foreach my $ignore (@ignore_emails) {
 821         return 1 if ($ignore eq $address);
 822     }
 823
 824     return 0;
 825 }
 826
 827 sub range_is_maintained {
 828     my ($start, $end) = @_;
 829
 830     for (my $i = $start; $i < $end; $i++) {
 831         my $line = $typevalue[$i];
 832         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 833             my $type = $1;
 834             my $value = $2;
 835             if ($type eq 'S') {
 836                 if ($value =~ /(maintain|support)/i) {
 837                     return 1;
 838                 }
 839             }
 840         }
 841     }
 842     return 0;
 843 }
 844
 845 sub range_has_maintainer {
 846     my ($start, $end) = @_;
 847
 848     for (my $i = $start; $i < $end; $i++) {
 849         my $line = $typevalue[$i];
 850         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 851             my $type = $1;
 852             my $value = $2;
 853             if ($type eq 'M') {
 854                 return 1;
 855             }
 856         }
 857     }
 858     return 0;
 859 }
 860
 861 sub get_maintainers {
 862     %email_hash_name = ();
 863     %email_hash_address = ();
 864     %commit_author_hash = ();
 865     %commit_signer_hash = ();
 866     @email_to = ();
 867     %hash_list_to = ();
 868     @list_to = ();
 869     @scm = ();
 870     @web = ();
 871     @bug = ();
 872     @subsystem = ();
 873     @status = ();
 874     @substatus = ();
 875     %deduplicate_name_hash = ();
 876     %deduplicate_address_hash = ();
 877     if ($email_git_all_signature_types) {
 878         $signature_pattern = "(.+?)[Bb][Yy]:";
 879     } else {
 880         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 881     }
 882
 883     # Find responsible parties
 884
 885     my %exact_pattern_match_hash = ();
 886
 887     foreach my $file (@files) {
 888
 889         my %hash;
 890         my $tvi = find_first_section();
 891         while ($tvi < @typevalue) {
 892             my $start = find_starting_index($tvi);
 893             my $end = find_ending_index($tvi);
 894             my $exclude = 0;
 895             my $i;
 896
 897             #Do not match excluded file patterns
 898
 899             for ($i = $start; $i < $end; $i++) {
 900                 my $line = $typevalue[$i];
 901                 if ($line =~ m/^([A-Z]):\s*(.*)/) {
 902                     my $type = $1;
 903                     my $value = $2;
 904                     if ($type eq 'X') {
 905                         if (file_match_pattern($file, $value)) {
 906                             $exclude = 1;
 907                             last;
 908                         }
 909                     }
 910                 }
 911             }
 912
 913             if (!$exclude) {
 914                 for ($i = $start; $i < $end; $i++) {
 915                     my $line = $typevalue[$i];
 916                     if ($line =~ m/^([A-Z]):\s*(.*)/) {
 917                         my $type = $1;
 918                         my $value = $2;
 919                         if ($type eq 'F') {
 920                             if (file_match_pattern($file, $value)) {
 921                                 my $value_pd = ($value =~ tr@/@@);
 922                                 my $file_pd = ($file  =~ tr@/@@);
 923                                 $value_pd++ if (substr($value,-1,1) ne "/");
 924                                 $value_pd = -1 if ($value =~ /^\.\*/);
 925                                 if ($value_pd >= $file_pd &&
 926                                     range_is_maintained($start, $end) &&
 927                                     range_has_maintainer($start, $end)) {
 928                                     $exact_pattern_match_hash{$file} = 1;
 929                                 }
 930                                 if ($pattern_depth == 0 ||
 931                                     (($file_pd - $value_pd) < $pattern_depth)) {
 932                                     $hash{$tvi} = $value_pd;
 933                                 }
 934                             }
 935                         } elsif ($type eq 'N') {
 936                             if ($file =~ m/$value/x) {
 937                                 $hash{$tvi} = 0;
 938                             }
 939                         }
 940                     }
 941                 }
 942             }
 943             $tvi = $end + 1;
 944         }
 945
 946         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 947             add_categories($line, "");
 948             if ($sections) {
 949                 my $i;
 950                 my $start = find_starting_index($line);
 951                 my $end = find_ending_index($line);
 952                 for ($i = $start; $i < $end; $i++) {
 953                     my $line = $typevalue[$i];
 954                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 955                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 956                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 957                         $line =~ s/\\\./\./g;           ##Convert \. to .
 958                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 959                     }
 960                     my $count = $line =~ s/^([A-Z]):/$1:\t/g;
 961                     if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
 962                         print("$line\n");
 963                     }
 964                 }
 965                 print("\n");
 966             }
 967         }
 968
 969         maintainers_in_file($file);
 970     }
 971
 972     if ($keywords) {
 973         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 974         foreach my $line (@keyword_tvi) {
 975             add_categories($line, ":Keyword:$keyword_hash{$line}");
 976         }
 977     }
 978
 979     foreach my $email (@email_to, @list_to) {
 980         $email->[0] = deduplicate_email($email->[0]);
 981     }
 982
 983     foreach my $file (@files) {
 984         if ($email &&
 985             ($email_git ||
 986              ($email_git_fallback &&
 987               $file !~ /MAINTAINERS$/ &&
 988               !$exact_pattern_match_hash{$file}))) {
 989             vcs_file_signoffs($file);
 990         }
 991         if ($email && $email_git_blame) {
 992             vcs_file_blame($file);
 993         }
 994     }
 995
 996     if ($email) {
 997         foreach my $chief (@penguin_chief) {
 998             if ($chief =~ m/^(.*):(.*)/) {
 999                 my $email_address;
1000
1001                 $email_address = format_email($1, $2, $email_usename);
1002                 if ($email_git_penguin_chiefs) {
1003                     push(@email_to, [$email_address, 'chief penguin']);
1004                 } else {
1005                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
1006                 }
1007             }
1008         }
1009
1010         foreach my $email (@file_emails) {
1011             $email = mailmap_email($email);
1012             my ($name, $address) = parse_email($email);
1013
1014             my $tmp_email = format_email($name, $address, $email_usename);
1015             push_email_address($tmp_email, '');
1016             add_role($tmp_email, 'in file');
1017         }
1018     }
1019
1020     foreach my $fix (@fixes) {
1021         vcs_add_commit_signers($fix, "blamed_fixes");
1022     }
1023
1024     my @to = ();
1025     if ($email || $email_list) {
1026         if ($email) {
1027             @to = (@to, @email_to);
1028         }
1029         if ($email_list) {
1030             @to = (@to, @list_to);
1031         }
1032     }
1033
1034     if ($interactive) {
1035         @to = interactive_get_maintainers(\@to);
1036     }
1037
1038     return @to;
1039 }
1040
1041 sub file_match_pattern {
1042     my ($file, $pattern) = @_;
1043     if (substr($pattern, -1) eq "/") {
1044         if ($file =~ m@^$pattern@) {
1045             return 1;
1046         }
1047     } else {
1048         if ($file =~ m@^$pattern@) {
1049             my $s1 = ($file =~ tr@/@@);
1050             my $s2 = ($pattern =~ tr@/@@);
1051             if ($s1 == $s2) {
1052                 return 1;
1053             }
1054         }
1055     }
1056     return 0;
1057 }
1058
1059 sub usage {
1060     print <<EOT;
1061 usage: $P [options] patchfile
1062        $P [options] -f file|directory
1063 version: $V
1064
1065 MAINTAINER field selection options:
1066   --email => print email address(es) if any
1067     --git => include recent git \*-by: signers
1068     --git-all-signature-types => include signers regardless of signature type
1069         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
1070     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
1071     --git-chief-penguins => include ${penguin_chiefs}
1072     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1073     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1074     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
1075     --git-blame => use git blame to find modified commits for patch or file
1076     --git-blame-signatures => when used with --git-blame, also include all commit signers
1077     --git-since => git history to use (default: $email_git_since)
1078     --hg-since => hg history to use (default: $email_hg_since)
1079     --interactive => display a menu (mostly useful if used with the --git option)
1080     --m => include maintainer(s) if any
1081     --r => include reviewer(s) if any
1082     --n => include name 'Full Name <addr\@domain.tld>'
1083     --l => include list(s) if any
1084     --moderated => include moderated lists(s) if any (default: true)
1085     --s => include subscriber only list(s) if any (default: false)
1086     --remove-duplicates => minimize duplicate email names/addresses
1087     --roles => show roles (role:subsystem, git-signer, list, etc...)
1088     --rolestats => show roles and statistics (commits/total_commits, %)
1089     --substatus => show subsystem status if not Maintained (default: match --roles when output is tty)"
1090     --file-emails => add email addresses found in -f file (default: 0 (off))
1091     --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on))
1092   --scm => print SCM tree(s) if any
1093   --status => print status if any
1094   --subsystem => print subsystem name if any
1095   --web => print website(s) if any
1096   --bug => print bug reporting info if any
1097
1098 Output type options:
1099   --separator [, ] => separator for multiple entries on 1 line
1100     using --separator also sets --nomultiline if --separator is not [, ]
1101   --multiline => print 1 entry per line
1102
1103 Other options:
1104   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
1105   --keywords => scan patch for keywords (default: $keywords)
1106   --keywords-in-file => scan file for keywords (default: $keywords_in_file)
1107   --sections => print all of the subsystem sections with pattern matches
1108   --letters => print all matching 'letter' types from all matching sections
1109   --mailmap => use .mailmap file (default: $email_use_mailmap)
1110   --no-tree => run without a kernel tree
1111   --self-test => show potential issues with MAINTAINERS file content
1112   --version => show version
1113   --help => show this help information
1114
1115 Default options:
1116   [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1117    --pattern-depth=0 --remove-duplicates --rolestats --keywords]
1118
1119 Notes:
1120   Using "-f directory" may give unexpected results:
1121       Used with "--git", git signators for _all_ files in and below
1122           directory are examined as git recurses directories.
1123           Any specified X: (exclude) pattern matches are _not_ ignored.
1124       Used with "--nogit", directory is used as a pattern match,
1125           no individual file within the directory or subdirectory
1126           is matched.
1127       Used with "--git-blame", does not iterate all files in directory
1128   Using "--git-blame" is slow and may add old committers and authors
1129       that are no longer active maintainers to the output.
1130   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1131       other automated tools that expect only ["name"] <email address>
1132       may not work because of additional output after <email address>.
1133   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1134       not the percentage of the entire file authored.  # of commits is
1135       not a good measure of amount of code authored.  1 major commit may
1136       contain a thousand lines, 5 trivial commits may modify a single line.
1137   If git is not installed, but mercurial (hg) is installed and an .hg
1138       repository exists, the following options apply to mercurial:
1139           --git,
1140           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1141           --git-blame
1142       Use --hg-since not --git-since to control date selection
1143   File ".get_maintainer.conf", if it exists in the linux kernel source root
1144       directory, can change whatever get_maintainer defaults are desired.
1145       Entries in this file can be any command line argument.
1146       This file is prepended to any additional command line arguments.
1147       Multiple lines and # comments are allowed.
1148   Most options have both positive and negative forms.
1149       The negative forms for --<foo> are --no<foo> and --no-<foo>.
1150
1151 EOT
1152 }
1153
1154 sub top_of_kernel_tree {
1155     my ($lk_path) = @_;
1156
1157     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1158         $lk_path .= "/";
1159     }
1160     if (   (-f "${lk_path}COPYING")
1161         && (-f "${lk_path}CREDITS")
1162         && (-f "${lk_path}Kbuild")
1163         && (-e "${lk_path}MAINTAINERS")
1164         && (-f "${lk_path}Makefile")
1165         && (-f "${lk_path}README")
1166         && (-d "${lk_path}Documentation")
1167         && (-d "${lk_path}arch")
1168         && (-d "${lk_path}include")
1169         && (-d "${lk_path}drivers")
1170         && (-d "${lk_path}fs")
1171         && (-d "${lk_path}init")
1172         && (-d "${lk_path}ipc")
1173         && (-d "${lk_path}kernel")
1174         && (-d "${lk_path}lib")
1175         && (-d "${lk_path}scripts")) {
1176         return 1;
1177     }
1178     return 0;
1179 }
1180
1181 sub escape_name {
1182     my ($name) = @_;
1183
1184     if ($name =~ /[^\w \-]/ai) {         ##has "must quote" chars
1185         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
1186         $name = "\"$name\"";
1187     }
1188
1189     return $name;
1190 }
1191
1192 sub parse_email {
1193     my ($formatted_email) = @_;
1194
1195     my $name = "";
1196     my $address = "";
1197
1198     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
1199         $name = $1;
1200         $address = $2;
1201     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
1202         $address = $1;
1203     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
1204         $address = $1;
1205     }
1206
1207     $name =~ s/^\s+|\s+$//g;
1208     $name =~ s/^\"|\"$//g;
1209     $name = escape_name($name);
1210     $address =~ s/^\s+|\s+$//g;
1211
1212     return ($name, $address);
1213 }
1214
1215 sub format_email {
1216     my ($name, $address, $usename) = @_;
1217
1218     my $formatted_email;
1219
1220     $name =~ s/^\s+|\s+$//g;
1221     $name =~ s/^\"|\"$//g;
1222     $name = escape_name($name);
1223     $address =~ s/^\s+|\s+$//g;
1224
1225     if ($usename) {
1226         if ("$name" eq "") {
1227             $formatted_email = "$address";
1228         } else {
1229             $formatted_email = "$name <$address>";
1230         }
1231     } else {
1232         $formatted_email = $address;
1233     }
1234
1235     return $formatted_email;
1236 }
1237
1238 sub find_first_section {
1239     my $index = 0;
1240
1241     while ($index < @typevalue) {
1242         my $tv = $typevalue[$index];
1243         if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
1244             last;
1245         }
1246         $index++;
1247     }
1248
1249     return $index;
1250 }
1251
1252 sub find_starting_index {
1253     my ($index) = @_;
1254
1255     while ($index > 0) {
1256         my $tv = $typevalue[$index];
1257         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
1258             last;
1259         }
1260         $index--;
1261     }
1262
1263     return $index;
1264 }
1265
1266 sub find_ending_index {
1267     my ($index) = @_;
1268
1269     while ($index < @typevalue) {
1270         my $tv = $typevalue[$index];
1271         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
1272             last;
1273         }
1274         $index++;
1275     }
1276
1277     return $index;
1278 }
1279
1280 sub get_subsystem_name {
1281     my ($index) = @_;
1282
1283     my $start = find_starting_index($index);
1284
1285     my $subsystem = $typevalue[$start];
1286     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1287         $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
1288         $subsystem =~ s/\s*$//;
1289         $subsystem = $subsystem . "...";
1290     }
1291     return $subsystem;
1292 }
1293
1294 sub get_maintainer_role {
1295     my ($index) = @_;
1296
1297     my $i;
1298     my $start = find_starting_index($index);
1299     my $end = find_ending_index($index);
1300
1301     my $role = "maintainer";
1302     my $subsystem = get_subsystem_name($index);
1303     my $status = "unknown";
1304
1305     for ($i = $start + 1; $i < $end; $i++) {
1306         my $tv = $typevalue[$i];
1307         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1308             my $ptype = $1;
1309             my $pvalue = $2;
1310             if ($ptype eq "S") {
1311                 $status = $pvalue;
1312             }
1313         }
1314     }
1315
1316     $status = lc($status);
1317     if ($status eq "buried alive in reporters") {
1318         $role = "chief penguin";
1319     }
1320
1321     return $role . ":" . $subsystem;
1322 }
1323
1324 sub get_list_role {
1325     my ($index) = @_;
1326
1327     my $subsystem = get_subsystem_name($index);
1328
1329     if ($subsystem eq "THE REST") {
1330         $subsystem = "";
1331     }
1332
1333     return $subsystem;
1334 }
1335
1336 sub add_categories {
1337     my ($index, $suffix) = @_;
1338
1339     my $i;
1340     my $start = find_starting_index($index);
1341     my $end = find_ending_index($index);
1342
1343     my $subsystem = $typevalue[$start];
1344     push(@subsystem, $subsystem);
1345     my $status = "Unknown";
1346
1347     for ($i = $start + 1; $i < $end; $i++) {
1348         my $tv = $typevalue[$i];
1349         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1350             my $ptype = $1;
1351             my $pvalue = $2;
1352             if ($ptype eq "L") {
1353                 my $list_address = $pvalue;
1354                 my $list_additional = "";
1355                 my $list_role = get_list_role($i);
1356
1357                 if ($list_role ne "") {
1358                     $list_role = ":" . $list_role;
1359                 }
1360                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1361                     $list_address = $1;
1362                     $list_additional = $2;
1363                 }
1364                 if ($list_additional =~ m/subscribers-only/) {
1365                     if ($email_subscriber_list) {
1366                         if (!$hash_list_to{lc($list_address)}) {
1367                             $hash_list_to{lc($list_address)} = 1;
1368                             push(@list_to, [$list_address,
1369                                             "subscriber list${list_role}" . $suffix]);
1370                         }
1371                     }
1372                 } else {
1373                     if ($email_list) {
1374                         if (!$hash_list_to{lc($list_address)}) {
1375                             if ($list_additional =~ m/moderated/) {
1376                                 if ($email_moderated_list) {
1377                                     $hash_list_to{lc($list_address)} = 1;
1378                                     push(@list_to, [$list_address,
1379                                                     "moderated list${list_role}" . $suffix]);
1380                                 }
1381                             } else {
1382                                 $hash_list_to{lc($list_address)} = 1;
1383                                 push(@list_to, [$list_address,
1384                                                 "open list${list_role}" . $suffix]);
1385                             }
1386                         }
1387                     }
1388                 }
1389             } elsif ($ptype eq "M") {
1390                 if ($email_maintainer) {
1391                     my $role = get_maintainer_role($i);
1392                     push_email_addresses($pvalue, $role . $suffix);
1393                 }
1394             } elsif ($ptype eq "R") {
1395                 if ($email_reviewer) {
1396                     my $subs = get_subsystem_name($i);
1397                     push_email_addresses($pvalue, "reviewer:$subs" . $suffix);
1398                 }
1399             } elsif ($ptype eq "T") {
1400                 push(@scm, $pvalue . $suffix);
1401             } elsif ($ptype eq "W") {
1402                 push(@web, $pvalue . $suffix);
1403             } elsif ($ptype eq "B") {
1404                 push(@bug, $pvalue . $suffix);
1405             } elsif ($ptype eq "S") {
1406                 push(@status, $pvalue . $suffix);
1407                 $status = $pvalue;
1408             }
1409         }
1410     }
1411
1412     if ($subsystem ne "THE REST" and $status ne "Maintained") {
1413         push(@substatus, $subsystem . " status: " . $status . $suffix)
1414     }
1415 }
1416
1417 sub email_inuse {
1418     my ($name, $address) = @_;
1419
1420     return 1 if (($name eq "") && ($address eq ""));
1421     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1422     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1423
1424     return 0;
1425 }
1426
1427 sub push_email_address {
1428     my ($line, $role) = @_;
1429
1430     my ($name, $address) = parse_email($line);
1431
1432     if ($address eq "") {
1433         return 0;
1434     }
1435
1436     if (!$email_remove_duplicates) {
1437         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1438     } elsif (!email_inuse($name, $address)) {
1439         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1440         $email_hash_name{lc($name)}++ if ($name ne "");
1441         $email_hash_address{lc($address)}++;
1442     }
1443
1444     return 1;
1445 }
1446
1447 sub push_email_addresses {
1448     my ($address, $role) = @_;
1449
1450     my @address_list = ();
1451
1452     if (rfc822_valid($address)) {
1453         push_email_address($address, $role);
1454     } elsif (@address_list = rfc822_validlist($address)) {
1455         my $array_count = shift(@address_list);
1456         while (my $entry = shift(@address_list)) {
1457             push_email_address($entry, $role);
1458         }
1459     } else {
1460         if (!push_email_address($address, $role)) {
1461             warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1462         }
1463     }
1464 }
1465
1466 sub add_role {
1467     my ($line, $role) = @_;
1468
1469     my ($name, $address) = parse_email($line);
1470     my $email = format_email($name, $address, $email_usename);
1471
1472     foreach my $entry (@email_to) {
1473         if ($email_remove_duplicates) {
1474             my ($entry_name, $entry_address) = parse_email($entry->[0]);
1475             if (($name eq $entry_name || $address eq $entry_address)
1476                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1477             ) {
1478                 if ($entry->[1] eq "") {
1479                     $entry->[1] = "$role";
1480                 } else {
1481                     $entry->[1] = "$entry->[1],$role";
1482                 }
1483             }
1484         } else {
1485             if ($email eq $entry->[0]
1486                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1487             ) {
1488                 if ($entry->[1] eq "") {
1489                     $entry->[1] = "$role";
1490                 } else {
1491                     $entry->[1] = "$entry->[1],$role";
1492                 }
1493             }
1494         }
1495     }
1496 }
1497
1498 sub which {
1499     my ($bin) = @_;
1500
1501     foreach my $path (split(/:/, $ENV{PATH})) {
1502         if (-e "$path/$bin") {
1503             return "$path/$bin";
1504         }
1505     }
1506
1507     return "";
1508 }
1509
1510 sub which_conf {
1511     my ($conf) = @_;
1512
1513     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1514         if (-e "$path/$conf") {
1515             return "$path/$conf";
1516         }
1517     }
1518
1519     return "";
1520 }
1521
1522 sub mailmap_email {
1523     my ($line) = @_;
1524
1525     my ($name, $address) = parse_email($line);
1526     my $email = format_email($name, $address, 1);
1527     my $real_name = $name;
1528     my $real_address = $address;
1529
1530     if (exists $mailmap->{names}->{$email} ||
1531         exists $mailmap->{addresses}->{$email}) {
1532         if (exists $mailmap->{names}->{$email}) {
1533             $real_name = $mailmap->{names}->{$email};
1534         }
1535         if (exists $mailmap->{addresses}->{$email}) {
1536             $real_address = $mailmap->{addresses}->{$email};
1537         }
1538     } else {
1539         if (exists $mailmap->{names}->{$address}) {
1540             $real_name = $mailmap->{names}->{$address};
1541         }
1542         if (exists $mailmap->{addresses}->{$address}) {
1543             $real_address = $mailmap->{addresses}->{$address};
1544         }
1545     }
1546     return format_email($real_name, $real_address, 1);
1547 }
1548
1549 sub mailmap {
1550     my (@addresses) = @_;
1551
1552     my @mapped_emails = ();
1553     foreach my $line (@addresses) {
1554         push(@mapped_emails, mailmap_email($line));
1555     }
1556     merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1557     return @mapped_emails;
1558 }
1559
1560 sub merge_by_realname {
1561     my %address_map;
1562     my (@emails) = @_;
1563
1564     foreach my $email (@emails) {
1565         my ($name, $address) = parse_email($email);
1566         if (exists $address_map{$name}) {
1567             $address = $address_map{$name};
1568             $email = format_email($name, $address, 1);
1569         } else {
1570             $address_map{$name} = $address;
1571         }
1572     }
1573 }
1574
1575 sub git_execute_cmd {
1576     my ($cmd) = @_;
1577     my @lines = ();
1578
1579     my $output = `$cmd`;
1580     $output =~ s/^\s*//gm;
1581     @lines = split("\n", $output);
1582
1583     return @lines;
1584 }
1585
1586 sub hg_execute_cmd {
1587     my ($cmd) = @_;
1588     my @lines = ();
1589
1590     my $output = `$cmd`;
1591     @lines = split("\n", $output);
1592
1593     return @lines;
1594 }
1595
1596 sub extract_formatted_signatures {
1597     my (@signature_lines) = @_;
1598
1599     my @type = @signature_lines;
1600
1601     s/\s*(.*):.*/$1/ for (@type);
1602
1603     # cut -f2- -d":"
1604     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1605
1606 ## Reformat email addresses (with names) to avoid badly written signatures
1607
1608     foreach my $signer (@signature_lines) {
1609         $signer = deduplicate_email($signer);
1610     }
1611
1612     return (\@type, \@signature_lines);
1613 }
1614
1615 sub vcs_find_signers {
1616     my ($cmd, $file) = @_;
1617     my $commits;
1618     my @lines = ();
1619     my @signatures = ();
1620     my @authors = ();
1621     my @stats = ();
1622
1623     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1624
1625     my $pattern = $VCS_cmds{"commit_pattern"};
1626     my $author_pattern = $VCS_cmds{"author_pattern"};
1627     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1628
1629     $stat_pattern =~ s/(\$\w+)/$1/eeg;          #interpolate $stat_pattern
1630
1631     $commits = grep(/$pattern/, @lines);        # of commits
1632
1633     @authors = grep(/$author_pattern/, @lines);
1634     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1635     @stats = grep(/$stat_pattern/, @lines);
1636
1637 #    print("stats: <@stats>\n");
1638
1639     return (0, \@signatures, \@authors, \@stats) if !@signatures;
1640
1641     save_commits_by_author(@lines) if ($interactive);
1642     save_commits_by_signer(@lines) if ($interactive);
1643
1644     if (!$email_git_penguin_chiefs) {
1645         @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1646     }
1647
1648     my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1649     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1650
1651     return ($commits, $signers_ref, $authors_ref, \@stats);
1652 }
1653
1654 sub vcs_find_author {
1655     my ($cmd) = @_;
1656     my @lines = ();
1657
1658     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1659
1660     if (!$email_git_penguin_chiefs) {
1661         @lines = grep(!/${penguin_chiefs}/i, @lines);
1662     }
1663
1664     return @lines if !@lines;
1665
1666     my @authors = ();
1667     foreach my $line (@lines) {
1668         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1669             my $author = $1;
1670             my ($name, $address) = parse_email($author);
1671             $author = format_email($name, $address, 1);
1672             push(@authors, $author);
1673         }
1674     }
1675
1676     save_commits_by_author(@lines) if ($interactive);
1677     save_commits_by_signer(@lines) if ($interactive);
1678
1679     return @authors;
1680 }
1681
1682 sub vcs_save_commits {
1683     my ($cmd) = @_;
1684     my @lines = ();
1685     my @commits = ();
1686
1687     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1688
1689     foreach my $line (@lines) {
1690         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1691             push(@commits, $1);
1692         }
1693     }
1694
1695     return @commits;
1696 }
1697
1698 sub vcs_blame {
1699     my ($file) = @_;
1700     my $cmd;
1701     my @commits = ();
1702
1703     return @commits if (!(-f $file));
1704
1705     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1706         my @all_commits = ();
1707
1708         $cmd = $VCS_cmds{"blame_file_cmd"};
1709         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1710         @all_commits = vcs_save_commits($cmd);
1711
1712         foreach my $file_range_diff (@range) {
1713             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1714             my $diff_file = $1;
1715             my $diff_start = $2;
1716             my $diff_length = $3;
1717             next if ("$file" ne "$diff_file");
1718             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1719                 push(@commits, $all_commits[$i]);
1720             }
1721         }
1722     } elsif (@range) {
1723         foreach my $file_range_diff (@range) {
1724             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1725             my $diff_file = $1;
1726             my $diff_start = $2;
1727             my $diff_length = $3;
1728             next if ("$file" ne "$diff_file");
1729             $cmd = $VCS_cmds{"blame_range_cmd"};
1730             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1731             push(@commits, vcs_save_commits($cmd));
1732         }
1733     } else {
1734         $cmd = $VCS_cmds{"blame_file_cmd"};
1735         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1736         @commits = vcs_save_commits($cmd);
1737     }
1738
1739     foreach my $commit (@commits) {
1740         $commit =~ s/^\^//g;
1741     }
1742
1743     return @commits;
1744 }
1745
1746 my $printed_novcs = 0;
1747 sub vcs_exists {
1748     %VCS_cmds = %VCS_cmds_git;
1749     return 1 if eval $VCS_cmds{"available"};
1750     %VCS_cmds = %VCS_cmds_hg;
1751     return 2 if eval $VCS_cmds{"available"};
1752     %VCS_cmds = ();
1753     if (!$printed_novcs && $email_git) {
1754         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1755         warn("Using a git repository produces better results.\n");
1756         warn("Try Linus Torvalds' latest git repository using:\n");
1757         warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1758         $printed_novcs = 1;
1759     }
1760     return 0;
1761 }
1762
1763 sub vcs_is_git {
1764     vcs_exists();
1765     return $vcs_used == 1;
1766 }
1767
1768 sub vcs_is_hg {
1769     return $vcs_used == 2;
1770 }
1771
1772 sub vcs_add_commit_signers {
1773     return if (!vcs_exists());
1774
1775     my ($commit, $desc) = @_;
1776     my $commit_count = 0;
1777     my $commit_authors_ref;
1778     my $commit_signers_ref;
1779     my $stats_ref;
1780     my @commit_authors = ();
1781     my @commit_signers = ();
1782     my $cmd;
1783
1784     $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1785     $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
1786
1787     ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, "");
1788     @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
1789     @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
1790
1791     foreach my $signer (@commit_signers) {
1792         $signer = deduplicate_email($signer);
1793     }
1794
1795     vcs_assign($desc, 1, @commit_signers);
1796 }
1797
1798 sub interactive_get_maintainers {
1799     my ($list_ref) = @_;
1800     my @list = @$list_ref;
1801
1802     vcs_exists();
1803
1804     my %selected;
1805     my %authored;
1806     my %signed;
1807     my $count = 0;
1808     my $maintained = 0;
1809     foreach my $entry (@list) {
1810         $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1811         $selected{$count} = 1;
1812         $authored{$count} = 0;
1813         $signed{$count} = 0;
1814         $count++;
1815     }
1816
1817     #menu loop
1818     my $done = 0;
1819     my $print_options = 0;
1820     my $redraw = 1;
1821     while (!$done) {
1822         $count = 0;
1823         if ($redraw) {
1824             printf STDERR "\n%1s %2s %-65s",
1825                           "*", "#", "email/list and role:stats";
1826             if ($email_git ||
1827                 ($email_git_fallback && !$maintained) ||
1828                 $email_git_blame) {
1829                 print STDERR "auth sign";
1830             }
1831             print STDERR "\n";
1832             foreach my $entry (@list) {
1833                 my $email = $entry->[0];
1834                 my $role = $entry->[1];
1835                 my $sel = "";
1836                 $sel = "*" if ($selected{$count});
1837                 my $commit_author = $commit_author_hash{$email};
1838                 my $commit_signer = $commit_signer_hash{$email};
1839                 my $authored = 0;
1840                 my $signed = 0;
1841                 $authored++ for (@{$commit_author});
1842                 $signed++ for (@{$commit_signer});
1843                 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1844                 printf STDERR "%4d %4d", $authored, $signed
1845                     if ($authored > 0 || $signed > 0);
1846                 printf STDERR "\n     %s\n", $role;
1847                 if ($authored{$count}) {
1848                     my $commit_author = $commit_author_hash{$email};
1849                     foreach my $ref (@{$commit_author}) {
1850                         print STDERR "     Author: @{$ref}[1]\n";
1851                     }
1852                 }
1853                 if ($signed{$count}) {
1854                     my $commit_signer = $commit_signer_hash{$email};
1855                     foreach my $ref (@{$commit_signer}) {
1856                         print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1857                     }
1858                 }
1859
1860                 $count++;
1861             }
1862         }
1863         my $date_ref = \$email_git_since;
1864         $date_ref = \$email_hg_since if (vcs_is_hg());
1865         if ($print_options) {
1866             $print_options = 0;
1867             if (vcs_exists()) {
1868                 print STDERR <<EOT
1869
1870 Version Control options:
1871 g  use git history      [$email_git]
1872 gf use git-fallback     [$email_git_fallback]
1873 b  use git blame        [$email_git_blame]
1874 bs use blame signatures [$email_git_blame_signatures]
1875 c# minimum commits      [$email_git_min_signatures]
1876 %# min percent          [$email_git_min_percent]
1877 d# history to use       [$$date_ref]
1878 x# max maintainers      [$email_git_max_maintainers]
1879 t  all signature types  [$email_git_all_signature_types]
1880 m  use .mailmap         [$email_use_mailmap]
1881 EOT
1882             }
1883             print STDERR <<EOT
1884
1885 Additional options:
1886 0  toggle all
1887 tm toggle maintainers
1888 tg toggle git entries
1889 tl toggle open list entries
1890 ts toggle subscriber list entries
1891 f  emails in file       [$email_file_emails]
1892 k  keywords in file     [$keywords]
1893 r  remove duplicates    [$email_remove_duplicates]
1894 p# pattern match depth  [$pattern_depth]
1895 EOT
1896         }
1897         print STDERR
1898 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1899
1900         my $input = <STDIN>;
1901         chomp($input);
1902
1903         $redraw = 1;
1904         my $rerun = 0;
1905         my @wish = split(/[, ]+/, $input);
1906         foreach my $nr (@wish) {
1907             $nr = lc($nr);
1908             my $sel = substr($nr, 0, 1);
1909             my $str = substr($nr, 1);
1910             my $val = 0;
1911             $val = $1 if $str =~ /^(\d+)$/;
1912
1913             if ($sel eq "y") {
1914                 $interactive = 0;
1915                 $done = 1;
1916                 $output_rolestats = 0;
1917                 $output_roles = 0;
1918                 $output_substatus = 0;
1919                 last;
1920             } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1921                 $selected{$nr - 1} = !$selected{$nr - 1};
1922             } elsif ($sel eq "*" || $sel eq '^') {
1923                 my $toggle = 0;
1924                 $toggle = 1 if ($sel eq '*');
1925                 for (my $i = 0; $i < $count; $i++) {
1926                     $selected{$i} = $toggle;
1927                 }
1928             } elsif ($sel eq "0") {
1929                 for (my $i = 0; $i < $count; $i++) {
1930                     $selected{$i} = !$selected{$i};
1931                 }
1932             } elsif ($sel eq "t") {
1933                 if (lc($str) eq "m") {
1934                     for (my $i = 0; $i < $count; $i++) {
1935                         $selected{$i} = !$selected{$i}
1936                             if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1937                     }
1938                 } elsif (lc($str) eq "g") {
1939                     for (my $i = 0; $i < $count; $i++) {
1940                         $selected{$i} = !$selected{$i}
1941                             if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1942                     }
1943                 } elsif (lc($str) eq "l") {
1944                     for (my $i = 0; $i < $count; $i++) {
1945                         $selected{$i} = !$selected{$i}
1946                             if ($list[$i]->[1] =~ /^(open list)/i);
1947                     }
1948                 } elsif (lc($str) eq "s") {
1949                     for (my $i = 0; $i < $count; $i++) {
1950                         $selected{$i} = !$selected{$i}
1951                             if ($list[$i]->[1] =~ /^(subscriber list)/i);
1952                     }
1953                 }
1954             } elsif ($sel eq "a") {
1955                 if ($val > 0 && $val <= $count) {
1956                     $authored{$val - 1} = !$authored{$val - 1};
1957                 } elsif ($str eq '*' || $str eq '^') {
1958                     my $toggle = 0;
1959                     $toggle = 1 if ($str eq '*');
1960                     for (my $i = 0; $i < $count; $i++) {
1961                         $authored{$i} = $toggle;
1962                     }
1963                 }
1964             } elsif ($sel eq "s") {
1965                 if ($val > 0 && $val <= $count) {
1966                     $signed{$val - 1} = !$signed{$val - 1};
1967                 } elsif ($str eq '*' || $str eq '^') {
1968                     my $toggle = 0;
1969                     $toggle = 1 if ($str eq '*');
1970                     for (my $i = 0; $i < $count; $i++) {
1971                         $signed{$i} = $toggle;
1972                     }
1973                 }
1974             } elsif ($sel eq "o") {
1975                 $print_options = 1;
1976                 $redraw = 1;
1977             } elsif ($sel eq "g") {
1978                 if ($str eq "f") {
1979                     bool_invert(\$email_git_fallback);
1980                 } else {
1981                     bool_invert(\$email_git);
1982                 }
1983                 $rerun = 1;
1984             } elsif ($sel eq "b") {
1985                 if ($str eq "s") {
1986                     bool_invert(\$email_git_blame_signatures);
1987                 } else {
1988                     bool_invert(\$email_git_blame);
1989                 }
1990                 $rerun = 1;
1991             } elsif ($sel eq "c") {
1992                 if ($val > 0) {
1993                     $email_git_min_signatures = $val;
1994                     $rerun = 1;
1995                 }
1996             } elsif ($sel eq "x") {
1997                 if ($val > 0) {
1998                     $email_git_max_maintainers = $val;
1999                     $rerun = 1;
2000                 }
2001             } elsif ($sel eq "%") {
2002                 if ($str ne "" && $val >= 0) {
2003                     $email_git_min_percent = $val;
2004                     $rerun = 1;
2005                 }
2006             } elsif ($sel eq "d") {
2007                 if (vcs_is_git()) {
2008                     $email_git_since = $str;
2009                 } elsif (vcs_is_hg()) {
2010                     $email_hg_since = $str;
2011                 }
2012                 $rerun = 1;
2013             } elsif ($sel eq "t") {
2014                 bool_invert(\$email_git_all_signature_types);
2015                 $rerun = 1;
2016             } elsif ($sel eq "f") {
2017                 bool_invert(\$email_file_emails);
2018                 $rerun = 1;
2019             } elsif ($sel eq "r") {
2020                 bool_invert(\$email_remove_duplicates);
2021                 $rerun = 1;
2022             } elsif ($sel eq "m") {
2023                 bool_invert(\$email_use_mailmap);
2024                 read_mailmap();
2025                 $rerun = 1;
2026             } elsif ($sel eq "k") {
2027                 bool_invert(\$keywords);
2028                 $rerun = 1;
2029             } elsif ($sel eq "p") {
2030                 if ($str ne "" && $val >= 0) {
2031                     $pattern_depth = $val;
2032                     $rerun = 1;
2033                 }
2034             } elsif ($sel eq "h" || $sel eq "?") {
2035                 print STDERR <<EOT
2036
2037 Interactive mode allows you to select the various maintainers, submitters,
2038 commit signers and mailing lists that could be CC'd on a patch.
2039
2040 Any *'d entry is selected.
2041
2042 If you have git or hg installed, you can choose to summarize the commit
2043 history of files in the patch.  Also, each line of the current file can
2044 be matched to its commit author and that commits signers with blame.
2045
2046 Various knobs exist to control the length of time for active commit
2047 tracking, the maximum number of commit authors and signers to add,
2048 and such.
2049
2050 Enter selections at the prompt until you are satisfied that the selected
2051 maintainers are appropriate.  You may enter multiple selections separated
2052 by either commas or spaces.
2053
2054 EOT
2055             } else {
2056                 print STDERR "invalid option: '$nr'\n";
2057                 $redraw = 0;
2058             }
2059         }
2060         if ($rerun) {
2061             print STDERR "git-blame can be very slow, please have patience..."
2062                 if ($email_git_blame);
2063             goto &get_maintainers;
2064         }
2065     }
2066
2067     #drop not selected entries
2068     $count = 0;
2069     my @new_emailto = ();
2070     foreach my $entry (@list) {
2071         if ($selected{$count}) {
2072             push(@new_emailto, $list[$count]);
2073         }
2074         $count++;
2075     }
2076     return @new_emailto;
2077 }
2078
2079 sub bool_invert {
2080     my ($bool_ref) = @_;
2081
2082     if ($$bool_ref) {
2083         $$bool_ref = 0;
2084     } else {
2085         $$bool_ref = 1;
2086     }
2087 }
2088
2089 sub deduplicate_email {
2090     my ($email) = @_;
2091
2092     my $matched = 0;
2093     my ($name, $address) = parse_email($email);
2094     $email = format_email($name, $address, 1);
2095     $email = mailmap_email($email);
2096
2097     return $email if (!$email_remove_duplicates);
2098
2099     ($name, $address) = parse_email($email);
2100
2101     if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
2102         $name = $deduplicate_name_hash{lc($name)}->[0];
2103         $address = $deduplicate_name_hash{lc($name)}->[1];
2104         $matched = 1;
2105     } elsif ($deduplicate_address_hash{lc($address)}) {
2106         $name = $deduplicate_address_hash{lc($address)}->[0];
2107         $address = $deduplicate_address_hash{lc($address)}->[1];
2108         $matched = 1;
2109     }
2110     if (!$matched) {
2111         $deduplicate_name_hash{lc($name)} = [ $name, $address ];
2112         $deduplicate_address_hash{lc($address)} = [ $name, $address ];
2113     }
2114     $email = format_email($name, $address, 1);
2115     $email = mailmap_email($email);
2116     return $email;
2117 }
2118
2119 sub save_commits_by_author {
2120     my (@lines) = @_;
2121
2122     my @authors = ();
2123     my @commits = ();
2124     my @subjects = ();
2125
2126     foreach my $line (@lines) {
2127         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2128             my $author = $1;
2129             $author = deduplicate_email($author);
2130             push(@authors, $author);
2131         }
2132         push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2133         push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2134     }
2135
2136     for (my $i = 0; $i < @authors; $i++) {
2137         my $exists = 0;
2138         foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
2139             if (@{$ref}[0] eq $commits[$i] &&
2140                 @{$ref}[1] eq $subjects[$i]) {
2141                 $exists = 1;
2142                 last;
2143             }
2144         }
2145         if (!$exists) {
2146             push(@{$commit_author_hash{$authors[$i]}},
2147                  [ ($commits[$i], $subjects[$i]) ]);
2148         }
2149     }
2150 }
2151
2152 sub save_commits_by_signer {
2153     my (@lines) = @_;
2154
2155     my $commit = "";
2156     my $subject = "";
2157
2158     foreach my $line (@lines) {
2159         $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2160         $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2161         if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
2162             my @signatures = ($line);
2163             my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
2164             my @types = @$types_ref;
2165             my @signers = @$signers_ref;
2166
2167             my $type = $types[0];
2168             my $signer = $signers[0];
2169
2170             $signer = deduplicate_email($signer);
2171
2172             my $exists = 0;
2173             foreach my $ref(@{$commit_signer_hash{$signer}}) {
2174                 if (@{$ref}[0] eq $commit &&
2175                     @{$ref}[1] eq $subject &&
2176                     @{$ref}[2] eq $type) {
2177                     $exists = 1;
2178                     last;
2179                 }
2180             }
2181             if (!$exists) {
2182                 push(@{$commit_signer_hash{$signer}},
2183                      [ ($commit, $subject, $type) ]);
2184             }
2185         }
2186     }
2187 }
2188
2189 sub vcs_assign {
2190     my ($role, $divisor, @lines) = @_;
2191
2192     my %hash;
2193     my $count = 0;
2194
2195     return if (@lines <= 0);
2196
2197     if ($divisor <= 0) {
2198         warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
2199         $divisor = 1;
2200     }
2201
2202     @lines = mailmap(@lines);
2203
2204     return if (@lines <= 0);
2205
2206     @lines = sort(@lines);
2207
2208     # uniq -c
2209     $hash{$_}++ for @lines;
2210
2211     # sort -rn
2212     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
2213         my $sign_offs = $hash{$line};
2214         my $percent = $sign_offs * 100 / $divisor;
2215
2216         $percent = 100 if ($percent > 100);
2217         next if (ignore_email_address($line));
2218         $count++;
2219         last if ($sign_offs < $email_git_min_signatures ||
2220                  $count > $email_git_max_maintainers ||
2221                  $percent < $email_git_min_percent);
2222         push_email_address($line, '');
2223         if ($output_rolestats) {
2224             my $fmt_percent = sprintf("%.0f", $percent);
2225             add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
2226         } else {
2227             add_role($line, $role);
2228         }
2229     }
2230 }
2231
2232 sub vcs_file_signoffs {
2233     my ($file) = @_;
2234
2235     my $authors_ref;
2236     my $signers_ref;
2237     my $stats_ref;
2238     my @authors = ();
2239     my @signers = ();
2240     my @stats = ();
2241     my $commits;
2242
2243     $vcs_used = vcs_exists();
2244     return if (!$vcs_used);
2245
2246     my $cmd = $VCS_cmds{"find_signers_cmd"};
2247     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
2248
2249     ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2250
2251     @signers = @{$signers_ref} if defined $signers_ref;
2252     @authors = @{$authors_ref} if defined $authors_ref;
2253     @stats = @{$stats_ref} if defined $stats_ref;
2254
2255 #    print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
2256
2257     foreach my $signer (@signers) {
2258         $signer = deduplicate_email($signer);
2259     }
2260
2261     vcs_assign("commit_signer", $commits, @signers);
2262     vcs_assign("authored", $commits, @authors);
2263     if ($#authors == $#stats) {
2264         my $stat_pattern = $VCS_cmds{"stat_pattern"};
2265         $stat_pattern =~ s/(\$\w+)/$1/eeg;      #interpolate $stat_pattern
2266
2267         my $added = 0;
2268         my $deleted = 0;
2269         for (my $i = 0; $i <= $#stats; $i++) {
2270             if ($stats[$i] =~ /$stat_pattern/) {
2271                 $added += $1;
2272                 $deleted += $2;
2273             }
2274         }
2275         my @tmp_authors = uniq(@authors);
2276         foreach my $author (@tmp_authors) {
2277             $author = deduplicate_email($author);
2278         }
2279         @tmp_authors = uniq(@tmp_authors);
2280         my @list_added = ();
2281         my @list_deleted = ();
2282         foreach my $author (@tmp_authors) {
2283             my $auth_added = 0;
2284             my $auth_deleted = 0;
2285             for (my $i = 0; $i <= $#stats; $i++) {
2286                 if ($author eq deduplicate_email($authors[$i]) &&
2287                     $stats[$i] =~ /$stat_pattern/) {
2288                     $auth_added += $1;
2289                     $auth_deleted += $2;
2290                 }
2291             }
2292             for (my $i = 0; $i < $auth_added; $i++) {
2293                 push(@list_added, $author);
2294             }
2295             for (my $i = 0; $i < $auth_deleted; $i++) {
2296                 push(@list_deleted, $author);
2297             }
2298         }
2299         vcs_assign("added_lines", $added, @list_added);
2300         vcs_assign("removed_lines", $deleted, @list_deleted);
2301     }
2302 }
2303
2304 sub vcs_file_blame {
2305     my ($file) = @_;
2306
2307     my @signers = ();
2308     my @all_commits = ();
2309     my @commits = ();
2310     my $total_commits;
2311     my $total_lines;
2312
2313     $vcs_used = vcs_exists();
2314     return if (!$vcs_used);
2315
2316     @all_commits = vcs_blame($file);
2317     @commits = uniq(@all_commits);
2318     $total_commits = @commits;
2319     $total_lines = @all_commits;
2320
2321     if ($email_git_blame_signatures) {
2322         if (vcs_is_hg()) {
2323             my $commit_count;
2324             my $commit_authors_ref;
2325             my $commit_signers_ref;
2326             my $stats_ref;
2327             my @commit_authors = ();
2328             my @commit_signers = ();
2329             my $commit = join(" -r ", @commits);
2330             my $cmd;
2331
2332             $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2333             $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2334
2335             ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2336             @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2337             @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2338
2339             push(@signers, @commit_signers);
2340         } else {
2341             foreach my $commit (@commits) {
2342                 my $commit_count;
2343                 my $commit_authors_ref;
2344                 my $commit_signers_ref;
2345                 my $stats_ref;
2346                 my @commit_authors = ();
2347                 my @commit_signers = ();
2348                 my $cmd;
2349
2350                 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2351                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2352
2353                 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2354                 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2355                 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2356
2357                 push(@signers, @commit_signers);
2358             }
2359         }
2360     }
2361
2362     if ($from_filename) {
2363         if ($output_rolestats) {
2364             my @blame_signers;
2365             if (vcs_is_hg()) {{         # Double brace for last exit
2366                 my $commit_count;
2367                 my @commit_signers = ();
2368                 @commits = uniq(@commits);
2369                 @commits = sort(@commits);
2370                 my $commit = join(" -r ", @commits);
2371                 my $cmd;
2372
2373                 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2374                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2375
2376                 my @lines = ();
2377
2378                 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2379
2380                 if (!$email_git_penguin_chiefs) {
2381                     @lines = grep(!/${penguin_chiefs}/i, @lines);
2382                 }
2383
2384                 last if !@lines;
2385
2386                 my @authors = ();
2387                 foreach my $line (@lines) {
2388                     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2389                         my $author = $1;
2390                         $author = deduplicate_email($author);
2391                         push(@authors, $author);
2392                     }
2393                 }
2394
2395                 save_commits_by_author(@lines) if ($interactive);
2396                 save_commits_by_signer(@lines) if ($interactive);
2397
2398                 push(@signers, @authors);
2399             }}
2400             else {
2401                 foreach my $commit (@commits) {
2402                     my $i;
2403                     my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2404                     $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
2405                     my @author = vcs_find_author($cmd);
2406                     next if !@author;
2407
2408                     my $formatted_author = deduplicate_email($author[0]);
2409
2410                     my $count = grep(/$commit/, @all_commits);
2411                     for ($i = 0; $i < $count ; $i++) {
2412                         push(@blame_signers, $formatted_author);
2413                     }
2414                 }
2415             }
2416             if (@blame_signers) {
2417                 vcs_assign("authored lines", $total_lines, @blame_signers);
2418             }
2419         }
2420         foreach my $signer (@signers) {
2421             $signer = deduplicate_email($signer);
2422         }
2423         vcs_assign("commits", $total_commits, @signers);
2424     } else {
2425         foreach my $signer (@signers) {
2426             $signer = deduplicate_email($signer);
2427         }
2428         vcs_assign("modified commits", $total_commits, @signers);
2429     }
2430 }
2431
2432 sub vcs_file_exists {
2433     my ($file) = @_;
2434
2435     my $exists;
2436
2437     my $vcs_used = vcs_exists();
2438     return 0 if (!$vcs_used);
2439
2440     my $cmd = $VCS_cmds{"file_exists_cmd"};
2441     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
2442     $cmd .= " 2>&1";
2443     $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2444
2445     return 0 if ($? != 0);
2446
2447     return $exists;
2448 }
2449
2450 sub vcs_list_files {
2451     my ($file) = @_;
2452
2453     my @lsfiles = ();
2454
2455     my $vcs_used = vcs_exists();
2456     return 0 if (!$vcs_used);
2457
2458     my $cmd = $VCS_cmds{"list_files_cmd"};
2459     $cmd =~ s/(\$\w+)/$1/eeg;   # interpolate $cmd
2460     @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd);
2461
2462     return () if ($? != 0);
2463
2464     return @lsfiles;
2465 }
2466
2467 sub uniq {
2468     my (@parms) = @_;
2469
2470     my %saw;
2471     @parms = grep(!$saw{$_}++, @parms);
2472     return @parms;
2473 }
2474
2475 sub sort_and_uniq {
2476     my (@parms) = @_;
2477
2478     my %saw;
2479     @parms = sort @parms;
2480     @parms = grep(!$saw{$_}++, @parms);
2481     return @parms;
2482 }
2483
2484 sub clean_file_emails {
2485     my (@file_emails) = @_;
2486     my @fmt_emails = ();
2487
2488     foreach my $email (@file_emails) {
2489         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2490         my ($name, $address) = parse_email($email);
2491
2492         # Strip quotes for easier processing, format_email will add them back
2493         $name =~ s/^"(.*)"$/$1/;
2494
2495         # Split into name-like parts and remove stray punctuation particles
2496         my @nw = split(/[^\p{L}\'\,\.\+-]/, $name);
2497         @nw = grep(!/^[\'\,\.\+-]$/, @nw);
2498
2499         # Make a best effort to extract the name, and only the name, by taking
2500         # only the last two names, or in the case of obvious initials, the last
2501         # three names.
2502         if (@nw > 2) {
2503             my $first = $nw[@nw - 3];
2504             my $middle = $nw[@nw - 2];
2505             my $last = $nw[@nw - 1];
2506
2507             if (((length($first) == 1 && $first =~ m/\p{L}/) ||
2508                  (length($first) == 2 && substr($first, -1) eq ".")) ||
2509                 (length($middle) == 1 ||
2510                  (length($middle) == 2 && substr($middle, -1) eq "."))) {
2511                 $name = "$first $middle $last";
2512             } else {
2513                 $name = "$middle $last";
2514             }
2515         } else {
2516             $name = "@nw";
2517         }
2518
2519         if (substr($name, -1) =~ /[,\.]/) {
2520             $name = substr($name, 0, length($name) - 1);
2521         }
2522
2523         if (substr($name, 0, 1) =~ /[,\.]/) {
2524             $name = substr($name, 1, length($name) - 1);
2525         }
2526
2527         my $fmt_email = format_email($name, $address, $email_usename);
2528         push(@fmt_emails, $fmt_email);
2529     }
2530     return @fmt_emails;
2531 }
2532
2533 sub merge_email {
2534     my @lines;
2535     my %saw;
2536
2537     for (@_) {
2538         my ($address, $role) = @$_;
2539         if (!$saw{$address}) {
2540             if ($output_roles) {
2541                 push(@lines, "$address ($role)");
2542             } else {
2543                 push(@lines, $address);
2544             }
2545             $saw{$address} = 1;
2546         }
2547     }
2548
2549     return @lines;
2550 }
2551
2552 sub output {
2553     my (@parms) = @_;
2554
2555     if ($output_multiline) {
2556         foreach my $line (@parms) {
2557             print("${line}\n");
2558         }
2559     } else {
2560         print(join($output_separator, @parms));
2561         print("\n");
2562     }
2563 }
2564
2565 my $rfc822re;
2566
2567 sub make_rfc822re {
2568 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2569 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
2570 #   This regexp will only work on addresses which have had comments stripped
2571 #   and replaced with rfc822_lwsp.
2572
2573     my $specials = '()<>@,;:\\\\".\\[\\]';
2574     my $controls = '\\000-\\037\\177';
2575
2576     my $dtext = "[^\\[\\]\\r\\\\]";
2577     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2578
2579     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2580
2581 #   Use zero-width assertion to spot the limit of an atom.  A simple
2582 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
2583     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2584     my $word = "(?:$atom|$quoted_string)";
2585     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2586
2587     my $sub_domain = "(?:$atom|$domain_literal)";
2588     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2589
2590     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2591
2592     my $phrase = "$word*";
2593     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2594     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2595     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2596
2597     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2598     my $address = "(?:$mailbox|$group)";
2599
2600     return "$rfc822_lwsp*$address";
2601 }
2602
2603 sub rfc822_strip_comments {
2604     my $s = shift;
2605 #   Recursively remove comments, and replace with a single space.  The simpler
2606 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2607 #   chars in atoms, for example.
2608
2609     while ($s =~ s/^((?:[^"\\]|\\.)*
2610                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2611                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2612     return $s;
2613 }
2614
2615 #   valid: returns true if the parameter is an RFC822 valid address
2616 #
2617 sub rfc822_valid {
2618     my $s = rfc822_strip_comments(shift);
2619
2620     if (!$rfc822re) {
2621         $rfc822re = make_rfc822re();
2622     }
2623
2624     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2625 }
2626
2627 #   validlist: In scalar context, returns true if the parameter is an RFC822
2628 #              valid list of addresses.
2629 #
2630 #              In list context, returns an empty list on failure (an invalid
2631 #              address was found); otherwise a list whose first element is the
2632 #              number of addresses found and whose remaining elements are the
2633 #              addresses.  This is needed to disambiguate failure (invalid)
2634 #              from success with no addresses found, because an empty string is
2635 #              a valid list.
2636
2637 sub rfc822_validlist {
2638     my $s = rfc822_strip_comments(shift);
2639
2640     if (!$rfc822re) {
2641         $rfc822re = make_rfc822re();
2642     }
2643     # * null list items are valid according to the RFC
2644     # * the '1' business is to aid in distinguishing failure from no results
2645
2646     my @r;
2647     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2648         $s =~ m/^$rfc822_char*$/) {
2649         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2650             push(@r, $1);
2651         }
2652         return wantarray ? (scalar(@r), @r) : 1;
2653     }
2654     return wantarray ? () : 0;
2655 }