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}