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