projects/linux·blob rcu-free-v3 · refs

2673 lines · 69.4 KiB

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