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