scripts/get_maintainer.pl

   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_maintainers.pl [OPTIONS] <patch>
   9 #        perl scripts/get_maintainers.pl [OPTIONS] -f <file>
  10 #
  11 # Licensed under the terms of the GNU GPL License version 2
  12
  13 use strict;
  14
  15 my $P = $0;
  16 my $V = '0.17';
  17
  18 use Getopt::Long qw(:config no_auto_abbrev);
  19
  20 my $lk_path = "./";
  21 my $email = 1;
  22 my $email_usename = 1;
  23 my $email_maintainer = 1;
  24 my $email_list = 1;
  25 my $email_subscriber_list = 0;
  26 my $email_git = 1;
  27 my $email_git_penguin_chiefs = 0;
  28 my $email_git_min_signatures = 1;
  29 my $email_git_max_maintainers = 5;
  30 my $email_git_min_percent = 5;
  31 my $email_git_since = "1-year-ago";
  32 my $output_multiline = 1;
  33 my $output_separator = ", ";
  34 my $scm = 0;
  35 my $web = 0;
  36 my $subsystem = 0;
  37 my $status = 0;
  38 my $from_filename = 0;
  39 my $version = 0;
  40 my $help = 0;
  41
  42 my $exit = 0;
  43
  44 my @penguin_chief = ();
  45 push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org");
  46 #Andrew wants in on most everything - 2009/01/14
  47 #push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org");
  48
  49 my @penguin_chief_names = ();
  50 foreach my $chief (@penguin_chief) {
  51     if ($chief =~ m/^(.*):(.*)/) {
  52         my $chief_name = $1;
  53         my $chief_addr = $2;
  54         push(@penguin_chief_names, $chief_name);
  55     }
  56 }
  57 my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)";
  58
  59 # rfc822 email address - preloaded methods go here.
  60 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
  61 my $rfc822_char = '[\\000-\\377]';
  62
  63 if (!GetOptions(
  64                 'email!' => \$email,
  65                 'git!' => \$email_git,
  66                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
  67                 'git-min-signatures=i' => \$email_git_min_signatures,
  68                 'git-max-maintainers=i' => \$email_git_max_maintainers,
  69                 'git-min-percent=i' => \$email_git_min_percent,
  70                 'git-since=s' => \$email_git_since,
  71                 'm!' => \$email_maintainer,
  72                 'n!' => \$email_usename,
  73                 'l!' => \$email_list,
  74                 's!' => \$email_subscriber_list,
  75                 'multiline!' => \$output_multiline,
  76                 'separator=s' => \$output_separator,
  77                 'subsystem!' => \$subsystem,
  78                 'status!' => \$status,
  79                 'scm!' => \$scm,
  80                 'web!' => \$web,
  81                 'f|file' => \$from_filename,
  82                 'v|version' => \$version,
  83                 'h|help' => \$help,
  84                 )) {
  85     usage();
  86     die "$P: invalid argument\n";
  87 }
  88
  89 if ($help != 0) {
  90     usage();
  91     exit 0;
  92 }
  93
  94 if ($version != 0) {
  95     print("${P} ${V}\n");
  96     exit 0;
  97 }
  98
  99 if ($#ARGV < 0) {
 100     usage();
 101     die "$P: argument missing: patchfile or -f file please\n";
 102 }
 103
 104 my $selections = $email + $scm + $status + $subsystem + $web;
 105 if ($selections == 0) {
 106     usage();
 107     die "$P:  Missing required option: email, scm, status, subsystem or web\n";
 108 }
 109
 110 if ($email && ($email_maintainer + $email_list + $email_subscriber_list
 111                + $email_git + $email_git_penguin_chiefs) == 0) {
 112     usage();
 113     die "$P: Please select at least 1 email option\n";
 114 }
 115
 116 if (!top_of_kernel_tree($lk_path)) {
 117     die "$P: The current directory does not appear to be "
 118         . "a linux kernel source tree.\n";
 119 }
 120
 121 ## Read MAINTAINERS for type/value pairs
 122
 123 my @typevalue = ();
 124 open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n";
 125 while (<MAINT>) {
 126     my $line = $_;
 127
 128     if ($line =~ m/^(\C):\s*(.*)/) {
 129         my $type = $1;
 130         my $value = $2;
 131
 132         ##Filename pattern matching
 133         if ($type eq "F" || $type eq "X") {
 134             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 135             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 136             $value =~ s/\?/\./g;         ##Convert ? to .
 137             ##if pattern is a directory and it lacks a trailing slash, add one
 138             if ((-d $value)) {
 139                 $value =~ s@([^/])$@$1/@;
 140             }
 141         }
 142         push(@typevalue, "$type:$value");
 143     } elsif (!/^(\s)*$/) {
 144         $line =~ s/\n$//g;
 145         push(@typevalue, $line);
 146     }
 147 }
 148 close(MAINT);
 149
 150 ## use the filenames on the command line or find the filenames in the patchfiles
 151
 152 my @files = ();
 153
 154 foreach my $file (@ARGV) {
 155     ##if $file is a directory and it lacks a trailing slash, add one
 156     if ((-d $file)) {
 157         $file =~ s@([^/])$@$1/@;
 158     } elsif (!(-f $file)) {
 159         die "$P: file '${file}' not found\n";
 160     }
 161     if ($from_filename) {
 162         push(@files, $file);
 163     } else {
 164         my $file_cnt = @files;
 165         open(PATCH, "<$file") or die "$P: Can't open ${file}\n";
 166         while (<PATCH>) {
 167             if (m/^\+\+\+\s+(\S+)/) {
 168                 my $filename = $1;
 169                 $filename =~ s@^[^/]*/@@;
 170                 $filename =~ s@\n@@;
 171                 push(@files, $filename);
 172             }
 173         }
 174         close(PATCH);
 175         if ($file_cnt == @files) {
 176             warn "$P: file '${file}' doesn't appear to be a patch.  "
 177                 . "Add -f to options?\n";
 178         }
 179         @files = sort_and_uniq(@files);
 180     }
 181 }
 182
 183 my @email_to = ();
 184 my @list_to = ();
 185 my @scm = ();
 186 my @web = ();
 187 my @subsystem = ();
 188 my @status = ();
 189
 190 # Find responsible parties
 191
 192 foreach my $file (@files) {
 193
 194 #Do not match excluded file patterns
 195
 196     my $exclude = 0;
 197     foreach my $line (@typevalue) {
 198         if ($line =~ m/^(\C):\s*(.*)/) {
 199             my $type = $1;
 200             my $value = $2;
 201             if ($type eq 'X') {
 202                 if (file_match_pattern($file, $value)) {
 203                     $exclude = 1;
 204                 }
 205             }
 206         }
 207     }
 208
 209     if (!$exclude) {
 210         my $tvi = 0;
 211         foreach my $line (@typevalue) {
 212             if ($line =~ m/^(\C):\s*(.*)/) {
 213                 my $type = $1;
 214                 my $value = $2;
 215                 if ($type eq 'F') {
 216                     if (file_match_pattern($file, $value)) {
 217                         add_categories($tvi);
 218                     }
 219                 }
 220             }
 221             $tvi++;
 222         }
 223     }
 224
 225     if ($email && $email_git) {
 226         recent_git_signoffs($file);
 227     }
 228
 229 }
 230
 231 if ($email) {
 232     foreach my $chief (@penguin_chief) {
 233         if ($chief =~ m/^(.*):(.*)/) {
 234             my $email_address;
 235             if ($email_usename) {
 236                 $email_address = format_email($1, $2);
 237             } else {
 238                 $email_address = $2;
 239             }
 240             if ($email_git_penguin_chiefs) {
 241                 push(@email_to, $email_address);
 242             } else {
 243                 @email_to = grep(!/${email_address}/, @email_to);
 244             }
 245         }
 246     }
 247 }
 248
 249 if ($email || $email_list) {
 250     my @to = ();
 251     if ($email) {
 252         @to = (@to, @email_to);
 253     }
 254     if ($email_list) {
 255         @to = (@to, @list_to);
 256     }
 257     output(uniq(@to));
 258 }
 259
 260 if ($scm) {
 261     @scm = sort_and_uniq(@scm);
 262     output(@scm);
 263 }
 264
 265 if ($status) {
 266     @status = sort_and_uniq(@status);
 267     output(@status);
 268 }
 269
 270 if ($subsystem) {
 271     @subsystem = sort_and_uniq(@subsystem);
 272     output(@subsystem);
 273 }
 274
 275 if ($web) {
 276     @web = sort_and_uniq(@web);
 277     output(@web);
 278 }
 279
 280 exit($exit);
 281
 282 sub file_match_pattern {
 283     my ($file, $pattern) = @_;
 284     if (substr($pattern, -1) eq "/") {
 285         if ($file =~ m@^$pattern@) {
 286             return 1;
 287         }
 288     } else {
 289         if ($file =~ m@^$pattern@) {
 290             my $s1 = ($file =~ tr@/@@);
 291             my $s2 = ($pattern =~ tr@/@@);
 292             if ($s1 == $s2) {
 293                 return 1;
 294             }
 295         }
 296     }
 297     return 0;
 298 }
 299
 300 sub usage {
 301     print <<EOT;
 302 usage: $P [options] patchfile
 303        $P [options] -f file|directory
 304 version: $V
 305
 306 MAINTAINER field selection options:
 307   --email => print email address(es) if any
 308     --git => include recent git \*-by: signers
 309     --git-chief-penguins => include ${penguin_chiefs}
 310     --git-min-signatures => number of signatures required (default: 1)
 311     --git-max-maintainers => maximum maintainers to add (default: 5)
 312     --git-min-percent => minimum percentage of commits required (default: 5)
 313     --git-since => git history to use (default: 1-year-ago)
 314     --m => include maintainer(s) if any
 315     --n => include name 'Full Name <addr\@domain.tld>'
 316     --l => include list(s) if any
 317     --s => include subscriber only list(s) if any
 318   --scm => print SCM tree(s) if any
 319   --status => print status if any
 320   --subsystem => print subsystem name if any
 321   --web => print website(s) if any
 322
 323 Output type options:
 324   --separator [, ] => separator for multiple entries on 1 line
 325   --multiline => print 1 entry per line
 326
 327 Default options:
 328   [--email --git --m --n --l --multiline]
 329
 330 Other options:
 331   --version => show version
 332   --help => show this help information
 333
 334 Notes:
 335   Using "-f directory" may give unexpected results:
 336
 337   Used with "--git", git signators for _all_ files in and below
 338      directory are examined as git recurses directories.
 339      Any specified X: (exclude) pattern matches are _not_ ignored.
 340   Used with "--nogit", directory is used as a pattern match,
 341      no individual file within the directory or subdirectory
 342      is matched.
 343 EOT
 344 }
 345
 346 sub top_of_kernel_tree {
 347         my ($lk_path) = @_;
 348
 349         if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
 350             $lk_path .= "/";
 351         }
 352         if (   (-f "${lk_path}COPYING")
 353             && (-f "${lk_path}CREDITS")
 354             && (-f "${lk_path}Kbuild")
 355             && (-f "${lk_path}MAINTAINERS")
 356             && (-f "${lk_path}Makefile")
 357             && (-f "${lk_path}README")
 358             && (-d "${lk_path}Documentation")
 359             && (-d "${lk_path}arch")
 360             && (-d "${lk_path}include")
 361             && (-d "${lk_path}drivers")
 362             && (-d "${lk_path}fs")
 363             && (-d "${lk_path}init")
 364             && (-d "${lk_path}ipc")
 365             && (-d "${lk_path}kernel")
 366             && (-d "${lk_path}lib")
 367             && (-d "${lk_path}scripts")) {
 368                 return 1;
 369         }
 370         return 0;
 371 }
 372
 373 sub format_email {
 374     my ($name, $email) = @_;
 375
 376     $name =~ s/^\s+|\s+$//g;
 377     $name =~ s/^\"|\"$//g;
 378     $email =~ s/^\s+|\s+$//g;
 379
 380     my $formatted_email = "";
 381
 382     if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
 383         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
 384         $formatted_email = "\"${name}\"\ \<${email}\>";
 385     } else {
 386         $formatted_email = "${name} \<${email}\>";
 387     }
 388     return $formatted_email;
 389 }
 390
 391 sub add_categories {
 392     my ($index) = @_;
 393
 394     $index = $index - 1;
 395     while ($index >= 0) {
 396         my $tv = $typevalue[$index];
 397         if ($tv =~ m/^(\C):\s*(.*)/) {
 398             my $ptype = $1;
 399             my $pvalue = $2;
 400             if ($ptype eq "L") {
 401                 my $list_address = $pvalue;
 402                 my $list_additional = "";
 403                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
 404                     $list_address = $1;
 405                     $list_additional = $2;
 406                 }
 407                 if ($list_additional =~ m/subscribers-only/) {
 408                     if ($email_subscriber_list) {
 409                         push(@list_to, $list_address);
 410                     }
 411                 } else {
 412                     if ($email_list) {
 413                         push(@list_to, $list_address);
 414                     }
 415                 }
 416             } elsif ($ptype eq "M") {
 417                 my $p_used = 0;
 418                 if ($index >= 0) {
 419                     my $tv = $typevalue[$index - 1];
 420                     if ($tv =~ m/^(\C):\s*(.*)/) {
 421                         if ($1 eq "P") {
 422                             if ($email_usename) {
 423                                 push_email_address(format_email($2, $pvalue));
 424                                 $p_used = 1;
 425                             }
 426                         }
 427                     }
 428                 }
 429                 if (!$p_used) {
 430                     push_email_addresses($pvalue);
 431                 }
 432             } elsif ($ptype eq "T") {
 433                 push(@scm, $pvalue);
 434             } elsif ($ptype eq "W") {
 435                 push(@web, $pvalue);
 436             } elsif ($ptype eq "S") {
 437                 push(@status, $pvalue);
 438             }
 439
 440             $index--;
 441         } else {
 442             push(@subsystem,$tv);
 443             $index = -1;
 444         }
 445     }
 446 }
 447
 448 sub push_email_address {
 449     my ($email_address) = @_;
 450
 451     my $email_name = "";
 452     if ($email_address =~ m/([^<]+)<(.*\@.*)>$/) {
 453         $email_name = $1;
 454         $email_address = $2;
 455     }
 456
 457     if ($email_maintainer) {
 458         if ($email_usename && $email_name) {
 459             push(@email_to, format_email($email_name, $email_address));
 460         } else {
 461             push(@email_to, $email_address);
 462         }
 463     }
 464 }
 465
 466 sub push_email_addresses {
 467     my ($address) = @_;
 468
 469     my @address_list = ();
 470
 471     if (rfc822_valid($address)) {
 472         push_email_address($address);
 473     } elsif (@address_list = rfc822_validlist($address)) {
 474         my $array_count = shift(@address_list);
 475         while (my $entry = shift(@address_list)) {
 476             push_email_address($entry);
 477         }
 478     } else {
 479         warn("Invalid MAINTAINERS address: '" . $address . "'\n");
 480     }
 481 }
 482
 483 sub which {
 484     my ($bin) = @_;
 485
 486     foreach my $path (split(/:/, $ENV{PATH})) {
 487         if (-e "$path/$bin") {
 488             return "$path/$bin";
 489         }
 490     }
 491
 492     return "";
 493 }
 494
 495 sub recent_git_signoffs {
 496     my ($file) = @_;
 497
 498     my $sign_offs = "";
 499     my $cmd = "";
 500     my $output = "";
 501     my $count = 0;
 502     my @lines = ();
 503     my $total_sign_offs;
 504
 505     if (which("git") eq "") {
 506         warn("$P: git not found.  Add --nogit to options?\n");
 507         return;
 508     }
 509     if (!(-d ".git")) {
 510         warn("$P: .git directory not found.  Use a git repository for better results.\n");
 511         warn("$P: perhaps 'git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git'\n");
 512         return;
 513     }
 514
 515     $cmd = "git log --since=${email_git_since} -- ${file}";
 516     $cmd .= " | grep -Ei \"^[-_         a-z]+by:.*\\\@.*\$\"";
 517     if (!$email_git_penguin_chiefs) {
 518         $cmd .= " | grep -Ev \"${penguin_chiefs}\"";
 519     }
 520     $cmd .= " | cut -f2- -d\":\"";
 521     $cmd .= " | sort | uniq -c | sort -rn";
 522
 523     $output = `${cmd}`;
 524     $output =~ s/^\s*//gm;
 525
 526     @lines = split("\n", $output);
 527
 528     $total_sign_offs = 0;
 529     foreach my $line (@lines) {
 530         if ($line =~ m/([0-9]+)\s+(.*)/) {
 531             $total_sign_offs += $1;
 532         } else {
 533             die("$P: Unexpected git output: ${line}\n");
 534         }
 535     }
 536
 537     foreach my $line (@lines) {
 538         if ($line =~ m/([0-9]+)\s+(.*)/) {
 539             my $sign_offs = $1;
 540             $line = $2;
 541             $count++;
 542             if ($sign_offs < $email_git_min_signatures ||
 543                 $count > $email_git_max_maintainers ||
 544                 $sign_offs * 100 / $total_sign_offs < $email_git_min_percent) {
 545                 last;
 546             }
 547         }
 548         if ($line =~ m/(.+)<(.+)>/) {
 549             my $git_name = $1;
 550             my $git_addr = $2;
 551             if ($email_usename) {
 552                 push(@email_to, format_email($git_name, $git_addr));
 553             } else {
 554                 push(@email_to, $git_addr);
 555             }
 556         } elsif ($line =~ m/<(.+)>/) {
 557             my $git_addr = $1;
 558             push(@email_to, $git_addr);
 559         } else {
 560             push(@email_to, $line);
 561         }
 562     }
 563 }
 564
 565 sub uniq {
 566     my @parms = @_;
 567
 568     my %saw;
 569     @parms = grep(!$saw{$_}++, @parms);
 570     return @parms;
 571 }
 572
 573 sub sort_and_uniq {
 574     my @parms = @_;
 575
 576     my %saw;
 577     @parms = sort @parms;
 578     @parms = grep(!$saw{$_}++, @parms);
 579     return @parms;
 580 }
 581
 582 sub output {
 583     my @parms = @_;
 584
 585     if ($output_multiline) {
 586         foreach my $line (@parms) {
 587             print("${line}\n");
 588         }
 589     } else {
 590         print(join($output_separator, @parms));
 591         print("\n");
 592     }
 593 }
 594
 595 my $rfc822re;
 596
 597 sub make_rfc822re {
 598 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
 599 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
 600 #   This regexp will only work on addresses which have had comments stripped
 601 #   and replaced with rfc822_lwsp.
 602
 603     my $specials = '()<>@,;:\\\\".\\[\\]';
 604     my $controls = '\\000-\\037\\177';
 605
 606     my $dtext = "[^\\[\\]\\r\\\\]";
 607     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
 608
 609     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
 610
 611 #   Use zero-width assertion to spot the limit of an atom.  A simple
 612 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
 613     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
 614     my $word = "(?:$atom|$quoted_string)";
 615     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
 616
 617     my $sub_domain = "(?:$atom|$domain_literal)";
 618     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
 619
 620     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
 621
 622     my $phrase = "$word*";
 623     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
 624     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
 625     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
 626
 627     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
 628     my $address = "(?:$mailbox|$group)";
 629
 630     return "$rfc822_lwsp*$address";
 631 }
 632
 633 sub rfc822_strip_comments {
 634     my $s = shift;
 635 #   Recursively remove comments, and replace with a single space.  The simpler
 636 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
 637 #   chars in atoms, for example.
 638
 639     while ($s =~ s/^((?:[^"\\]|\\.)*
 640                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
 641                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
 642     return $s;
 643 }
 644
 645 #   valid: returns true if the parameter is an RFC822 valid address
 646 #
 647 sub rfc822_valid ($) {
 648     my $s = rfc822_strip_comments(shift);
 649
 650     if (!$rfc822re) {
 651         $rfc822re = make_rfc822re();
 652     }
 653
 654     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
 655 }
 656
 657 #   validlist: In scalar context, returns true if the parameter is an RFC822
 658 #              valid list of addresses.
 659 #
 660 #              In list context, returns an empty list on failure (an invalid
 661 #              address was found); otherwise a list whose first element is the
 662 #              number of addresses found and whose remaining elements are the
 663 #              addresses.  This is needed to disambiguate failure (invalid)
 664 #              from success with no addresses found, because an empty string is
 665 #              a valid list.
 666
 667 sub rfc822_validlist ($) {
 668     my $s = rfc822_strip_comments(shift);
 669
 670     if (!$rfc822re) {
 671         $rfc822re = make_rfc822re();
 672     }
 673     # * null list items are valid according to the RFC
 674     # * the '1' business is to aid in distinguishing failure from no results
 675
 676     my @r;
 677     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
 678         $s =~ m/^$rfc822_char*$/) {
 679         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
 680             push @r, $1;
 681         }
 682         return wantarray ? (scalar(@r), @r) : 1;
 683     }
 684     else {
 685         return wantarray ? () : 0;
 686     }
 687 }