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