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