Add zlib
[git/pclouds.git] / git-send-email.perl
blob7552caca4bbbb38b161cfb47f94d4577627ccbb3
1 #!/usr/bin/perl -w
3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
6 # GPL v2 (See COPYING)
8 # Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
10 # Sends a collection of emails to the given email addresses, disturbingly fast.
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.
19 use strict;
20 use warnings;
21 use Term::ReadLine;
22 use Getopt::Long;
23 use Data::Dumper;
24 use Git;
26 package FakeTerm;
27 sub new {
28 my ($class, $reason) = @_;
29 return bless \$reason, shift;
31 sub readline {
32 my $self = shift;
33 die "Cannot use readline on FakeTerm: $$self";
35 package main;
38 sub usage {
39 print <<EOT;
40 git-send-email [options] <file | directory>...
41 Options:
42 --from Specify the "From:" line of the email to be sent.
44 --to Specify the primary "To:" line of the email.
46 --cc Specify an initial "Cc:" list for the entire series
47 of emails.
49 --bcc Specify a list of email addresses that should be Bcc:
50 on all the emails.
52 --compose Use \$EDITOR to edit an introductory message for the
53 patch series.
55 --subject Specify the initial "Subject:" line.
56 Only necessary if --compose is also set. If --compose
57 is not set, this will be prompted for.
59 --in-reply-to Specify the first "In-Reply-To:" header line.
60 Only used if --compose is also set. If --compose is not
61 set, this will be prompted for.
63 --chain-reply-to If set, the replies will all be to the previous
64 email sent, rather than to the first email sent.
65 Defaults to on.
67 --signed-off-cc Automatically add email addresses that appear in
68 Signed-off-by: or Cc: lines to the cc: list. Defaults to on.
70 --smtp-server If set, specifies the outgoing SMTP server to use.
71 Defaults to localhost.
73 --suppress-from Suppress sending emails to yourself if your address
74 appears in a From: line. Defaults to off.
76 --thread Specify that the "In-Reply-To:" header should be set on all
77 emails. Defaults to on.
79 --quiet Make git-send-email less verbose. One line per email
80 should be all that is output.
82 --dry-run Do everything except actually send the emails.
84 --envelope-sender Specify the envelope sender used to send the emails.
86 EOT
87 exit(1);
90 # most mail servers generate the Date: header, but not all...
91 sub format_2822_time {
92 my ($time) = @_;
93 my @localtm = localtime($time);
94 my @gmttm = gmtime($time);
95 my $localmin = $localtm[1] + $localtm[2] * 60;
96 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
97 if ($localtm[0] != $gmttm[0]) {
98 die "local zone differs from GMT by a non-minute interval\n";
100 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
101 $localmin += 1440;
102 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
103 $localmin -= 1440;
104 } elsif ($gmttm[6] != $localtm[6]) {
105 die "local time offset greater than or equal to 24 hours\n";
107 my $offset = $localmin - $gmtmin;
108 my $offhour = $offset / 60;
109 my $offmin = abs($offset % 60);
110 if (abs($offhour) >= 24) {
111 die ("local time offset greater than or equal to 24 hours\n");
114 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
115 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
116 $localtm[3],
117 qw(Jan Feb Mar Apr May Jun
118 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
119 $localtm[5]+1900,
120 $localtm[2],
121 $localtm[1],
122 $localtm[0],
123 ($offset >= 0) ? '+' : '-',
124 abs($offhour),
125 $offmin,
129 my $have_email_valid = eval { require Email::Valid; 1 };
130 my $smtp;
132 sub unique_email_list(@);
133 sub cleanup_compose_files();
135 # Constants (essentially)
136 my $compose_filename = ".msg.$$";
138 # Variables we fill in automatically, or via prompting:
139 my (@to,@cc,@initial_cc,@bcclist,@xh,
140 $initial_reply_to,$initial_subject,@files,$from,$compose,$time);
142 my $smtp_server;
143 my $envelope_sender;
145 # Example reply to:
146 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
148 my $repo = Git->repository();
149 my $term = eval {
150 new Term::ReadLine 'git-send-email';
152 if ($@) {
153 $term = new FakeTerm "$@: going non-interactive";
156 # Behavior modification variables
157 my ($quiet, $dry_run) = (0, 0);
159 # Variables with corresponding config settings
160 my ($thread, $chain_reply_to, $suppress_from, $signed_off_cc);
162 my %config_settings = (
163 "thread" => [\$thread, 1],
164 "chainreplyto" => [\$chain_reply_to, 1],
165 "suppressfrom" => [\$suppress_from, 0],
166 "signedoffcc" => [\$signed_off_cc, 1],
169 foreach my $setting (keys %config_settings) {
170 my $config = $repo->config_bool("sendemail.$setting");
171 ${$config_settings{$setting}->[0]} = (defined $config) ? $config : $config_settings{$setting}->[1];
174 @bcclist = $repo->config('sendemail.bcc');
175 if (!@bcclist or !$bcclist[0]) {
176 @bcclist = ();
179 # Begin by accumulating all the variables (defined above), that we will end up
180 # needing, first, from the command line:
182 my $rc = GetOptions("from=s" => \$from,
183 "in-reply-to=s" => \$initial_reply_to,
184 "subject=s" => \$initial_subject,
185 "to=s" => \@to,
186 "cc=s" => \@initial_cc,
187 "bcc=s" => \@bcclist,
188 "chain-reply-to!" => \$chain_reply_to,
189 "smtp-server=s" => \$smtp_server,
190 "compose" => \$compose,
191 "quiet" => \$quiet,
192 "suppress-from!" => \$suppress_from,
193 "signed-off-cc|signed-off-by-cc!" => \$signed_off_cc,
194 "dry-run" => \$dry_run,
195 "envelope-sender=s" => \$envelope_sender,
196 "thread!" => \$thread,
199 unless ($rc) {
200 usage();
203 # Verify the user input
205 foreach my $entry (@to) {
206 die "Comma in --to entry: $entry'\n" unless $entry !~ m/,/;
209 foreach my $entry (@initial_cc) {
210 die "Comma in --cc entry: $entry'\n" unless $entry !~ m/,/;
213 foreach my $entry (@bcclist) {
214 die "Comma in --bcclist entry: $entry'\n" unless $entry !~ m/,/;
217 # Now, let's fill any that aren't set in with defaults:
219 my ($author) = $repo->ident_person('author');
220 my ($committer) = $repo->ident_person('committer');
222 my %aliases;
223 my @alias_files = $repo->config('sendemail.aliasesfile');
224 my $aliasfiletype = $repo->config('sendemail.aliasfiletype');
225 my %parse_alias = (
226 # multiline formats can be supported in the future
227 mutt => sub { my $fh = shift; while (<$fh>) {
228 if (/^\s*alias\s+(\S+)\s+(.*)$/) {
229 my ($alias, $addr) = ($1, $2);
230 $addr =~ s/#.*$//; # mutt allows # comments
231 # commas delimit multiple addresses
232 $aliases{$alias} = [ split(/\s*,\s*/, $addr) ];
233 }}},
234 mailrc => sub { my $fh = shift; while (<$fh>) {
235 if (/^alias\s+(\S+)\s+(.*)$/) {
236 # spaces delimit multiple addresses
237 $aliases{$1} = [ split(/\s+/, $2) ];
238 }}},
239 pine => sub { my $fh = shift; while (<$fh>) {
240 if (/^(\S+)\s+(.*)$/) {
241 $aliases{$1} = [ split(/\s*,\s*/, $2) ];
242 }}},
243 gnus => sub { my $fh = shift; while (<$fh>) {
244 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
245 $aliases{$1} = [ $2 ];
249 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
250 foreach my $file (@alias_files) {
251 open my $fh, '<', $file or die "opening $file: $!\n";
252 $parse_alias{$aliasfiletype}->($fh);
253 close $fh;
257 ($from) = expand_aliases($from) if defined $from;
259 my $prompting = 0;
260 if (!defined $from) {
261 $from = $author || $committer;
262 do {
263 $_ = $term->readline("Who should the emails appear to be from? [$from] ");
264 } while (!defined $_);
266 $from = $_ if ($_);
267 print "Emails will be sent from: ", $from, "\n";
268 $prompting++;
271 if (!@to) {
272 do {
273 $_ = $term->readline("Who should the emails be sent to? ",
274 "");
275 } while (!defined $_);
276 my $to = $_;
277 push @to, split /,/, $to;
278 $prompting++;
281 sub expand_aliases {
282 my @cur = @_;
283 my @last;
284 do {
285 @last = @cur;
286 @cur = map { $aliases{$_} ? @{$aliases{$_}} : $_ } @last;
287 } while (join(',',@cur) ne join(',',@last));
288 return @cur;
291 @to = expand_aliases(@to);
292 @to = (map { sanitize_address_rfc822($_) } @to);
293 @initial_cc = expand_aliases(@initial_cc);
294 @bcclist = expand_aliases(@bcclist);
296 if (!defined $initial_subject && $compose) {
297 do {
298 $_ = $term->readline("What subject should the emails start with? ",
299 $initial_subject);
300 } while (!defined $_);
301 $initial_subject = $_;
302 $prompting++;
305 if ($thread && !defined $initial_reply_to && $prompting) {
306 do {
307 $_= $term->readline("Message-ID to be used as In-Reply-To for the first email? ",
308 $initial_reply_to);
309 } while (!defined $_);
311 $initial_reply_to = $_;
312 $initial_reply_to =~ s/(^\s+|\s+$)//g;
315 if (!$smtp_server) {
316 $smtp_server = $repo->config('sendemail.smtpserver');
318 if (!$smtp_server) {
319 foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
320 if (-x $_) {
321 $smtp_server = $_;
322 last;
325 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
328 if ($compose) {
329 # Note that this does not need to be secure, but we will make a small
330 # effort to have it be unique
331 open(C,">",$compose_filename)
332 or die "Failed to open for writing $compose_filename: $!";
333 print C "From $from # This line is ignored.\n";
334 printf C "Subject: %s\n\n", $initial_subject;
335 printf C <<EOT;
336 GIT: Please enter your email below.
337 GIT: Lines beginning in "GIT: " will be removed.
338 GIT: Consider including an overall diffstat or table of contents
339 GIT: for the patch you are writing.
342 close(C);
344 my $editor = $ENV{EDITOR};
345 $editor = 'vi' unless defined $editor;
346 system($editor, $compose_filename);
348 open(C2,">",$compose_filename . ".final")
349 or die "Failed to open $compose_filename.final : " . $!;
351 open(C,"<",$compose_filename)
352 or die "Failed to open $compose_filename : " . $!;
354 while(<C>) {
355 next if m/^GIT: /;
356 print C2 $_;
358 close(C);
359 close(C2);
361 do {
362 $_ = $term->readline("Send this email? (y|n) ");
363 } while (!defined $_);
365 if (uc substr($_,0,1) ne 'Y') {
366 cleanup_compose_files();
367 exit(0);
370 @files = ($compose_filename . ".final");
374 # Now that all the defaults are set, process the rest of the command line
375 # arguments and collect up the files that need to be processed.
376 for my $f (@ARGV) {
377 if (-d $f) {
378 opendir(DH,$f)
379 or die "Failed to opendir $f: $!";
381 push @files, grep { -f $_ } map { +$f . "/" . $_ }
382 sort readdir(DH);
384 } elsif (-f $f) {
385 push @files, $f;
387 } else {
388 print STDERR "Skipping $f - not found.\n";
392 if (@files) {
393 unless ($quiet) {
394 print $_,"\n" for (@files);
396 } else {
397 print STDERR "\nNo patch files specified!\n\n";
398 usage();
401 # Variables we set as part of the loop over files
402 our ($message_id, %mail, $subject, $reply_to, $references, $message);
404 sub extract_valid_address {
405 my $address = shift;
406 my $local_part_regexp = '[^<>"\s@]+';
407 my $domain_regexp = '[^.<>"\s@]+(?:\.[^.<>"\s@]+)+';
409 # check for a local address:
410 return $address if ($address =~ /^($local_part_regexp)$/);
412 if ($have_email_valid) {
413 $address =~ s/^\s*<(.*)>\s*$/$1/;
414 return scalar Email::Valid->address($address);
415 } else {
416 # less robust/correct than the monster regexp in Email::Valid,
417 # but still does a 99% job, and one less dependency
418 $address =~ /($local_part_regexp\@$domain_regexp)/;
419 return $1;
423 # Usually don't need to change anything below here.
425 # we make a "fake" message id by taking the current number
426 # of seconds since the beginning of Unix time and tacking on
427 # a random number to the end, in case we are called quicker than
428 # 1 second since the last time we were called.
430 # We'll setup a template for the message id, using the "from" address:
432 sub make_message_id
434 my $date = time;
435 my $pseudo_rand = int (rand(4200));
436 my $du_part;
437 for ($from, $committer, $author) {
438 $du_part = extract_valid_address($_);
439 last if ($du_part ne '');
441 if ($du_part eq '') {
442 use Sys::Hostname qw();
443 $du_part = 'user@' . Sys::Hostname::hostname();
445 my $message_id_template = "<%s-git-send-email-$du_part>";
446 $message_id = sprintf $message_id_template, "$date$pseudo_rand";
447 #print "new message id = $message_id\n"; # Was useful for debugging
452 $time = time - scalar $#files;
454 sub unquote_rfc2047 {
455 local ($_) = @_;
456 if (s/=\?utf-8\?q\?(.*)\?=/$1/g) {
457 s/_/ /g;
458 s/=([0-9A-F]{2})/chr(hex($1))/eg;
460 return "$_";
463 # If an address contains a . in the name portion, the name must be quoted.
464 sub sanitize_address_rfc822
466 my ($recipient) = @_;
467 my ($recipient_name) = ($recipient =~ /^(.*?)\s+</);
468 if ($recipient_name && $recipient_name =~ /\./ && $recipient_name !~ /^".*"$/) {
469 my ($name, $addr) = ($recipient =~ /^(.*?)(\s+<.*)/);
470 $recipient = "\"$name\"$addr";
472 return $recipient;
475 sub send_message
477 my @recipients = unique_email_list(@to);
478 @cc = (map { sanitize_address_rfc822($_) } @cc);
479 my $to = join (",\n\t", @recipients);
480 @recipients = unique_email_list(@recipients,@cc,@bcclist);
481 @recipients = (map { extract_valid_address($_) } @recipients);
482 my $date = format_2822_time($time++);
483 my $gitversion = '@@GIT_VERSION@@';
484 if ($gitversion =~ m/..GIT_VERSION../) {
485 $gitversion = Git::version();
488 my $cc = join(", ", unique_email_list(@cc));
489 my $ccline = "";
490 if ($cc ne '') {
491 $ccline = "\nCc: $cc";
493 $from = sanitize_address_rfc822($from);
494 make_message_id();
496 my $header = "From: $from
497 To: $to${ccline}
498 Subject: $subject
499 Date: $date
500 Message-Id: $message_id
501 X-Mailer: git-send-email $gitversion
503 if ($thread && $reply_to) {
505 $header .= "In-Reply-To: $reply_to\n";
506 $header .= "References: $references\n";
508 if (@xh) {
509 $header .= join("\n", @xh) . "\n";
512 my @sendmail_parameters = ('-i', @recipients);
513 my $raw_from = $from;
514 $raw_from = $envelope_sender if (defined $envelope_sender);
515 $raw_from = extract_valid_address($raw_from);
516 unshift (@sendmail_parameters,
517 '-f', $raw_from) if(defined $envelope_sender);
519 if ($dry_run) {
520 # We don't want to send the email.
521 } elsif ($smtp_server =~ m#^/#) {
522 my $pid = open my $sm, '|-';
523 defined $pid or die $!;
524 if (!$pid) {
525 exec($smtp_server, @sendmail_parameters) or die $!;
527 print $sm "$header\n$message";
528 close $sm or die $?;
529 } else {
530 require Net::SMTP;
531 $smtp ||= Net::SMTP->new( $smtp_server );
532 $smtp->mail( $raw_from ) or die $smtp->message;
533 $smtp->to( @recipients ) or die $smtp->message;
534 $smtp->data or die $smtp->message;
535 $smtp->datasend("$header\n$message") or die $smtp->message;
536 $smtp->dataend() or die $smtp->message;
537 $smtp->ok or die "Failed to send $subject\n".$smtp->message;
539 if ($quiet) {
540 printf (($dry_run ? "Dry-" : "")."Sent %s\n", $subject);
541 } else {
542 print (($dry_run ? "Dry-" : "")."OK. Log says:\nDate: $date\n");
543 if ($smtp_server !~ m#^/#) {
544 print "Server: $smtp_server\n";
545 print "MAIL FROM:<$raw_from>\n";
546 print "RCPT TO:".join(',',(map { "<$_>" } @recipients))."\n";
547 } else {
548 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
550 print "From: $from\nSubject: $subject\nCc: $cc\nTo: $to\n\n";
551 if ($smtp) {
552 print "Result: ", $smtp->code, ' ',
553 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
554 } else {
555 print "Result: OK\n";
560 $reply_to = $initial_reply_to;
561 $references = $initial_reply_to || '';
562 $subject = $initial_subject;
564 foreach my $t (@files) {
565 open(F,"<",$t) or die "can't open file $t";
567 my $author_not_sender = undef;
568 @cc = @initial_cc;
569 @xh = ();
570 my $input_format = undef;
571 my $header_done = 0;
572 $message = "";
573 while(<F>) {
574 if (!$header_done) {
575 if (/^From /) {
576 $input_format = 'mbox';
577 next;
579 chomp;
580 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
581 $input_format = 'mbox';
584 if (defined $input_format && $input_format eq 'mbox') {
585 if (/^Subject:\s+(.*)$/) {
586 $subject = $1;
588 } elsif (/^(Cc|From):\s+(.*)$/) {
589 if (unquote_rfc2047($2) eq $from) {
590 $from = $2;
591 next if ($suppress_from);
593 elsif ($1 eq 'From') {
594 $author_not_sender = $2;
596 printf("(mbox) Adding cc: %s from line '%s'\n",
597 $2, $_) unless $quiet;
598 push @cc, $2;
600 elsif (!/^Date:\s/ && /^[-A-Za-z]+:\s+\S/) {
601 push @xh, $_;
604 } else {
605 # In the traditional
606 # "send lots of email" format,
607 # line 1 = cc
608 # line 2 = subject
609 # So let's support that, too.
610 $input_format = 'lots';
611 if (@cc == 0) {
612 printf("(non-mbox) Adding cc: %s from line '%s'\n",
613 $_, $_) unless $quiet;
615 push @cc, $_;
617 } elsif (!defined $subject) {
618 $subject = $_;
622 # A whitespace line will terminate the headers
623 if (m/^\s*$/) {
624 $header_done = 1;
626 } else {
627 $message .= $_;
628 if (/^(Signed-off-by|Cc): (.*)$/i && $signed_off_cc) {
629 my $c = $2;
630 chomp $c;
631 push @cc, $c;
632 printf("(sob) Adding cc: %s from line '%s'\n",
633 $c, $_) unless $quiet;
637 close F;
638 if (defined $author_not_sender) {
639 $author_not_sender = unquote_rfc2047($author_not_sender);
640 $message = "From: $author_not_sender\n\n$message";
644 send_message();
646 # set up for the next message
647 if ($chain_reply_to || !defined $reply_to || length($reply_to) == 0) {
648 $reply_to = $message_id;
649 if (length $references > 0) {
650 $references .= "\n $message_id";
651 } else {
652 $references = "$message_id";
657 if ($compose) {
658 cleanup_compose_files();
661 sub cleanup_compose_files() {
662 unlink($compose_filename, $compose_filename . ".final");
666 $smtp->quit if $smtp;
668 sub unique_email_list(@) {
669 my %seen;
670 my @emails;
672 foreach my $entry (@_) {
673 if (my $clean = extract_valid_address($entry)) {
674 $seen{$clean} ||= 0;
675 next if $seen{$clean}++;
676 push @emails, $entry;
677 } else {
678 print STDERR "W: unable to extract a valid address",
679 " from: $entry\n";
682 return @emails;