scripts/get_maintainer.pl: better fix for subscriber-only mailing lists
[sfrench/cifs-2.6.git] / 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.16';
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_since = "1-year-ago";
31 my $output_multiline = 1;
32 my $output_separator = ", ";
33 my $scm = 0;
34 my $web = 0;
35 my $subsystem = 0;
36 my $status = 0;
37 my $from_filename = 0;
38 my $version = 0;
39 my $help = 0;
40
41 my $exit = 0;
42
43 my @penguin_chief = ();
44 push(@penguin_chief,"Linus Torvalds:torvalds\@linux-foundation.org");
45 #Andrew wants in on most everything - 2009/01/14
46 #push(@penguin_chief,"Andrew Morton:akpm\@linux-foundation.org");
47
48 my @penguin_chief_names = ();
49 foreach my $chief (@penguin_chief) {
50     if ($chief =~ m/^(.*):(.*)/) {
51         my $chief_name = $1;
52         my $chief_addr = $2;
53         push(@penguin_chief_names, $chief_name);
54     }
55 }
56 my $penguin_chiefs = "\(" . join("|",@penguin_chief_names) . "\)";
57
58 if (!GetOptions(
59                 'email!' => \$email,
60                 'git!' => \$email_git,
61                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
62                 'git-min-signatures=i' => \$email_git_min_signatures,
63                 'git-max-maintainers=i' => \$email_git_max_maintainers,
64                 'git-since=s' => \$email_git_since,
65                 'm!' => \$email_maintainer,
66                 'n!' => \$email_usename,
67                 'l!' => \$email_list,
68                 's!' => \$email_subscriber_list,
69                 'multiline!' => \$output_multiline,
70                 'separator=s' => \$output_separator,
71                 'subsystem!' => \$subsystem,
72                 'status!' => \$status,
73                 'scm!' => \$scm,
74                 'web!' => \$web,
75                 'f|file' => \$from_filename,
76                 'v|version' => \$version,
77                 'h|help' => \$help,
78                 )) {
79     usage();
80     die "$P: invalid argument\n";
81 }
82
83 if ($help != 0) {
84     usage();
85     exit 0;
86 }
87
88 if ($version != 0) {
89     print("${P} ${V}\n");
90     exit 0;
91 }
92
93 if ($#ARGV < 0) {
94     usage();
95     die "$P: argument missing: patchfile or -f file please\n";
96 }
97
98 my $selections = $email + $scm + $status + $subsystem + $web;
99 if ($selections == 0) {
100     usage();
101     die "$P:  Missing required option: email, scm, status, subsystem or web\n";
102 }
103
104 if ($email && ($email_maintainer + $email_list + $email_subscriber_list
105                + $email_git + $email_git_penguin_chiefs) == 0) {
106     usage();
107     die "$P: Please select at least 1 email option\n";
108 }
109
110 if (!top_of_kernel_tree($lk_path)) {
111     die "$P: The current directory does not appear to be "
112         . "a linux kernel source tree.\n";
113 }
114
115 ## Read MAINTAINERS for type/value pairs
116
117 my @typevalue = ();
118 open(MAINT, "<${lk_path}MAINTAINERS") || die "$P: Can't open MAINTAINERS\n";
119 while (<MAINT>) {
120     my $line = $_;
121
122     if ($line =~ m/^(\C):\s*(.*)/) {
123         my $type = $1;
124         my $value = $2;
125
126         ##Filename pattern matching
127         if ($type eq "F" || $type eq "X") {
128             $value =~ s@\.@\\\.@g;       ##Convert . to \.
129             $value =~ s/\*/\.\*/g;       ##Convert * to .*
130             $value =~ s/\?/\./g;         ##Convert ? to .
131         }
132         push(@typevalue, "$type:$value");
133     } elsif (!/^(\s)*$/) {
134         $line =~ s/\n$//g;
135         push(@typevalue, $line);
136     }
137 }
138 close(MAINT);
139
140 ## use the filenames on the command line or find the filenames in the patchfiles
141
142 my @files = ();
143
144 foreach my $file (@ARGV) {
145     next if ((-d $file));
146     if (!(-f $file)) {
147         die "$P: file '${file}' not found\n";
148     }
149     if ($from_filename) {
150         push(@files, $file);
151     } else {
152         my $file_cnt = @files;
153         open(PATCH, "<$file") or die "$P: Can't open ${file}\n";
154         while (<PATCH>) {
155             if (m/^\+\+\+\s+(\S+)/) {
156                 my $filename = $1;
157                 $filename =~ s@^[^/]*/@@;
158                 $filename =~ s@\n@@;
159                 push(@files, $filename);
160             }
161         }
162         close(PATCH);
163         if ($file_cnt == @files) {
164             die "$P: file '${file}' doesn't appear to be a patch.  "
165                 . "Add -f to options?\n";
166         }
167         @files = sort_and_uniq(@files);
168     }
169 }
170
171 my @email_to = ();
172 my @list_to = ();
173 my @scm = ();
174 my @web = ();
175 my @subsystem = ();
176 my @status = ();
177
178 # Find responsible parties
179
180 foreach my $file (@files) {
181
182 #Do not match excluded file patterns
183
184     my $exclude = 0;
185     foreach my $line (@typevalue) {
186         if ($line =~ m/^(\C):\s*(.*)/) {
187             my $type = $1;
188             my $value = $2;
189             if ($type eq 'X') {
190                 if (file_match_pattern($file, $value)) {
191                     $exclude = 1;
192                 }
193             }
194         }
195     }
196
197     if (!$exclude) {
198         my $tvi = 0;
199         foreach my $line (@typevalue) {
200             if ($line =~ m/^(\C):\s*(.*)/) {
201                 my $type = $1;
202                 my $value = $2;
203                 if ($type eq 'F') {
204                     if (file_match_pattern($file, $value)) {
205                         add_categories($tvi);
206                     }
207                 }
208             }
209             $tvi++;
210         }
211     }
212
213     if ($email && $email_git) {
214         recent_git_signoffs($file);
215     }
216
217 }
218
219 if ($email_git_penguin_chiefs) {
220     foreach my $chief (@penguin_chief) {
221         if ($chief =~ m/^(.*):(.*)/) {
222             my $chief_name = $1;
223             my $chief_addr = $2;
224             if ($email_usename) {
225                 push(@email_to, format_email($chief_name, $chief_addr));
226             } else {
227                 push(@email_to, $chief_addr);
228             }
229         }
230     }
231 }
232
233 if ($email || $email_list) {
234     my @to = ();
235     if ($email) {
236         @to = (@to, @email_to);
237     }
238     if ($email_list) {
239         if (@list_to == 0) {
240             push(@list_to, "linux-kernel\@vger.kernel.org");
241         @to = (@to, @list_to);
242         }
243     }
244     output(uniq(@to));
245 }
246
247 if ($scm) {
248     @scm = sort_and_uniq(@scm);
249     output(@scm);
250 }
251
252 if ($status) {
253     @status = sort_and_uniq(@status);
254     output(@status);
255 }
256
257 if ($subsystem) {
258     @subsystem = sort_and_uniq(@subsystem);
259     output(@subsystem);
260 }
261
262 if ($web) {
263     @web = sort_and_uniq(@web);
264     output(@web);
265 }
266
267 exit($exit);
268
269 sub file_match_pattern {
270     my ($file, $pattern) = @_;
271     if (substr($pattern, -1) eq "/") {
272         if ($file =~ m@^$pattern@) {
273             return 1;
274         }
275     } else {
276         if ($file =~ m@^$pattern@) {
277             my $s1 = ($file =~ tr@/@@);
278             my $s2 = ($pattern =~ tr@/@@);
279             if ($s1 == $s2) {
280                 return 1;
281             }
282         }
283     }
284     return 0;
285 }
286
287 sub usage {
288     print <<EOT;
289 usage: $P [options] patchfile
290        $P [options] -f file
291 version: $V
292
293 MAINTAINER field selection options:
294   --email => print email address(es) if any
295     --git => include recent git \*-by: signers
296     --git-chief-penguins => include ${penguin_chiefs}
297     --git-min-signatures => number of signatures required (default: 1)
298     --git-max-maintainers => maximum maintainers to add (default: 5)
299     --git-since => git history to use (default: 1-year-ago)
300     --m => include maintainer(s) if any
301     --n => include name 'Full Name <addr\@domain.tld>'
302     --l => include list(s) if any
303     --s => include subscriber only list(s) if any
304   --scm => print SCM tree(s) if any
305   --status => print status if any
306   --subsystem => print subsystem name if any
307   --web => print website(s) if any
308
309 Output type options:
310   --separator [, ] => separator for multiple entries on 1 line
311   --multiline => print 1 entry per line
312
313 Default options:
314   [--email --git --m --n --l --multiline]
315
316 Other options:
317   --version -> show version
318   --help => show this help information
319
320 EOT
321 }
322
323 sub top_of_kernel_tree {
324         my ($lk_path) = @_;
325
326         if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
327             $lk_path .= "/";
328         }
329         if (   (-f "${lk_path}COPYING")
330             && (-f "${lk_path}CREDITS")
331             && (-f "${lk_path}Kbuild")
332             && (-f "${lk_path}MAINTAINERS")
333             && (-f "${lk_path}Makefile")
334             && (-f "${lk_path}README")
335             && (-d "${lk_path}Documentation")
336             && (-d "${lk_path}arch")
337             && (-d "${lk_path}include")
338             && (-d "${lk_path}drivers")
339             && (-d "${lk_path}fs")
340             && (-d "${lk_path}init")
341             && (-d "${lk_path}ipc")
342             && (-d "${lk_path}kernel")
343             && (-d "${lk_path}lib")
344             && (-d "${lk_path}scripts")) {
345                 return 1;
346         }
347         return 0;
348 }
349
350 sub format_email {
351     my ($name, $email) = @_;
352
353     $name =~ s/^\s+|\s+$//g;
354     $email =~ s/^\s+|\s+$//g;
355
356     my $formatted_email = "";
357
358     if ($name =~ /[^a-z0-9 \.\-]/i) {    ##has "must quote" chars
359         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
360         $formatted_email = "\"${name}\"\ \<${email}\>";
361     } else {
362         $formatted_email = "${name} \<${email}\>";
363     }
364     return $formatted_email;
365 }
366
367 sub add_categories {
368     my ($index) = @_;
369
370     $index = $index - 1;
371     while ($index >= 0) {
372         my $tv = $typevalue[$index];
373         if ($tv =~ m/^(\C):\s*(.*)/) {
374             my $ptype = $1;
375             my $pvalue = $2;
376             if ($ptype eq "L") {
377                 my $list_address = $pvalue;
378                 my $list_additional = "";
379                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
380                     $list_address = $1;
381                     $list_additional = $2;
382                 }
383                 if ($list_additional =~ m/subscribers-only/) {
384                     if ($email_subscriber_list) {
385                         push(@list_to, $list_address);
386                     }
387                 } else {
388                     if ($email_list) {
389                         push(@list_to, $list_address);
390                     }
391                 }
392             } elsif ($ptype eq "M") {
393                 if ($email_maintainer) {
394                     if ($index >= 0) {
395                         my $tv = $typevalue[$index - 1];
396                         if ($tv =~ m/^(\C):\s*(.*)/) {
397                             if ($1 eq "P" && $email_usename) {
398                                 push(@email_to, format_email($2, $pvalue));
399                             } else {
400                                 push(@email_to, $pvalue);
401                             }
402                         }
403                     } else {
404                         push(@email_to, $pvalue);
405                     }
406                 }
407             } elsif ($ptype eq "T") {
408                 push(@scm, $pvalue);
409             } elsif ($ptype eq "W") {
410                 push(@web, $pvalue);
411             } elsif ($ptype eq "S") {
412                 push(@status, $pvalue);
413             }
414
415             $index--;
416         } else {
417             push(@subsystem,$tv);
418             $index = -1;
419         }
420     }
421 }
422
423 sub which {
424     my ($bin) = @_;
425
426     foreach my $path (split /:/, $ENV{PATH}) {
427         if (-e "$path/$bin") {
428             return "$path/$bin";
429         }
430     }
431
432     return "";
433 }
434
435 sub recent_git_signoffs {
436     my ($file) = @_;
437
438     my $sign_offs = "";
439     my $cmd = "";
440     my $output = "";
441     my $count = 0;
442     my @lines = ();
443
444     if (which("git") eq "") {
445         die("$P: git not found.  Add --nogit to options?\n");
446     }
447
448     $cmd = "git log --since=${email_git_since} -- ${file}";
449     $cmd .= " | grep -Pi \"^[-_         a-z]+by:.*\\\@\"";
450     if (!$email_git_penguin_chiefs) {
451         $cmd .= " | grep -Pv \"${penguin_chiefs}\"";
452     }
453     $cmd .= " | cut -f2- -d\":\"";
454     $cmd .= " | sed -e \"s/^\\s+//g\"";
455     $cmd .= " | sort | uniq -c | sort -rn";
456
457     $output = `${cmd}`;
458     $output =~ s/^\s*//gm;
459
460     @lines = split("\n", $output);
461     foreach my $line (@lines) {
462         if ($line =~ m/([0-9]+)\s+(.*)/) {
463             my $sign_offs = $1;
464             $line = $2;
465             $count++;
466             if ($sign_offs < $email_git_min_signatures ||
467                 $count > $email_git_max_maintainers) {
468                 last;
469             }
470         } else {
471             die("$P: Unexpected git output: ${line}\n");
472         }
473         if ($line =~ m/(.+)<(.+)>/) {
474             my $git_name = $1;
475             my $git_addr = $2;
476             $git_name =~ tr/^\"//;
477             $git_name =~ tr/^\\s*//;
478             $git_name =~ tr/\"$//;
479             $git_name =~ tr/\\s*$//;
480             if ($email_usename) {
481                 push(@email_to, format_email($git_name, $git_addr));
482             } else {
483                 push(@email_to, $git_addr);
484             }
485         } elsif ($line =~ m/<(.+)>/) {
486             my $git_addr = $1;
487             push(@email_to, $git_addr);
488         } else {
489             push(@email_to, $line);
490         }
491     }
492     return $output;
493 }
494
495 sub uniq {
496     my @parms = @_;
497
498     my %saw;
499     @parms = grep(!$saw{$_}++, @parms);
500     return @parms;
501 }
502
503 sub sort_and_uniq {
504     my @parms = @_;
505
506     my %saw;
507     @parms = sort @parms;
508     @parms = grep(!$saw{$_}++, @parms);
509     return @parms;
510 }
511
512 sub output {
513     my @parms = @_;
514
515     if ($output_multiline) {
516         foreach my $line (@parms) {
517             print("${line}\n");
518         }
519     } else {
520         print(join($output_separator, @parms));
521         print("\n");
522     }
523 }