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