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