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