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