1#!/usr/bin/perl -w 2# (c) 2007, Joe Perches <joe@perches.com> 3# created from checkpatch.pl 4# 5# Print selected MAINTAINERS information for 6# the files modified in a patch or for a file 7# 8# usage: perl scripts/get_maintainer.pl [OPTIONS] <patch> 9# perl scripts/get_maintainer.pl [OPTIONS] -f <file> 10# 11# Licensed under the terms of the GNU GPL License version 2 12 13use strict; 14 15my $P = $0; 16my $V = '0.23'; 17 18use Getopt::Long qw(:config no_auto_abbrev); 19 20my $lk_path = "./"; 21my $email = 1; 22my $email_usename = 1; 23my $email_maintainer = 1; 24my $email_list = 1; 25my $email_subscriber_list = 0; 26my $email_git_penguin_chiefs = 0; 27my $email_git = 1; 28my $email_git_blame = 0; 29my $email_git_min_signatures = 1; 30my $email_git_max_maintainers = 5; 31my $email_git_min_percent = 5; 32my $email_git_since = "1-year-ago"; 33my $email_hg_since = "-365"; 34my $email_remove_duplicates = 1; 35my $output_multiline = 1; 36my $output_separator = ", "; 37my $output_roles = 0; 38my $output_rolestats = 0; 39my $scm = 0; 40my $web = 0; 41my $subsystem = 0; 42my $status = 0; 43my $keywords = 1; 44my $sections = 0; 45my $file_emails = 0; 46my $from_filename = 0; 47my $pattern_depth = 0; 48my $version = 0; 49my $help = 0; 50 51my $exit = 0; 52 53my @penguin_chief = (); 54push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org"); 55#Andrew wants in on most everything - 2009/01/14 56#push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org"); 57 58my @penguin_chief_names = (); 59foreach my $chief (@penguin_chief) { 60 if ($chief =~ m/^(.*):(.*)/) { 61 my $chief_name = $1; 62 my $chief_addr = $2; 63 push(@penguin_chief_names, $chief_name); 64 } 65} 66my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)"; 67 68# rfc822 email address - preloaded methods go here. 69my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])"; 70my $rfc822_char = '[\\000-\\377]'; 71 72# VCS command support: class-like functions and strings 73 74my %VCS_cmds; 75 76my %VCS_cmds_git = ( 77 "execute_cmd" => \&git_execute_cmd, 78 "available" => '(which("git") ne "") && (-d ".git")', 79 "find_signers_cmd" => "git log --no-color --since=\$email_git_since -- \$file", 80 "find_commit_signers_cmd" => "git log --no-color -1 \$commit", 81 "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file", 82 "blame_file_cmd" => "git blame -l \$file", 83 "commit_pattern" => "^commit [0-9a-f]{40,40}", 84 "blame_commit_pattern" => "^([0-9a-f]+) " 85); 86 87my %VCS_cmds_hg = ( 88 "execute_cmd" => \&hg_execute_cmd, 89 "available" => '(which("hg") ne "") && (-d ".hg")', 90 "find_signers_cmd" => 91 "hg log --date=\$email_hg_since" . 92 " --template='commit {node}\\n{desc}\\n' -- \$file", 93 "find_commit_signers_cmd" => "hg log --template='{desc}\\n' -r \$commit", 94 "blame_range_cmd" => "", # not supported 95 "blame_file_cmd" => "hg blame -c \$file", 96 "commit_pattern" => "^commit [0-9a-f]{40,40}", 97 "blame_commit_pattern" => "^([0-9a-f]+):" 98); 99 100if (!GetOptions( 101 'email!' => \$email, 102 'git!' => \$email_git, 103 'git-blame!' => \$email_git_blame, 104 'git-chief-penguins!' => \$email_git_penguin_chiefs, 105 'git-min-signatures=i' => \$email_git_min_signatures, 106 'git-max-maintainers=i' => \$email_git_max_maintainers, 107 'git-min-percent=i' => \$email_git_min_percent, 108 'git-since=s' => \$email_git_since, 109 'hg-since=s' => \$email_hg_since, 110 'remove-duplicates!' => \$email_remove_duplicates, 111 'm!' => \$email_maintainer, 112 'n!' => \$email_usename, 113 'l!' => \$email_list, 114 's!' => \$email_subscriber_list, 115 'multiline!' => \$output_multiline, 116 'roles!' => \$output_roles, 117 'rolestats!' => \$output_rolestats, 118 'separator=s' => \$output_separator, 119 'subsystem!' => \$subsystem, 120 'status!' => \$status, 121 'scm!' => \$scm, 122 'web!' => \$web, 123 'pattern-depth=i' => \$pattern_depth, 124 'k|keywords!' => \$keywords, 125 'sections!' => \$sections, 126 'fe|file-emails!' => \$file_emails, 127 'f|file' => \$from_filename, 128 'v|version' => \$version, 129 'h|help|usage' => \$help, 130 )) { 131 die "$P: invalid argument - use --help if necessary\n"; 132} 133 134if ($help != 0) { 135 usage(); 136 exit 0; 137} 138 139if ($version != 0) { 140 print("${P} ${V}\n"); 141 exit 0; 142} 143 144if (-t STDIN && !@ARGV) { 145 # We're talking to a terminal, but have no command line arguments. 146 die "$P: missing patchfile or -f file - use --help if necessary\n"; 147} 148 149if ($output_separator ne ", ") { 150 $output_multiline = 0; 151} 152 153if ($output_rolestats) { 154 $output_roles = 1; 155} 156 157if ($sections) { 158 $email = 0; 159 $email_list = 0; 160 $scm = 0; 161 $status = 0; 162 $subsystem = 0; 163 $web = 0; 164 $keywords = 0; 165} else { 166 my $selections = $email + $scm + $status + $subsystem + $web; 167 if ($selections == 0) { 168 die "$P: Missing required option: email, scm, status, subsystem or web\n"; 169 } 170} 171 172if ($email && 173 ($email_maintainer + $email_list + $email_subscriber_list + 174 $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) { 175 die "$P: Please select at least 1 email option\n"; 176} 177 178if (!top_of_kernel_tree($lk_path)) { 179 die "$P: The current directory does not appear to be " 180 . "a linux kernel source tree.\n"; 181} 182 183## Read MAINTAINERS for type/value pairs 184 185my @typevalue = (); 186my %keyword_hash; 187 188open (my $maint, '<', "${lk_path}MAINTAINERS") 189 or die "$P: Can't open MAINTAINERS: $!\n"; 190while (<$maint>) { 191 my $line = $_; 192 193 if ($line =~ m/^(\C):\s*(.*)/) { 194 my $type = $1; 195 my $value = $2; 196 197 ##Filename pattern matching 198 if ($type eq "F" || $type eq "X") { 199 $value =~ s@\.@\\\.@g; ##Convert . to \. 200 $value =~ s/\*/\.\*/g; ##Convert * to .* 201 $value =~ s/\?/\./g; ##Convert ? to . 202 ##if pattern is a directory and it lacks a trailing slash, add one 203 if ((-d $value)) { 204 $value =~ s@([^/])$@$1/@; 205 } 206 } elsif ($type eq "K") { 207 $keyword_hash{@typevalue} = $value; 208 } 209 push(@typevalue, "$type:$value"); 210 } elsif (!/^(\s)*$/) { 211 $line =~ s/\n$//g; 212 push(@typevalue, $line); 213 } 214} 215close($maint); 216 217my %mailmap; 218 219if ($email_remove_duplicates) { 220 open(my $mailmap, '<', "${lk_path}.mailmap") 221 or warn "$P: Can't open .mailmap: $!\n"; 222 while (<$mailmap>) { 223 my $line = $_; 224 225 next if ($line =~ m/^\s*#/); 226 next if ($line =~ m/^\s*$/); 227 228 my ($name, $address) = parse_email($line); 229 $line = format_email($name, $address, $email_usename); 230 231 next if ($line =~ m/^\s*$/); 232 233 if (exists($mailmap{$name})) { 234 my $obj = $mailmap{$name}; 235 push(@$obj, $address); 236 } else { 237 my @arr = ($address); 238 $mailmap{$name} = \@arr; 239 } 240 } 241 close($mailmap); 242} 243 244## use the filenames on the command line or find the filenames in the patchfiles 245 246my @files = (); 247my @range = (); 248my @keyword_tvi = (); 249my @file_emails = (); 250 251if (!@ARGV) { 252 push(@ARGV, "&STDIN"); 253} 254 255foreach my $file (@ARGV) { 256 if ($file ne "&STDIN") { 257 ##if $file is a directory and it lacks a trailing slash, add one 258 if ((-d $file)) { 259 $file =~ s@([^/])$@$1/@; 260 } elsif (!(-f $file)) { 261 die "$P: file '${file}' not found\n"; 262 } 263 } 264 if ($from_filename) { 265 push(@files, $file); 266 if (-f $file && ($keywords || $file_emails)) { 267 open(my $f, '<', $file) 268 or die "$P: Can't open $file: $!\n"; 269 my $text = do { local($/) ; <$f> }; 270 close($f); 271 if ($keywords) { 272 foreach my $line (keys %keyword_hash) { 273 if ($text =~ m/$keyword_hash{$line}/x) { 274 push(@keyword_tvi, $line); 275 } 276 } 277 } 278 if ($file_emails) { 279 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; 280 push(@file_emails, clean_file_emails(@poss_addr)); 281 } 282 } 283 } else { 284 my $file_cnt = @files; 285 my $lastfile; 286 287 open(my $patch, "< $file") 288 or die "$P: Can't open $file: $!\n"; 289 while (<$patch>) { 290 my $patch_line = $_; 291 if (m/^\+\+\+\s+(\S+)/) { 292 my $filename = $1; 293 $filename =~ s@^[^/]*/@@; 294 $filename =~ s@\n@@; 295 $lastfile = $filename; 296 push(@files, $filename); 297 } elsif (m/^\@\@ -(\d+),(\d+)/) { 298 if ($email_git_blame) { 299 push(@range, "$lastfile:$1:$2"); 300 } 301 } elsif ($keywords) { 302 foreach my $line (keys %keyword_hash) { 303 if ($patch_line =~ m/^[+-].*$keyword_hash{$line}/x) { 304 push(@keyword_tvi, $line); 305 } 306 } 307 } 308 } 309 close($patch); 310 311 if ($file_cnt == @files) { 312 warn "$P: file '${file}' doesn't appear to be a patch. " 313 . "Add -f to options?\n"; 314 } 315 @files = sort_and_uniq(@files); 316 } 317} 318 319@file_emails = uniq(@file_emails); 320 321my @email_to = (); 322my @list_to = (); 323my @scm = (); 324my @web = (); 325my @subsystem = (); 326my @status = (); 327 328# Find responsible parties 329 330foreach my $file (@files) { 331 332 my %hash; 333 my $tvi = find_first_section(); 334 while ($tvi < @typevalue) { 335 my $start = find_starting_index($tvi); 336 my $end = find_ending_index($tvi); 337 my $exclude = 0; 338 my $i; 339 340 #Do not match excluded file patterns 341 342 for ($i = $start; $i < $end; $i++) { 343 my $line = $typevalue[$i]; 344 if ($line =~ m/^(\C):\s*(.*)/) { 345 my $type = $1; 346 my $value = $2; 347 if ($type eq 'X') { 348 if (file_match_pattern($file, $value)) { 349 $exclude = 1; 350 last; 351 } 352 } 353 } 354 } 355 356 if (!$exclude) { 357 for ($i = $start; $i < $end; $i++) { 358 my $line = $typevalue[$i]; 359 if ($line =~ m/^(\C):\s*(.*)/) { 360 my $type = $1; 361 my $value = $2; 362 if ($type eq 'F') { 363 if (file_match_pattern($file, $value)) { 364 my $value_pd = ($value =~ tr@/@@); 365 my $file_pd = ($file =~ tr@/@@); 366 $value_pd++ if (substr($value,-1,1) ne "/"); 367 if ($pattern_depth == 0 || 368 (($file_pd - $value_pd) < $pattern_depth)) { 369 $hash{$tvi} = $value_pd; 370 } 371 } 372 } 373 } 374 } 375 } 376 377 $tvi = $end + 1; 378 } 379 380 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 381 add_categories($line); 382 if ($sections) { 383 my $i; 384 my $start = find_starting_index($line); 385 my $end = find_ending_index($line); 386 for ($i = $start; $i < $end; $i++) { 387 my $line = $typevalue[$i]; 388 if ($line =~ /^[FX]:/) { ##Restore file patterns 389 $line =~ s/([^\\])\.([^\*])/$1\?$2/g; 390 $line =~ s/([^\\])\.$/$1\?/g; ##Convert . back to ? 391 $line =~ s/\\\./\./g; ##Convert \. to . 392 $line =~ s/\.\*/\*/g; ##Convert .* to * 393 } 394 $line =~ s/^([A-Z]):/$1:\t/g; 395 print("$line\n"); 396 } 397 print("\n"); 398 } 399 } 400 401 if ($email && $email_git) { 402 vcs_file_signoffs($file); 403 } 404 405 if ($email && $email_git_blame) { 406 vcs_file_blame($file); 407 } 408} 409 410if ($keywords) { 411 @keyword_tvi = sort_and_uniq(@keyword_tvi); 412 foreach my $line (@keyword_tvi) { 413 add_categories($line); 414 } 415} 416 417if ($email) { 418 foreach my $chief (@penguin_chief) { 419 if ($chief =~ m/^(.*):(.*)/) { 420 my $email_address; 421 422 $email_address = format_email($1, $2, $email_usename); 423 if ($email_git_penguin_chiefs) { 424 push(@email_to, [$email_address, 'chief penguin']); 425 } else { 426 @email_to = grep($_->[0] !~ /${email_address}/, @email_to); 427 } 428 } 429 } 430 431 foreach my $email (@file_emails) { 432 my ($name, $address) = parse_email($email); 433 434 my $tmp_email = format_email($name, $address, $email_usename); 435 push_email_address($tmp_email, ''); 436 add_role($tmp_email, 'in file'); 437 } 438} 439 440if ($email || $email_list) { 441 my @to = (); 442 if ($email) { 443 @to = (@to, @email_to); 444 } 445 if ($email_list) { 446 @to = (@to, @list_to); 447 } 448 output(merge_email(@to)); 449} 450 451if ($scm) { 452 @scm = uniq(@scm); 453 output(@scm); 454} 455 456if ($status) { 457 @status = uniq(@status); 458 output(@status); 459} 460 461if ($subsystem) { 462 @subsystem = uniq(@subsystem); 463 output(@subsystem); 464} 465 466if ($web) { 467 @web = uniq(@web); 468 output(@web); 469} 470 471exit($exit); 472 473sub file_match_pattern { 474 my ($file, $pattern) = @_; 475 if (substr($pattern, -1) eq "/") { 476 if ($file =~ m@^$pattern@) { 477 return 1; 478 } 479 } else { 480 if ($file =~ m@^$pattern@) { 481 my $s1 = ($file =~ tr@/@@); 482 my $s2 = ($pattern =~ tr@/@@); 483 if ($s1 == $s2) { 484 return 1; 485 } 486 } 487 } 488 return 0; 489} 490 491sub usage { 492 print <<EOT; 493usage: $P [options] patchfile 494 $P [options] -f file|directory 495version: $V 496 497MAINTAINER field selection options: 498 --email => print email address(es) if any 499 --git => include recent git \*-by: signers 500 --git-chief-penguins => include ${penguin_chiefs} 501 --git-min-signatures => number of signatures required (default: 1) 502 --git-max-maintainers => maximum maintainers to add (default: 5) 503 --git-min-percent => minimum percentage of commits required (default: 5) 504 --git-blame => use git blame to find modified commits for patch or file 505 --git-since => git history to use (default: 1-year-ago) 506 --hg-since => hg history to use (default: -365) 507 --m => include maintainer(s) if any 508 --n => include name 'Full Name <addr\@domain.tld>' 509 --l => include list(s) if any 510 --s => include subscriber only list(s) if any 511 --remove-duplicates => minimize duplicate email names/addresses 512 --roles => show roles (status:subsystem, git-signer, list, etc...) 513 --rolestats => show roles and statistics (commits/total_commits, %) 514 --file-emails => add email addresses found in -f file (default: 0 (off)) 515 --scm => print SCM tree(s) if any 516 --status => print status if any 517 --subsystem => print subsystem name if any 518 --web => print website(s) if any 519 520Output type options: 521 --separator [, ] => separator for multiple entries on 1 line 522 using --separator also sets --nomultiline if --separator is not [, ] 523 --multiline => print 1 entry per line 524 525Other options: 526 --pattern-depth => Number of pattern directory traversals (default: 0 (all)) 527 --keywords => scan patch for keywords (default: 1 (on)) 528 --sections => print the entire subsystem sections with pattern matches 529 --version => show version 530 --help => show this help information 531 532Default options: 533 [--email --git --m --n --l --multiline --pattern-depth=0 --remove-duplicates] 534 535Notes: 536 Using "-f directory" may give unexpected results: 537 Used with "--git", git signators for _all_ files in and below 538 directory are examined as git recurses directories. 539 Any specified X: (exclude) pattern matches are _not_ ignored. 540 Used with "--nogit", directory is used as a pattern match, 541 no individual file within the directory or subdirectory 542 is matched. 543 Used with "--git-blame", does not iterate all files in directory 544 Using "--git-blame" is slow and may add old committers and authors 545 that are no longer active maintainers to the output. 546 Using "--roles" or "--rolestats" with git send-email --cc-cmd or any 547 other automated tools that expect only ["name"] <email address> 548 may not work because of additional output after <email address>. 549 Using "--rolestats" and "--git-blame" shows the #/total=% commits, 550 not the percentage of the entire file authored. # of commits is 551 not a good measure of amount of code authored. 1 major commit may 552 contain a thousand lines, 5 trivial commits may modify a single line. 553 If git is not installed, but mercurial (hg) is installed and an .hg 554 repository exists, the following options apply to mercurial: 555 --git, 556 --git-min-signatures, --git-max-maintainers, --git-min-percent, and 557 --git-blame 558 Use --hg-since not --git-since to control date selection 559EOT 560} 561 562sub top_of_kernel_tree { 563 my ($lk_path) = @_; 564 565 if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") { 566 $lk_path .= "/"; 567 } 568 if ( (-f "${lk_path}COPYING") 569 && (-f "${lk_path}CREDITS") 570 && (-f "${lk_path}Kbuild") 571 && (-f "${lk_path}MAINTAINERS") 572 && (-f "${lk_path}Makefile") 573 && (-f "${lk_path}README") 574 && (-d "${lk_path}Documentation") 575 && (-d "${lk_path}arch") 576 && (-d "${lk_path}include") 577 && (-d "${lk_path}drivers") 578 && (-d "${lk_path}fs") 579 && (-d "${lk_path}init") 580 && (-d "${lk_path}ipc") 581 && (-d "${lk_path}kernel") 582 && (-d "${lk_path}lib") 583 && (-d "${lk_path}scripts")) { 584 return 1; 585 } 586 return 0; 587} 588 589sub parse_email { 590 my ($formatted_email) = @_; 591 592 my $name = ""; 593 my $address = ""; 594 595 if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) { 596 $name = $1; 597 $address = $2; 598 } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) { 599 $address = $1; 600 } elsif ($formatted_email =~ /^(.+\@\S*).*$/) { 601 $address = $1; 602 } 603 604 $name =~ s/^\s+|\s+$//g; 605 $name =~ s/^\"|\"$//g; 606 $address =~ s/^\s+|\s+$//g; 607 608 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 609 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 610 $name = "\"$name\""; 611 } 612 613 return ($name, $address); 614} 615 616sub format_email { 617 my ($name, $address, $usename) = @_; 618 619 my $formatted_email; 620 621 $name =~ s/^\s+|\s+$//g; 622 $name =~ s/^\"|\"$//g; 623 $address =~ s/^\s+|\s+$//g; 624 625 if ($name =~ /[^\w \-]/i) { ##has "must quote" chars 626 $name =~ s/(?<!\\)"/\\"/g; ##escape quotes 627 $name = "\"$name\""; 628 } 629 630 if ($usename) { 631 if ("$name" eq "") { 632 $formatted_email = "$address"; 633 } else { 634 $formatted_email = "$name <$address>"; 635 } 636 } else { 637 $formatted_email = $address; 638 } 639 640 return $formatted_email; 641} 642 643sub find_first_section { 644 my $index = 0; 645 646 while ($index < @typevalue) { 647 my $tv = $typevalue[$index]; 648 if (($tv =~ m/^(\C):\s*(.*)/)) { 649 last; 650 } 651 $index++; 652 } 653 654 return $index; 655} 656 657sub find_starting_index { 658 my ($index) = @_; 659 660 while ($index > 0) { 661 my $tv = $typevalue[$index]; 662 if (!($tv =~ m/^(\C):\s*(.*)/)) { 663 last; 664 } 665 $index--; 666 } 667 668 return $index; 669} 670 671sub find_ending_index { 672 my ($index) = @_; 673 674 while ($index < @typevalue) { 675 my $tv = $typevalue[$index]; 676 if (!($tv =~ m/^(\C):\s*(.*)/)) { 677 last; 678 } 679 $index++; 680 } 681 682 return $index; 683} 684 685sub get_maintainer_role { 686 my ($index) = @_; 687 688 my $i; 689 my $start = find_starting_index($index); 690 my $end = find_ending_index($index); 691 692 my $role; 693 my $subsystem = $typevalue[$start]; 694 if (length($subsystem) > 20) { 695 $subsystem = substr($subsystem, 0, 17); 696 $subsystem =~ s/\s*$//; 697 $subsystem = $subsystem . "..."; 698 } 699 700 for ($i = $start + 1; $i < $end; $i++) { 701 my $tv = $typevalue[$i]; 702 if ($tv =~ m/^(\C):\s*(.*)/) { 703 my $ptype = $1; 704 my $pvalue = $2; 705 if ($ptype eq "S") { 706 $role = $pvalue; 707 } 708 } 709 } 710 711 $role = lc($role); 712 if ($role eq "supported") { 713 $role = "supporter"; 714 } elsif ($role eq "maintained") { 715 $role = "maintainer"; 716 } elsif ($role eq "odd fixes") { 717 $role = "odd fixer"; 718 } elsif ($role eq "orphan") { 719 $role = "orphan minder"; 720 } elsif ($role eq "obsolete") { 721 $role = "obsolete minder"; 722 } elsif ($role eq "buried alive in reporters") { 723 $role = "chief penguin"; 724 } 725 726 return $role . ":" . $subsystem; 727} 728 729sub get_list_role { 730 my ($index) = @_; 731 732 my $i; 733 my $start = find_starting_index($index); 734 my $end = find_ending_index($index); 735 736 my $subsystem = $typevalue[$start]; 737 if (length($subsystem) > 20) { 738 $subsystem = substr($subsystem, 0, 17); 739 $subsystem =~ s/\s*$//; 740 $subsystem = $subsystem . "..."; 741 } 742 743 if ($subsystem eq "THE REST") { 744 $subsystem = ""; 745 } 746 747 return $subsystem; 748} 749 750sub add_categories { 751 my ($index) = @_; 752 753 my $i; 754 my $start = find_starting_index($index); 755 my $end = find_ending_index($index); 756 757 push(@subsystem, $typevalue[$start]); 758 759 for ($i = $start + 1; $i < $end; $i++) { 760 my $tv = $typevalue[$i]; 761 if ($tv =~ m/^(\C):\s*(.*)/) { 762 my $ptype = $1; 763 my $pvalue = $2; 764 if ($ptype eq "L") { 765 my $list_address = $pvalue; 766 my $list_additional = ""; 767 my $list_role = get_list_role($i); 768 769 if ($list_role ne "") { 770 $list_role = ":" . $list_role; 771 } 772 if ($list_address =~ m/([^\s]+)\s+(.*)$/) { 773 $list_address = $1; 774 $list_additional = $2; 775 } 776 if ($list_additional =~ m/subscribers-only/) { 777 if ($email_subscriber_list) { 778 push(@list_to, [$list_address, "subscriber list${list_role}"]); 779 } 780 } else { 781 if ($email_list) { 782 push(@list_to, [$list_address, "open list${list_role}"]); 783 } 784 } 785 } elsif ($ptype eq "M") { 786 my ($name, $address) = parse_email($pvalue); 787 if ($name eq "") { 788 if ($i > 0) { 789 my $tv = $typevalue[$i - 1]; 790 if ($tv =~ m/^(\C):\s*(.*)/) { 791 if ($1 eq "P") { 792 $name = $2; 793 $pvalue = format_email($name, $address, $email_usename); 794 } 795 } 796 } 797 } 798 if ($email_maintainer) { 799 my $role = get_maintainer_role($i); 800 push_email_addresses($pvalue, $role); 801 } 802 } elsif ($ptype eq "T") { 803 push(@scm, $pvalue); 804 } elsif ($ptype eq "W") { 805 push(@web, $pvalue); 806 } elsif ($ptype eq "S") { 807 push(@status, $pvalue); 808 } 809 } 810 } 811} 812 813my %email_hash_name; 814my %email_hash_address; 815 816sub email_inuse { 817 my ($name, $address) = @_; 818 819 return 1 if (($name eq "") && ($address eq "")); 820 return 1 if (($name ne "") && exists($email_hash_name{$name})); 821 return 1 if (($address ne "") && exists($email_hash_address{$address})); 822 823 return 0; 824} 825 826sub push_email_address { 827 my ($line, $role) = @_; 828 829 my ($name, $address) = parse_email($line); 830 831 if ($address eq "") { 832 return 0; 833 } 834 835 if (!$email_remove_duplicates) { 836 push(@email_to, [format_email($name, $address, $email_usename), $role]); 837 } elsif (!email_inuse($name, $address)) { 838 push(@email_to, [format_email($name, $address, $email_usename), $role]); 839 $email_hash_name{$name}++; 840 $email_hash_address{$address}++; 841 } 842 843 return 1; 844} 845 846sub push_email_addresses { 847 my ($address, $role) = @_; 848 849 my @address_list = (); 850 851 if (rfc822_valid($address)) { 852 push_email_address($address, $role); 853 } elsif (@address_list = rfc822_validlist($address)) { 854 my $array_count = shift(@address_list); 855 while (my $entry = shift(@address_list)) { 856 push_email_address($entry, $role); 857 } 858 } else { 859 if (!push_email_address($address, $role)) { 860 warn("Invalid MAINTAINERS address: '" . $address . "'\n"); 861 } 862 } 863} 864 865sub add_role { 866 my ($line, $role) = @_; 867 868 my ($name, $address) = parse_email($line); 869 my $email = format_email($name, $address, $email_usename); 870 871 foreach my $entry (@email_to) { 872 if ($email_remove_duplicates) { 873 my ($entry_name, $entry_address) = parse_email($entry->[0]); 874 if (($name eq $entry_name || $address eq $entry_address) 875 && ($role eq "" || !($entry->[1] =~ m/$role/)) 876 ) { 877 if ($entry->[1] eq "") { 878 $entry->[1] = "$role"; 879 } else { 880 $entry->[1] = "$entry->[1],$role"; 881 } 882 } 883 } else { 884 if ($email eq $entry->[0] 885 && ($role eq "" || !($entry->[1] =~ m/$role/)) 886 ) { 887 if ($entry->[1] eq "") { 888 $entry->[1] = "$role"; 889 } else { 890 $entry->[1] = "$entry->[1],$role"; 891 } 892 } 893 } 894 } 895} 896 897sub which { 898 my ($bin) = @_; 899 900 foreach my $path (split(/:/, $ENV{PATH})) { 901 if (-e "$path/$bin") { 902 return "$path/$bin"; 903 } 904 } 905 906 return ""; 907} 908 909sub mailmap { 910 my (@lines) = @_; 911 my %hash; 912 913 foreach my $line (@lines) { 914 my ($name, $address) = parse_email($line); 915 if (!exists($hash{$name})) { 916 $hash{$name} = $address; 917 } elsif ($address ne $hash{$name}) { 918 $address = $hash{$name}; 919 $line = format_email($name, $address, $email_usename); 920 } 921 if (exists($mailmap{$name})) { 922 my $obj = $mailmap{$name}; 923 foreach my $map_address (@$obj) { 924 if (($map_address eq $address) && 925 ($map_address ne $hash{$name})) { 926 $line = format_email($name, $hash{$name}, $email_usename); 927 } 928 } 929 } 930 } 931 932 return @lines; 933} 934 935sub git_execute_cmd { 936 my ($cmd) = @_; 937 my @lines = (); 938 939 my $output = `$cmd`; 940 $output =~ s/^\s*//gm; 941 @lines = split("\n", $output); 942 943 return @lines; 944} 945 946sub hg_execute_cmd { 947 my ($cmd) = @_; 948 my @lines = (); 949 950 my $output = `$cmd`; 951 @lines = split("\n", $output); 952 953 return @lines; 954} 955 956sub vcs_find_signers { 957 my ($cmd) = @_; 958 my @lines = (); 959 my $commits; 960 961 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 962 963 my $pattern = $VCS_cmds{"commit_pattern"}; 964 965 $commits = grep(/$pattern/, @lines); # of commits 966 967 @lines = grep(/^[-_ a-z]+by:.*\@.*$/i, @lines); 968 if (!$email_git_penguin_chiefs) { 969 @lines = grep(!/${penguin_chiefs}/i, @lines); 970 } 971 # cut -f2- -d":" 972 s/.*:\s*(.+)\s*/$1/ for (@lines); 973 974## Reformat email addresses (with names) to avoid badly written signatures 975 976 foreach my $line (@lines) { 977 my ($name, $address) = parse_email($line); 978 $line = format_email($name, $address, 1); 979 } 980 981 return ($commits, @lines); 982} 983 984sub vcs_save_commits { 985 my ($cmd) = @_; 986 my @lines = (); 987 my @commits = (); 988 989 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd); 990 991 foreach my $line (@lines) { 992 if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) { 993 push(@commits, $1); 994 } 995 } 996 997 return @commits; 998} 999 1000sub vcs_blame { 1001 my ($file) = @_; 1002 my $cmd; 1003 my @commits = (); 1004 1005 return @commits if (!(-f $file)); 1006 1007 if (@range && $VCS_cmds{"blame_range_cmd"} eq "") { 1008 my @all_commits = (); 1009 1010 $cmd = $VCS_cmds{"blame_file_cmd"}; 1011 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1012 @all_commits = vcs_save_commits($cmd); 1013 1014 foreach my $file_range_diff (@range) { 1015 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1016 my $diff_file = $1; 1017 my $diff_start = $2; 1018 my $diff_length = $3; 1019 next if ("$file" ne "$diff_file"); 1020 for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) { 1021 push(@commits, $all_commits[$i]); 1022 } 1023 } 1024 } elsif (@range) { 1025 foreach my $file_range_diff (@range) { 1026 next if (!($file_range_diff =~ m/(.+):(.+):(.+)/)); 1027 my $diff_file = $1; 1028 my $diff_start = $2; 1029 my $diff_length = $3; 1030 next if ("$file" ne "$diff_file"); 1031 $cmd = $VCS_cmds{"blame_range_cmd"}; 1032 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1033 push(@commits, vcs_save_commits($cmd)); 1034 } 1035 } else { 1036 $cmd = $VCS_cmds{"blame_file_cmd"}; 1037 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1038 @commits = vcs_save_commits($cmd); 1039 } 1040 1041 return @commits; 1042} 1043 1044my $printed_novcs = 0; 1045sub vcs_exists { 1046 %VCS_cmds = %VCS_cmds_git; 1047 return 1 if eval $VCS_cmds{"available"}; 1048 %VCS_cmds = %VCS_cmds_hg; 1049 return 1 if eval $VCS_cmds{"available"}; 1050 %VCS_cmds = (); 1051 if (!$printed_novcs) { 1052 warn("$P: No supported VCS found. Add --nogit to options?\n"); 1053 warn("Using a git repository produces better results.\n"); 1054 warn("Try Linus Torvalds' latest git repository using:\n"); 1055 warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git\n"); 1056 $printed_novcs = 1; 1057 } 1058 return 0; 1059} 1060 1061sub vcs_assign { 1062 my ($role, $divisor, @lines) = @_; 1063 1064 my %hash; 1065 my $count = 0; 1066 1067 return if (@lines <= 0); 1068 1069 if ($divisor <= 0) { 1070 warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n"); 1071 $divisor = 1; 1072 } 1073 1074 if ($email_remove_duplicates) { 1075 @lines = mailmap(@lines); 1076 } 1077 1078 @lines = sort(@lines); 1079 1080 # uniq -c 1081 $hash{$_}++ for @lines; 1082 1083 # sort -rn 1084 foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) { 1085 my $sign_offs = $hash{$line}; 1086 my $percent = $sign_offs * 100 / $divisor; 1087 1088 $percent = 100 if ($percent > 100); 1089 $count++; 1090 last if ($sign_offs < $email_git_min_signatures || 1091 $count > $email_git_max_maintainers || 1092 $percent < $email_git_min_percent); 1093 push_email_address($line, ''); 1094 if ($output_rolestats) { 1095 my $fmt_percent = sprintf("%.0f", $percent); 1096 add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%"); 1097 } else { 1098 add_role($line, $role); 1099 } 1100 } 1101} 1102 1103sub vcs_file_signoffs { 1104 my ($file) = @_; 1105 1106 my @signers = (); 1107 my $commits; 1108 1109 return if (!vcs_exists()); 1110 1111 my $cmd = $VCS_cmds{"find_signers_cmd"}; 1112 $cmd =~ s/(\$\w+)/$1/eeg; # interpolate $cmd 1113 1114 ($commits, @signers) = vcs_find_signers($cmd); 1115 vcs_assign("commit_signer", $commits, @signers); 1116} 1117 1118sub vcs_file_blame { 1119 my ($file) = @_; 1120 1121 my @signers = (); 1122 my @commits = (); 1123 my $total_commits; 1124 1125 return if (!vcs_exists()); 1126 1127 @commits = vcs_blame($file); 1128 @commits = uniq(@commits); 1129 $total_commits = @commits; 1130 1131 foreach my $commit (@commits) { 1132 my $commit_count; 1133 my @commit_signers = (); 1134 1135 my $cmd = $VCS_cmds{"find_commit_signers_cmd"}; 1136 $cmd =~ s/(\$\w+)/$1/eeg; #interpolate $cmd 1137 1138 ($commit_count, @commit_signers) = vcs_find_signers($cmd); 1139 push(@signers, @commit_signers); 1140 } 1141 1142 if ($from_filename) { 1143 vcs_assign("commits", $total_commits, @signers); 1144 } else { 1145 vcs_assign("modified commits", $total_commits, @signers); 1146 } 1147} 1148 1149sub uniq { 1150 my (@parms) = @_; 1151 1152 my %saw; 1153 @parms = grep(!$saw{$_}++, @parms); 1154 return @parms; 1155} 1156 1157sub sort_and_uniq { 1158 my (@parms) = @_; 1159 1160 my %saw; 1161 @parms = sort @parms; 1162 @parms = grep(!$saw{$_}++, @parms); 1163 return @parms; 1164} 1165 1166sub clean_file_emails { 1167 my (@file_emails) = @_; 1168 my @fmt_emails = (); 1169 1170 foreach my $email (@file_emails) { 1171 $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g; 1172 my ($name, $address) = parse_email($email); 1173 if ($name eq '"[,\.]"') { 1174 $name = ""; 1175 } 1176 1177 my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name); 1178 if (@nw > 2) { 1179 my $first = $nw[@nw - 3]; 1180 my $middle = $nw[@nw - 2]; 1181 my $last = $nw[@nw - 1]; 1182 1183 if (((length($first) == 1 && $first =~ m/[A-Za-z]/) || 1184 (length($first) == 2 && substr($first, -1) eq ".")) || 1185 (length($middle) == 1 || 1186 (length($middle) == 2 && substr($middle, -1) eq "."))) { 1187 $name = "$first $middle $last"; 1188 } else { 1189 $name = "$middle $last"; 1190 } 1191 } 1192 1193 if (substr($name, -1) =~ /[,\.]/) { 1194 $name = substr($name, 0, length($name) - 1); 1195 } elsif (substr($name, -2) =~ /[,\.]"/) { 1196 $name = substr($name, 0, length($name) - 2) . '"'; 1197 } 1198 1199 if (substr($name, 0, 1) =~ /[,\.]/) { 1200 $name = substr($name, 1, length($name) - 1); 1201 } elsif (substr($name, 0, 2) =~ /"[,\.]/) { 1202 $name = '"' . substr($name, 2, length($name) - 2); 1203 } 1204 1205 my $fmt_email = format_email($name, $address, $email_usename); 1206 push(@fmt_emails, $fmt_email); 1207 } 1208 return @fmt_emails; 1209} 1210 1211sub merge_email { 1212 my @lines; 1213 my %saw; 1214 1215 for (@_) { 1216 my ($address, $role) = @$_; 1217 if (!$saw{$address}) { 1218 if ($output_roles) { 1219 push(@lines, "$address ($role)"); 1220 } else { 1221 push(@lines, $address); 1222 } 1223 $saw{$address} = 1; 1224 } 1225 } 1226 1227 return @lines; 1228} 1229 1230sub output { 1231 my (@parms) = @_; 1232 1233 if ($output_multiline) { 1234 foreach my $line (@parms) { 1235 print("${line}\n"); 1236 } 1237 } else { 1238 print(join($output_separator, @parms)); 1239 print("\n"); 1240 } 1241} 1242 1243my $rfc822re; 1244 1245sub make_rfc822re { 1246# Basic lexical tokens are specials, domain_literal, quoted_string, atom, and 1247# comment. We must allow for rfc822_lwsp (or comments) after each of these. 1248# This regexp will only work on addresses which have had comments stripped 1249# and replaced with rfc822_lwsp. 1250 1251 my $specials = '()<>@,;:\\\\".\\[\\]'; 1252 my $controls = '\\000-\\037\\177'; 1253 1254 my $dtext = "[^\\[\\]\\r\\\\]"; 1255 my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*"; 1256 1257 my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*"; 1258 1259# Use zero-width assertion to spot the limit of an atom. A simple 1260# $rfc822_lwsp* causes the regexp engine to hang occasionally. 1261 my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))"; 1262 my $word = "(?:$atom|$quoted_string)"; 1263 my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*"; 1264 1265 my $sub_domain = "(?:$atom|$domain_literal)"; 1266 my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*"; 1267 1268 my $addr_spec = "$localpart\@$rfc822_lwsp*$domain"; 1269 1270 my $phrase = "$word*"; 1271 my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)"; 1272 my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*"; 1273 my $mailbox = "(?:$addr_spec|$phrase$route_addr)"; 1274 1275 my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*"; 1276 my $address = "(?:$mailbox|$group)"; 1277 1278 return "$rfc822_lwsp*$address"; 1279} 1280 1281sub rfc822_strip_comments { 1282 my $s = shift; 1283# Recursively remove comments, and replace with a single space. The simpler 1284# regexps in the Email Addressing FAQ are imperfect - they will miss escaped 1285# chars in atoms, for example. 1286 1287 while ($s =~ s/^((?:[^"\\]|\\.)* 1288 (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*) 1289 \((?:[^()\\]|\\.)*\)/$1 /osx) {} 1290 return $s; 1291} 1292 1293# valid: returns true if the parameter is an RFC822 valid address 1294# 1295sub rfc822_valid { 1296 my $s = rfc822_strip_comments(shift); 1297 1298 if (!$rfc822re) { 1299 $rfc822re = make_rfc822re(); 1300 } 1301 1302 return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/; 1303} 1304 1305# validlist: In scalar context, returns true if the parameter is an RFC822 1306# valid list of addresses. 1307# 1308# In list context, returns an empty list on failure (an invalid 1309# address was found); otherwise a list whose first element is the 1310# number of addresses found and whose remaining elements are the 1311# addresses. This is needed to disambiguate failure (invalid) 1312# from success with no addresses found, because an empty string is 1313# a valid list. 1314 1315sub rfc822_validlist { 1316 my $s = rfc822_strip_comments(shift); 1317 1318 if (!$rfc822re) { 1319 $rfc822re = make_rfc822re(); 1320 } 1321 # * null list items are valid according to the RFC 1322 # * the '1' business is to aid in distinguishing failure from no results 1323 1324 my @r; 1325 if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so && 1326 $s =~ m/^$rfc822_char*$/) { 1327 while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) { 1328 push(@r, $1); 1329 } 1330 return wantarray ? (scalar(@r), @r) : 1; 1331 } 1332 return wantarray ? () : 0; 1333} 1334