linux/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, "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
  87my @penguin_chief_names = ();
  88foreach 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}
  95my $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
 100my @signature_tags = ();
 101push(@signature_tags, "Signed-off-by:");
 102push(@signature_tags, "Reviewed-by:");
 103push(@signature_tags, "Acked-by:");
 104
 105my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 106
 107# rfc822 email address - preloaded methods go here.
 108my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
 109my $rfc822_char = '[\\000-\\377]';
 110
 111# VCS command support: class-like functions and strings
 112
 113my %VCS_cmds;
 114
 115my %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
 155my %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
 185my $conf = which_conf(".get_maintainer.conf");
 186if (-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
 211my @ignore_emails = ();
 212my $ignore_file = which_conf(".get_maintainer.ignore");
 213if (-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
 232if ($#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
 240if (!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
 287if ($help != 0) {
 288    usage();
 289    exit 0;
 290}
 291
 292if ($version != 0) {
 293    print("${P} ${V}\n");
 294    exit 0;
 295}
 296
 297if (defined $self_test) {
 298    read_all_maintainer_files();
 299    self_test();
 300    exit 0;
 301}
 302
 303if (-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
 312if ($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
 329if ($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
 336if ($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
 343my @typevalue = ();
 344my %keyword_hash;
 345my @mfiles = ();
 346my @self_test_info = ();
 347
 348sub 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
 386sub 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
 394sub find_ignore_git {
 395    return grep { $_ !~ /^\.git$/; } @_;
 396}
 397
 398read_all_maintainer_files();
 399
 400sub 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
 434sub 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
 454my $mailmap;
 455
 456read_mailmap();
 457
 458sub 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
 530if (!@ARGV) {
 531    push(@ARGV, "&STDIN");
 532}
 533
 534foreach 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
 625my %email_hash_name;
 626my %email_hash_address;
 627my @email_to = ();
 628my %hash_list_to;
 629my @list_to = ();
 630my @scm = ();
 631my @web = ();
 632my @subsystem = ();
 633my @status = ();
 634my %deduplicate_name_hash = ();
 635my %deduplicate_address_hash = ();
 636
 637my @maintainers = get_maintainers();
 638if (@maintainers) {
 639    @maintainers = merge_email(@maintainers);
 640    output(@maintainers);
 641}
 642
 643if ($scm) {
 644    @scm = uniq(@scm);
 645    output(@scm);
 646}
 647
 648if ($status) {
 649    @status = uniq(@status);
 650    output(@status);
 651}
 652
 653if ($subsystem) {
 654    @subsystem = uniq(@subsystem);
 655    output(@subsystem);
 656}
 657
 658if ($web) {
 659    @web = uniq(@web);
 660    output(@web);
 661}
 662
 663exit($exit);
 664
 665sub 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
 794sub 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
 804sub 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
 822sub 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
 838sub 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            my ($name, $address) = parse_email($email);
 987
 988            my $tmp_email = format_email($name, $address, $email_usename);
 989            push_email_address($tmp_email, '');
 990            add_role($tmp_email, 'in file');
 991        }
 992    }
 993
 994    foreach my $fix (@fixes) {
 995        vcs_add_commit_signers($fix, "blamed_fixes");
 996    }
 997
 998    my @to = ();
 999    if ($email || $email_list) {
1000        if ($email) {
1001            @to = (@to, @email_to);
1002        }
1003        if ($email_list) {
1004            @to = (@to, @list_to);
1005        }
1006    }
1007
1008    if ($interactive) {
1009        @to = interactive_get_maintainers(\@to);
1010    }
1011
1012    return @to;
1013}
1014
1015sub file_match_pattern {
1016    my ($file, $pattern) = @_;
1017    if (substr($pattern, -1) eq "/") {
1018        if ($file =~ m@^$pattern@) {
1019            return 1;
1020        }
1021    } else {
1022        if ($file =~ m@^$pattern@) {
1023            my $s1 = ($file =~ tr@/@@);
1024            my $s2 = ($pattern =~ tr@/@@);
1025            if ($s1 == $s2) {
1026                return 1;
1027            }
1028        }
1029    }
1030    return 0;
1031}
1032
1033sub usage {
1034    print <<EOT;
1035usage: $P [options] patchfile
1036       $P [options] -f file|directory
1037version: $V
1038
1039MAINTAINER field selection options:
1040  --email => print email address(es) if any
1041    --git => include recent git \*-by: signers
1042    --git-all-signature-types => include signers regardless of signature type
1043        or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
1044    --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
1045    --git-chief-penguins => include ${penguin_chiefs}
1046    --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1047    --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1048    --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
1049    --git-blame => use git blame to find modified commits for patch or file
1050    --git-blame-signatures => when used with --git-blame, also include all commit signers
1051    --git-since => git history to use (default: $email_git_since)
1052    --hg-since => hg history to use (default: $email_hg_since)
1053    --interactive => display a menu (mostly useful if used with the --git option)
1054    --m => include maintainer(s) if any
1055    --r => include reviewer(s) if any
1056    --n => include name 'Full Name <addr\@domain.tld>'
1057    --l => include list(s) if any
1058    --moderated => include moderated lists(s) if any (default: true)
1059    --s => include subscriber only list(s) if any (default: false)
1060    --remove-duplicates => minimize duplicate email names/addresses
1061    --roles => show roles (status:subsystem, git-signer, list, etc...)
1062    --rolestats => show roles and statistics (commits/total_commits, %)
1063    --file-emails => add email addresses found in -f file (default: 0 (off))
1064    --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on))
1065  --scm => print SCM tree(s) if any
1066  --status => print status if any
1067  --subsystem => print subsystem name if any
1068  --web => print website(s) if any
1069
1070Output type options:
1071  --separator [, ] => separator for multiple entries on 1 line
1072    using --separator also sets --nomultiline if --separator is not [, ]
1073  --multiline => print 1 entry per line
1074
1075Other options:
1076  --pattern-depth => Number of pattern directory traversals (default: 0 (all))
1077  --keywords => scan patch for keywords (default: $keywords)
1078  --sections => print all of the subsystem sections with pattern matches
1079  --letters => print all matching 'letter' types from all matching sections
1080  --mailmap => use .mailmap file (default: $email_use_mailmap)
1081  --no-tree => run without a kernel tree
1082  --self-test => show potential issues with MAINTAINERS file content
1083  --version => show version
1084  --help => show this help information
1085
1086Default options:
1087  [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1088   --pattern-depth=0 --remove-duplicates --rolestats]
1089
1090Notes:
1091  Using "-f directory" may give unexpected results:
1092      Used with "--git", git signators for _all_ files in and below
1093          directory are examined as git recurses directories.
1094          Any specified X: (exclude) pattern matches are _not_ ignored.
1095      Used with "--nogit", directory is used as a pattern match,
1096          no individual file within the directory or subdirectory
1097          is matched.
1098      Used with "--git-blame", does not iterate all files in directory
1099  Using "--git-blame" is slow and may add old committers and authors
1100      that are no longer active maintainers to the output.
1101  Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1102      other automated tools that expect only ["name"] <email address>
1103      may not work because of additional output after <email address>.
1104  Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1105      not the percentage of the entire file authored.  # of commits is
1106      not a good measure of amount of code authored.  1 major commit may
1107      contain a thousand lines, 5 trivial commits may modify a single line.
1108  If git is not installed, but mercurial (hg) is installed and an .hg
1109      repository exists, the following options apply to mercurial:
1110          --git,
1111          --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1112          --git-blame
1113      Use --hg-since not --git-since to control date selection
1114  File ".get_maintainer.conf", if it exists in the linux kernel source root
1115      directory, can change whatever get_maintainer defaults are desired.
1116      Entries in this file can be any command line argument.
1117      This file is prepended to any additional command line arguments.
1118      Multiple lines and # comments are allowed.
1119  Most options have both positive and negative forms.
1120      The negative forms for --<foo> are --no<foo> and --no-<foo>.
1121
1122EOT
1123}
1124
1125sub top_of_kernel_tree {
1126    my ($lk_path) = @_;
1127
1128    if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1129        $lk_path .= "/";
1130    }
1131    if (   (-f "${lk_path}COPYING")
1132        && (-f "${lk_path}CREDITS")
1133        && (-f "${lk_path}Kbuild")
1134        && (-e "${lk_path}MAINTAINERS")
1135        && (-f "${lk_path}Makefile")
1136        && (-f "${lk_path}README")
1137        && (-d "${lk_path}Documentation")
1138        && (-d "${lk_path}arch")
1139        && (-d "${lk_path}include")
1140        && (-d "${lk_path}drivers")
1141        && (-d "${lk_path}fs")
1142        && (-d "${lk_path}init")
1143        && (-d "${lk_path}ipc")
1144        && (-d "${lk_path}kernel")
1145        && (-d "${lk_path}lib")
1146        && (-d "${lk_path}scripts")) {
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