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