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