Merge branch 'ml/trace'
[git] / git-send-email.perl
1 #!/usr/bin/perl -w
2 #
3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
5 #
6 # GPL v2 (See COPYING)
7 #
8 # Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
9 #
10 # Sends a collection of emails to the given email addresses, disturbingly fast.
11 #
12 # Supports two formats:
13 # 1. mbox format files (ignoring most headers and MIME formatting - this is designed for sending patches)
14 # 2. The original format support by Greg's script:
15 #    first line of the message is who to CC,
16 #    and second line is the subject of the message.
17 #
18
19 use strict;
20 use warnings;
21 use Term::ReadLine;
22 use Getopt::Long;
23 use Data::Dumper;
24
25 package FakeTerm;
26 sub new {
27         my ($class, $reason) = @_;
28         return bless \$reason, shift;
29 }
30 sub readline {
31         my $self = shift;
32         die "Cannot use readline on FakeTerm: $$self";
33 }
34 package main;
35
36 # most mail servers generate the Date: header, but not all...
37 sub format_2822_time {
38         my ($time) = @_;
39         my @localtm = localtime($time);
40         my @gmttm = gmtime($time);
41         my $localmin = $localtm[1] + $localtm[2] * 60;
42         my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
43         if ($localtm[0] != $gmttm[0]) {
44                 die "local zone differs from GMT by a non-minute interval\n";
45         }
46         if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
47                 $localmin += 1440;
48         } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
49                 $localmin -= 1440;
50         } elsif ($gmttm[6] != $localtm[6]) {
51                 die "local time offset greater than or equal to 24 hours\n";
52         }
53         my $offset = $localmin - $gmtmin;
54         my $offhour = $offset / 60;
55         my $offmin = abs($offset % 60);
56         if (abs($offhour) >= 24) {
57                 die ("local time offset greater than or equal to 24 hours\n");
58         }
59
60         return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
61                        qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
62                        $localtm[3],
63                        qw(Jan Feb Mar Apr May Jun
64                           Jul Aug Sep Oct Nov Dec)[$localtm[4]],
65                        $localtm[5]+1900,
66                        $localtm[2],
67                        $localtm[1],
68                        $localtm[0],
69                        ($offset >= 0) ? '+' : '-',
70                        abs($offhour),
71                        $offmin,
72                        );
73 }
74
75 my $have_email_valid = eval { require Email::Valid; 1 };
76 my $smtp;
77
78 sub unique_email_list(@);
79 sub cleanup_compose_files();
80
81 # Constants (essentially)
82 my $compose_filename = ".msg.$$";
83
84 # Variables we fill in automatically, or via prompting:
85 my (@to,@cc,@initial_cc,@bcclist,
86         $initial_reply_to,$initial_subject,@files,$from,$compose,$time);
87
88 # Behavior modification variables
89 my ($chain_reply_to, $quiet, $suppress_from, $no_signed_off_cc) = (1, 0, 0, 0);
90 my $smtp_server;
91
92 # Example reply to:
93 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
94
95 my $term = eval {
96         new Term::ReadLine 'git-send-email';
97 };
98 if ($@) {
99         $term = new FakeTerm "$@: going non-interactive";
100 }
101
102 # Begin by accumulating all the variables (defined above), that we will end up
103 # needing, first, from the command line:
104
105 my $rc = GetOptions("from=s" => \$from,
106                     "in-reply-to=s" => \$initial_reply_to,
107                     "subject=s" => \$initial_subject,
108                     "to=s" => \@to,
109                     "cc=s" => \@initial_cc,
110                     "bcc=s" => \@bcclist,
111                     "chain-reply-to!" => \$chain_reply_to,
112                     "smtp-server=s" => \$smtp_server,
113                     "compose" => \$compose,
114                     "quiet" => \$quiet,
115                     "suppress-from" => \$suppress_from,
116                     "no-signed-off-cc|no-signed-off-by-cc" => \$no_signed_off_cc,
117          );
118
119 # Verify the user input
120
121 foreach my $entry (@to) {
122         die "Comma in --to entry: $entry'\n" unless $entry !~ m/,/;
123 }
124
125 foreach my $entry (@initial_cc) {
126         die "Comma in --cc entry: $entry'\n" unless $entry !~ m/,/;
127 }
128
129 foreach my $entry (@bcclist) {
130         die "Comma in --bcclist entry: $entry'\n" unless $entry !~ m/,/;
131 }
132
133 # Now, let's fill any that aren't set in with defaults:
134
135 sub gitvar {
136     my ($var) = @_;
137     my $fh;
138     my $pid = open($fh, '-|');
139     die "$!" unless defined $pid;
140     if (!$pid) {
141         exec('git-var', $var) or die "$!";
142     }
143     my ($val) = <$fh>;
144     close $fh or die "$!";
145     chomp($val);
146     return $val;
147 }
148
149 sub gitvar_ident {
150     my ($name) = @_;
151     my $val = gitvar($name);
152     my @field = split(/\s+/, $val);
153     return join(' ', @field[0...(@field-3)]);
154 }
155
156 my ($author) = gitvar_ident('GIT_AUTHOR_IDENT');
157 my ($committer) = gitvar_ident('GIT_COMMITTER_IDENT');
158
159 my %aliases;
160 chomp(my @alias_files = `git-repo-config --get-all sendemail.aliasesfile`);
161 chomp(my $aliasfiletype = `git-repo-config sendemail.aliasfiletype`);
162 my %parse_alias = (
163         # multiline formats can be supported in the future
164         mutt => sub { my $fh = shift; while (<$fh>) {
165                 if (/^alias\s+(\S+)\s+(.*)$/) {
166                         my ($alias, $addr) = ($1, $2);
167                         $addr =~ s/#.*$//; # mutt allows # comments
168                          # commas delimit multiple addresses
169                         $aliases{$alias} = [ split(/\s*,\s*/, $addr) ];
170                 }}},
171         mailrc => sub { my $fh = shift; while (<$fh>) {
172                 if (/^alias\s+(\S+)\s+(.*)$/) {
173                         # spaces delimit multiple addresses
174                         $aliases{$1} = [ split(/\s+/, $2) ];
175                 }}},
176         pine => sub { my $fh = shift; while (<$fh>) {
177                 if (/^(\S+)\s+(.*)$/) {
178                         $aliases{$1} = [ split(/\s*,\s*/, $2) ];
179                 }}},
180         gnus => sub { my $fh = shift; while (<$fh>) {
181                 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
182                         $aliases{$1} = [ $2 ];
183                 }}}
184 );
185
186 if (@alias_files && defined $parse_alias{$aliasfiletype}) {
187         foreach my $file (@alias_files) {
188                 open my $fh, '<', $file or die "opening $file: $!\n";
189                 $parse_alias{$aliasfiletype}->($fh);
190                 close $fh;
191         }
192 }
193
194 my $prompting = 0;
195 if (!defined $from) {
196         $from = $author || $committer;
197         do {
198                 $_ = $term->readline("Who should the emails appear to be from? ",
199                         $from);
200         } while (!defined $_);
201
202         $from = $_;
203         print "Emails will be sent from: ", $from, "\n";
204         $prompting++;
205 }
206
207 if (!@to) {
208         do {
209                 $_ = $term->readline("Who should the emails be sent to? ",
210                                 "");
211         } while (!defined $_);
212         my $to = $_;
213         push @to, split /,/, $to;
214         $prompting++;
215 }
216
217 sub expand_aliases {
218         my @cur = @_;
219         my @last;
220         do {
221                 @last = @cur;
222                 @cur = map { $aliases{$_} ? @{$aliases{$_}} : $_ } @last;
223         } while (join(',',@cur) ne join(',',@last));
224         return @cur;
225 }
226
227 @to = expand_aliases(@to);
228 @initial_cc = expand_aliases(@initial_cc);
229 @bcclist = expand_aliases(@bcclist);
230
231 if (!defined $initial_subject && $compose) {
232         do {
233                 $_ = $term->readline("What subject should the emails start with? ",
234                         $initial_subject);
235         } while (!defined $_);
236         $initial_subject = $_;
237         $prompting++;
238 }
239
240 if (!defined $initial_reply_to && $prompting) {
241         do {
242                 $_= $term->readline("Message-ID to be used as In-Reply-To for the first email? ",
243                         $initial_reply_to);
244         } while (!defined $_);
245
246         $initial_reply_to = $_;
247         $initial_reply_to =~ s/(^\s+|\s+$)//g;
248 }
249
250 if (!$smtp_server) {
251         foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
252                 if (-x $_) {
253                         $smtp_server = $_;
254                         last;
255                 }
256         }
257         $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
258 }
259
260 if ($compose) {
261         # Note that this does not need to be secure, but we will make a small
262         # effort to have it be unique
263         open(C,">",$compose_filename)
264                 or die "Failed to open for writing $compose_filename: $!";
265         print C "From $from # This line is ignored.\n";
266         printf C "Subject: %s\n\n", $initial_subject;
267         printf C <<EOT;
268 GIT: Please enter your email below.
269 GIT: Lines beginning in "GIT: " will be removed.
270 GIT: Consider including an overall diffstat or table of contents
271 GIT: for the patch you are writing.
272
273 EOT
274         close(C);
275
276         my $editor = $ENV{EDITOR};
277         $editor = 'vi' unless defined $editor;
278         system($editor, $compose_filename);
279
280         open(C2,">",$compose_filename . ".final")
281                 or die "Failed to open $compose_filename.final : " . $!;
282
283         open(C,"<",$compose_filename)
284                 or die "Failed to open $compose_filename : " . $!;
285
286         while(<C>) {
287                 next if m/^GIT: /;
288                 print C2 $_;
289         }
290         close(C);
291         close(C2);
292
293         do {
294                 $_ = $term->readline("Send this email? (y|n) ");
295         } while (!defined $_);
296
297         if (uc substr($_,0,1) ne 'Y') {
298                 cleanup_compose_files();
299                 exit(0);
300         }
301
302         @files = ($compose_filename . ".final");
303 }
304
305
306 # Now that all the defaults are set, process the rest of the command line
307 # arguments and collect up the files that need to be processed.
308 for my $f (@ARGV) {
309         if (-d $f) {
310                 opendir(DH,$f)
311                         or die "Failed to opendir $f: $!";
312
313                 push @files, grep { -f $_ } map { +$f . "/" . $_ }
314                                 sort readdir(DH);
315
316         } elsif (-f $f) {
317                 push @files, $f;
318
319         } else {
320                 print STDERR "Skipping $f - not found.\n";
321         }
322 }
323
324 if (@files) {
325         unless ($quiet) {
326                 print $_,"\n" for (@files);
327         }
328 } else {
329         print <<EOT;
330 git-send-email [options] <file | directory> [... file | directory ]
331 Options:
332    --from         Specify the "From:" line of the email to be sent.
333
334    --to           Specify the primary "To:" line of the email.
335
336    --cc           Specify an initial "Cc:" list for the entire series
337                   of emails.
338
339    --bcc          Specify a list of email addresses that should be Bcc:
340                   on all the emails.
341
342    --compose      Use \$EDITOR to edit an introductory message for the
343                   patch series.
344
345    --subject      Specify the initial "Subject:" line.
346                   Only necessary if --compose is also set.  If --compose
347                   is not set, this will be prompted for.
348
349    --in-reply-to  Specify the first "In-Reply-To:" header line.
350                   Only used if --compose is also set.  If --compose is not
351                   set, this will be prompted for.
352
353    --chain-reply-to If set, the replies will all be to the previous
354                   email sent, rather than to the first email sent.
355                   Defaults to on.
356
357    --no-signed-off-cc Suppress the automatic addition of email addresses
358                  that appear in a Signed-off-by: line, to the cc: list.
359                  Note: Using this option is not recommended.
360
361    --smtp-server  If set, specifies the outgoing SMTP server to use.
362                   Defaults to localhost.
363
364   --suppress-from Suppress sending emails to yourself if your address
365                   appears in a From: line.
366
367    --quiet      Make git-send-email less verbose.  One line per email should be
368                 all that is output.
369
370 Error: Please specify a file or a directory on the command line.
371 EOT
372         exit(1);
373 }
374
375 # Variables we set as part of the loop over files
376 our ($message_id, $cc, %mail, $subject, $reply_to, $references, $message);
377
378 sub extract_valid_address {
379         my $address = shift;
380         my $local_part_regexp = '[^<>"\s@]+';
381         my $domain_regexp = '[^.<>"\s@]+(?:\.[^.<>"\s@]+)+';
382
383         # check for a local address:
384         return $address if ($address =~ /^($local_part_regexp)$/);
385
386         if ($have_email_valid) {
387                 return scalar Email::Valid->address($address);
388         } else {
389                 # less robust/correct than the monster regexp in Email::Valid,
390                 # but still does a 99% job, and one less dependency
391                 $address =~ /($local_part_regexp\@$domain_regexp)/;
392                 return $1;
393         }
394 }
395
396 # Usually don't need to change anything below here.
397
398 # we make a "fake" message id by taking the current number
399 # of seconds since the beginning of Unix time and tacking on
400 # a random number to the end, in case we are called quicker than
401 # 1 second since the last time we were called.
402
403 # We'll setup a template for the message id, using the "from" address:
404 my $message_id_from = extract_valid_address($from);
405 my $message_id_template = "<%s-git-send-email-$message_id_from>";
406
407 sub make_message_id
408 {
409         my $date = time;
410         my $pseudo_rand = int (rand(4200));
411         $message_id = sprintf $message_id_template, "$date$pseudo_rand";
412         #print "new message id = $message_id\n"; # Was useful for debugging
413 }
414
415
416
417 $cc = "";
418 $time = time - scalar $#files;
419
420 sub send_message
421 {
422         my @recipients = unique_email_list(@to);
423         my $to = join (",\n\t", @recipients);
424         @recipients = unique_email_list(@recipients,@cc,@bcclist);
425         my $date = format_2822_time($time++);
426         my $gitversion = '@@GIT_VERSION@@';
427         if ($gitversion =~ m/..GIT_VERSION../) {
428             $gitversion = `git --version`;
429             chomp $gitversion;
430             # keep only what's after the last space
431             $gitversion =~ s/^.* //;
432         }
433
434         my $header = "From: $from
435 To: $to
436 Cc: $cc
437 Subject: $subject
438 Date: $date
439 Message-Id: $message_id
440 X-Mailer: git-send-email $gitversion
441 ";
442         if ($reply_to) {
443
444                 $header .= "In-Reply-To: $reply_to\n";
445                 $header .= "References: $references\n";
446         }
447
448         if ($smtp_server =~ m#^/#) {
449                 my $pid = open my $sm, '|-';
450                 defined $pid or die $!;
451                 if (!$pid) {
452                         exec($smtp_server,'-i',
453                              map { extract_valid_address($_) }
454                              @recipients) or die $!;
455                 }
456                 print $sm "$header\n$message";
457                 close $sm or die $?;
458         } else {
459                 require Net::SMTP;
460                 $smtp ||= Net::SMTP->new( $smtp_server );
461                 $smtp->mail( $from ) or die $smtp->message;
462                 $smtp->to( @recipients ) or die $smtp->message;
463                 $smtp->data or die $smtp->message;
464                 $smtp->datasend("$header\n$message") or die $smtp->message;
465                 $smtp->dataend() or die $smtp->message;
466                 $smtp->ok or die "Failed to send $subject\n".$smtp->message;
467         }
468         if ($quiet) {
469                 printf "Sent %s\n", $subject;
470         } else {
471                 print "OK. Log says:\nDate: $date\n";
472                 if ($smtp) {
473                         print "Server: $smtp_server\n";
474                 } else {
475                         print "Sendmail: $smtp_server\n";
476                 }
477                 print "From: $from\nSubject: $subject\nCc: $cc\nTo: $to\n\n";
478                 if ($smtp) {
479                         print "Result: ", $smtp->code, ' ',
480                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
481                 } else {
482                         print "Result: OK\n";
483                 }
484         }
485 }
486
487 $reply_to = $initial_reply_to;
488 $references = $initial_reply_to || '';
489 make_message_id();
490 $subject = $initial_subject;
491
492 foreach my $t (@files) {
493         open(F,"<",$t) or die "can't open file $t";
494
495         my $author_not_sender = undef;
496         @cc = @initial_cc;
497         my $found_mbox = 0;
498         my $header_done = 0;
499         $message = "";
500         while(<F>) {
501                 if (!$header_done) {
502                         $found_mbox = 1, next if (/^From /);
503                         chomp;
504
505                         if ($found_mbox) {
506                                 if (/^Subject:\s+(.*)$/) {
507                                         $subject = $1;
508
509                                 } elsif (/^(Cc|From):\s+(.*)$/) {
510                                         if ($2 eq $from) {
511                                                 next if ($suppress_from);
512                                         }
513                                         else {
514                                                 $author_not_sender = $2;
515                                         }
516                                         printf("(mbox) Adding cc: %s from line '%s'\n",
517                                                 $2, $_) unless $quiet;
518                                         push @cc, $2;
519                                 }
520
521                         } else {
522                                 # In the traditional
523                                 # "send lots of email" format,
524                                 # line 1 = cc
525                                 # line 2 = subject
526                                 # So let's support that, too.
527                                 if (@cc == 0) {
528                                         printf("(non-mbox) Adding cc: %s from line '%s'\n",
529                                                 $_, $_) unless $quiet;
530
531                                         push @cc, $_;
532
533                                 } elsif (!defined $subject) {
534                                         $subject = $_;
535                                 }
536                         }
537
538                         # A whitespace line will terminate the headers
539                         if (m/^\s*$/) {
540                                 $header_done = 1;
541                         }
542                 } else {
543                         $message .=  $_;
544                         if (/^Signed-off-by: (.*)$/i && !$no_signed_off_cc) {
545                                 my $c = $1;
546                                 chomp $c;
547                                 push @cc, $c;
548                                 printf("(sob) Adding cc: %s from line '%s'\n",
549                                         $c, $_) unless $quiet;
550                         }
551                 }
552         }
553         close F;
554         if (defined $author_not_sender) {
555                 $message = "From: $author_not_sender\n\n$message";
556         }
557
558         $cc = join(", ", unique_email_list(@cc));
559
560         send_message();
561
562         # set up for the next message
563         if ($chain_reply_to || length($reply_to) == 0) {
564                 $reply_to = $message_id;
565                 if (length $references > 0) {
566                         $references .= " $message_id";
567                 } else {
568                         $references = "$message_id";
569                 }
570         }
571         make_message_id();
572 }
573
574 if ($compose) {
575         cleanup_compose_files();
576 }
577
578 sub cleanup_compose_files() {
579         unlink($compose_filename, $compose_filename . ".final");
580
581 }
582
583 $smtp->quit if $smtp;
584
585 sub unique_email_list(@) {
586         my %seen;
587         my @emails;
588
589         foreach my $entry (@_) {
590                 if (my $clean = extract_valid_address($entry)) {
591                         $seen{$clean} ||= 0;
592                         next if $seen{$clean}++;
593                         push @emails, $entry;
594                 } else {
595                         print STDERR "W: unable to extract a valid address",
596                                         " from: $entry\n";
597                 }
598         }
599         return @emails;
600 }