git.oblomov.eu Git - git/blob - 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 Text::ParseWords;
  24 use Data::Dumper;
  25 use Term::ANSIColor;
  26 use Git;
  27
  28 package FakeTerm;
  29 sub new {
  30         my ($class, $reason) = @_;
  31         return bless \$reason, shift;
  32 }
  33 sub readline {
  34         my $self = shift;
  35         die "Cannot use readline on FakeTerm: $$self";
  36 }
  37 package main;
  38
  39
  40 sub usage {
  41         print <<EOT;
  42 git send-email [options] <file | directory>...
  43 Options:
  44    --from         Specify the "From:" line of the email to be sent.
  45
  46    --to           Specify the primary "To:" line of the email.
  47
  48    --cc           Specify an initial "Cc:" list for the entire series
  49                   of emails.
  50
  51    --cc-cmd       Specify a command to execute per file which adds
  52                   per file specific cc address entries
  53
  54    --bcc          Specify a list of email addresses that should be Bcc:
  55                   on all the emails.
  56
  57    --compose      Use \$GIT_EDITOR, core.editor, \$EDITOR, or \$VISUAL to edit
  58                   an introductory message for the patch series.
  59
  60    --subject      Specify the initial "Subject:" line.
  61                   Only necessary if --compose is also set.  If --compose
  62                   is not set, this will be prompted for.
  63
  64    --in-reply-to  Specify the first "In-Reply-To:" header line.
  65                   Only used if --compose is also set.  If --compose is not
  66                   set, this will be prompted for.
  67
  68    --chain-reply-to If set, the replies will all be to the previous
  69                   email sent, rather than to the first email sent.
  70                   Defaults to on.
  71
  72    --signed-off-cc Automatically add email addresses that appear in
  73                  Signed-off-by: or Cc: lines to the cc: list. Defaults to on.
  74
  75    --identity     The configuration identity, a subsection to prioritise over
  76                   the default section.
  77
  78    --smtp-server  If set, specifies the outgoing SMTP server to use.
  79                   Defaults to localhost.  Port number can be specified here with
  80                   hostname:port format or by using --smtp-server-port option.
  81
  82    --smtp-server-port Specify a port on the outgoing SMTP server to connect to.
  83
  84    --smtp-user    The username for SMTP-AUTH.
  85
  86    --smtp-pass    The password for SMTP-AUTH.
  87
  88    --smtp-encryption Specify 'tls' for STARTTLS encryption, or 'ssl' for SSL.
  89                   Any other value disables the feature.
  90
  91    --smtp-ssl     Synonym for '--smtp-encryption=ssl'.  Deprecated.
  92
  93    --suppress-cc  Suppress the specified category of auto-CC.  The category
  94                   can be one of 'author' for the patch author, 'self' to
  95                   avoid copying yourself, 'sob' for Signed-off-by lines,
  96                   'cccmd' for the output of the cccmd, or 'all' to suppress
  97                   all of these.
  98
  99    --suppress-from Suppress sending emails to yourself. Defaults to off.
 100
 101    --thread       Specify that the "In-Reply-To:" header should be set on all
 102                   emails. Defaults to on.
 103
 104    --quiet        Make git-send-email less verbose.  One line per email
 105                   should be all that is output.
 106
 107    --dry-run      Do everything except actually send the emails.
 108
 109    --envelope-sender    Specify the envelope sender used to send the emails.
 110
 111    --no-validate        Don't perform any sanity checks on patches.
 112
 113 EOT
 114         exit(1);
 115 }
 116
 117 # most mail servers generate the Date: header, but not all...
 118 sub format_2822_time {
 119         my ($time) = @_;
 120         my @localtm = localtime($time);
 121         my @gmttm = gmtime($time);
 122         my $localmin = $localtm[1] + $localtm[2] * 60;
 123         my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
 124         if ($localtm[0] != $gmttm[0]) {
 125                 die "local zone differs from GMT by a non-minute interval\n";
 126         }
 127         if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
 128                 $localmin += 1440;
 129         } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
 130                 $localmin -= 1440;
 131         } elsif ($gmttm[6] != $localtm[6]) {
 132                 die "local time offset greater than or equal to 24 hours\n";
 133         }
 134         my $offset = $localmin - $gmtmin;
 135         my $offhour = $offset / 60;
 136         my $offmin = abs($offset % 60);
 137         if (abs($offhour) >= 24) {
 138                 die ("local time offset greater than or equal to 24 hours\n");
 139         }
 140
 141         return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
 142                        qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
 143                        $localtm[3],
 144                        qw(Jan Feb Mar Apr May Jun
 145                           Jul Aug Sep Oct Nov Dec)[$localtm[4]],
 146                        $localtm[5]+1900,
 147                        $localtm[2],
 148                        $localtm[1],
 149                        $localtm[0],
 150                        ($offset >= 0) ? '+' : '-',
 151                        abs($offhour),
 152                        $offmin,
 153                        );
 154 }
 155
 156 my $have_email_valid = eval { require Email::Valid; 1 };
 157 my $smtp;
 158 my $auth;
 159
 160 sub unique_email_list(@);
 161 sub cleanup_compose_files();
 162
 163 # Constants (essentially)
 164 my $compose_filename = ".msg.$$";
 165
 166 # Variables we fill in automatically, or via prompting:
 167 my (@to,@cc,@initial_cc,@bcclist,@xh,
 168         $initial_reply_to,$initial_subject,@files,$author,$sender,$smtp_authpass,$compose,$time);
 169
 170 my $envelope_sender;
 171
 172 # Example reply to:
 173 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
 174
 175 my $repo = eval { Git->repository() };
 176 my @repo = $repo ? ($repo) : ();
 177 my $term = eval {
 178         $ENV{"GIT_SEND_EMAIL_NOTTY"}
 179                 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
 180                 : new Term::ReadLine 'git-send-email';
 181 };
 182 if ($@) {
 183         $term = new FakeTerm "$@: going non-interactive";
 184 }
 185
 186 # Behavior modification variables
 187 my ($quiet, $dry_run) = (0, 0);
 188
 189 # Variables with corresponding config settings
 190 my ($thread, $chain_reply_to, $suppress_from, $signed_off_cc, $cc_cmd);
 191 my ($smtp_server, $smtp_server_port, $smtp_authuser, $smtp_encryption);
 192 my ($identity, $aliasfiletype, @alias_files, @smtp_host_parts);
 193 my ($no_validate);
 194 my (@suppress_cc);
 195
 196 my %config_bool_settings = (
 197     "thread" => [\$thread, 1],
 198     "chainreplyto" => [\$chain_reply_to, 1],
 199     "suppressfrom" => [\$suppress_from, undef],
 200     "signedoffcc" => [\$signed_off_cc, undef],
 201 );
 202
 203 my %config_settings = (
 204     "smtpserver" => \$smtp_server,
 205     "smtpserverport" => \$smtp_server_port,
 206     "smtpuser" => \$smtp_authuser,
 207     "smtppass" => \$smtp_authpass,
 208     "to" => \@to,
 209     "cc" => \@initial_cc,
 210     "cccmd" => \$cc_cmd,
 211     "aliasfiletype" => \$aliasfiletype,
 212     "bcc" => \@bcclist,
 213     "aliasesfile" => \@alias_files,
 214     "suppresscc" => \@suppress_cc,
 215     "envelopesender" => \$envelope_sender,
 216 );
 217
 218 # Handle Uncouth Termination
 219 sub signal_handler {
 220
 221         # Make text normal
 222         print color("reset"), "\n";
 223
 224         # SMTP password masked
 225         system "stty echo";
 226
 227         # tmp files from --compose
 228         if (-e $compose_filename) {
 229                 print "'$compose_filename' contains an intermediate version of the email you were composing.\n";
 230         }
 231         if (-e ($compose_filename . ".final")) {
 232                 print "'$compose_filename.final' contains the composed email.\n"
 233         }
 234
 235         exit;
 236 };
 237
 238 $SIG{TERM} = \&signal_handler;
 239 $SIG{INT}  = \&signal_handler;
 240
 241 # Begin by accumulating all the variables (defined above), that we will end up
 242 # needing, first, from the command line:
 243
 244 my $rc = GetOptions("sender|from=s" => \$sender,
 245                     "in-reply-to=s" => \$initial_reply_to,
 246                     "subject=s" => \$initial_subject,
 247                     "to=s" => \@to,
 248                     "cc=s" => \@initial_cc,
 249                     "bcc=s" => \@bcclist,
 250                     "chain-reply-to!" => \$chain_reply_to,
 251                     "smtp-server=s" => \$smtp_server,
 252                     "smtp-server-port=s" => \$smtp_server_port,
 253                     "smtp-user=s" => \$smtp_authuser,
 254                     "smtp-pass:s" => \$smtp_authpass,
 255                     "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
 256                     "smtp-encryption=s" => \$smtp_encryption,
 257                     "identity=s" => \$identity,
 258                     "compose" => \$compose,
 259                     "quiet" => \$quiet,
 260                     "cc-cmd=s" => \$cc_cmd,
 261                     "suppress-from!" => \$suppress_from,
 262                     "suppress-cc=s" => \@suppress_cc,
 263                     "signed-off-cc|signed-off-by-cc!" => \$signed_off_cc,
 264                     "dry-run" => \$dry_run,
 265                     "envelope-sender=s" => \$envelope_sender,
 266                     "thread!" => \$thread,
 267                     "no-validate" => \$no_validate,
 268          );
 269
 270 unless ($rc) {
 271     usage();
 272 }
 273
 274 # Now, let's fill any that aren't set in with defaults:
 275
 276 sub read_config {
 277         my ($prefix) = @_;
 278
 279         foreach my $setting (keys %config_bool_settings) {
 280                 my $target = $config_bool_settings{$setting}->[0];
 281                 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
 282         }
 283
 284         foreach my $setting (keys %config_settings) {
 285                 my $target = $config_settings{$setting};
 286                 if (ref($target) eq "ARRAY") {
 287                         unless (@$target) {
 288                                 my @values = Git::config(@repo, "$prefix.$setting");
 289                                 @$target = @values if (@values && defined $values[0]);
 290                         }
 291                 }
 292                 else {
 293                         $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
 294                 }
 295         }
 296
 297         if (!defined $smtp_encryption) {
 298                 my $enc = Git::config(@repo, "$prefix.smtpencryption");
 299                 if (defined $enc) {
 300                         $smtp_encryption = $enc;
 301                 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
 302                         $smtp_encryption = 'ssl';
 303                 }
 304         }
 305 }
 306
 307 # read configuration from [sendemail "$identity"], fall back on [sendemail]
 308 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
 309 read_config("sendemail.$identity") if (defined $identity);
 310 read_config("sendemail");
 311
 312 # fall back on builtin bool defaults
 313 foreach my $setting (values %config_bool_settings) {
 314         ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
 315 }
 316
 317 # 'default' encryption is none -- this only prevents a warning
 318 $smtp_encryption = '' unless (defined $smtp_encryption);
 319
 320 # Set CC suppressions
 321 my(%suppress_cc);
 322 if (@suppress_cc) {
 323         foreach my $entry (@suppress_cc) {
 324                 die "Unknown --suppress-cc field: '$entry'\n"
 325                         unless $entry =~ /^(all|cccmd|cc|author|self|sob)$/;
 326                 $suppress_cc{$entry} = 1;
 327         }
 328 }
 329
 330 if ($suppress_cc{'all'}) {
 331         foreach my $entry (qw (ccmd cc author self sob)) {
 332                 $suppress_cc{$entry} = 1;
 333         }
 334         delete $suppress_cc{'all'};
 335 }
 336
 337 # If explicit old-style ones are specified, they trump --suppress-cc.
 338 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
 339 $suppress_cc{'sob'} = !$signed_off_cc if defined $signed_off_cc;
 340
 341 # Debugging, print out the suppressions.
 342 if (0) {
 343         print "suppressions:\n";
 344         foreach my $entry (keys %suppress_cc) {
 345                 printf "  %-5s -> $suppress_cc{$entry}\n", $entry;
 346         }
 347 }
 348
 349 my ($repoauthor, $repocommitter);
 350 ($repoauthor) = Git::ident_person(@repo, 'author');
 351 ($repocommitter) = Git::ident_person(@repo, 'committer');
 352
 353 # Verify the user input
 354
 355 foreach my $entry (@to) {
 356         die "Comma in --to entry: $entry'\n" unless $entry !~ m/,/;
 357 }
 358
 359 foreach my $entry (@initial_cc) {
 360         die "Comma in --cc entry: $entry'\n" unless $entry !~ m/,/;
 361 }
 362
 363 foreach my $entry (@bcclist) {
 364         die "Comma in --bcclist entry: $entry'\n" unless $entry !~ m/,/;
 365 }
 366
 367 sub split_addrs {
 368         return parse_line('\s*,\s*', 1, @_);
 369 }
 370
 371 my %aliases;
 372 my %parse_alias = (
 373         # multiline formats can be supported in the future
 374         mutt => sub { my $fh = shift; while (<$fh>) {
 375                 if (/^\s*alias\s+(\S+)\s+(.*)$/) {
 376                         my ($alias, $addr) = ($1, $2);
 377                         $addr =~ s/#.*$//; # mutt allows # comments
 378                          # commas delimit multiple addresses
 379                         $aliases{$alias} = [ split_addrs($addr) ];
 380                 }}},
 381         mailrc => sub { my $fh = shift; while (<$fh>) {
 382                 if (/^alias\s+(\S+)\s+(.*)$/) {
 383                         # spaces delimit multiple addresses
 384                         $aliases{$1} = [ split(/\s+/, $2) ];
 385                 }}},
 386         pine => sub { my $fh = shift; while (<$fh>) {
 387                 if (/^(\S+)\t.*\t(.*)$/) {
 388                         $aliases{$1} = [ split_addrs($2) ];
 389                 }}},
 390         gnus => sub { my $fh = shift; while (<$fh>) {
 391                 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
 392                         $aliases{$1} = [ $2 ];
 393                 }}}
 394 );
 395
 396 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
 397         foreach my $file (@alias_files) {
 398                 open my $fh, '<', $file or die "opening $file: $!\n";
 399                 $parse_alias{$aliasfiletype}->($fh);
 400                 close $fh;
 401         }
 402 }
 403
 404 ($sender) = expand_aliases($sender) if defined $sender;
 405
 406 # Now that all the defaults are set, process the rest of the command line
 407 # arguments and collect up the files that need to be processed.
 408 for my $f (@ARGV) {
 409         if (-d $f) {
 410                 opendir(DH,$f)
 411                         or die "Failed to opendir $f: $!";
 412
 413                 push @files, grep { -f $_ } map { +$f . "/" . $_ }
 414                                 sort readdir(DH);
 415                 closedir(DH);
 416         } elsif (-f $f or -p $f) {
 417                 push @files, $f;
 418         } else {
 419                 print STDERR "Skipping $f - not found.\n";
 420         }
 421 }
 422
 423 if (!$no_validate) {
 424         foreach my $f (@files) {
 425                 unless (-p $f) {
 426                         my $error = validate_patch($f);
 427                         $error and die "fatal: $f: $error\nwarning: no patches were sent\n";
 428                 }
 429         }
 430 }
 431
 432 if (@files) {
 433         unless ($quiet) {
 434                 print $_,"\n" for (@files);
 435         }
 436 } else {
 437         print STDERR "\nNo patch files specified!\n\n";
 438         usage();
 439 }
 440
 441 my $prompting = 0;
 442 if (!defined $sender) {
 443         $sender = $repoauthor || $repocommitter || '';
 444
 445         while (1) {
 446                 $_ = $term->readline("Who should the emails appear to be from? [$sender] ");
 447                 last if defined $_;
 448                 print "\n";
 449         }
 450
 451         $sender = $_ if ($_);
 452         print "Emails will be sent from: ", $sender, "\n";
 453         $prompting++;
 454 }
 455
 456 if (!@to) {
 457
 458
 459         while (1) {
 460                 $_ = $term->readline("Who should the emails be sent to? ", "");
 461                 last if defined $_;
 462                 print "\n";
 463         }
 464
 465         my $to = $_;
 466         push @to, split_addrs($to);
 467         $prompting++;
 468 }
 469
 470 sub expand_aliases {
 471         my @cur = @_;
 472         my @last;
 473         do {
 474                 @last = @cur;
 475                 @cur = map { $aliases{$_} ? @{$aliases{$_}} : $_ } @last;
 476         } while (join(',',@cur) ne join(',',@last));
 477         return @cur;
 478 }
 479
 480 @to = expand_aliases(@to);
 481 @to = (map { sanitize_address($_) } @to);
 482 @initial_cc = expand_aliases(@initial_cc);
 483 @bcclist = expand_aliases(@bcclist);
 484
 485 if (!defined $initial_subject && $compose) {
 486         while (1) {
 487                 $_ = $term->readline("What subject should the initial email start with? ", $initial_subject);
 488                 last if defined $_;
 489                 print "\n";
 490         }
 491
 492         $initial_subject = $_;
 493         $prompting++;
 494 }
 495
 496 if ($thread && !defined $initial_reply_to && $prompting) {
 497         while (1) {
 498                 $_= $term->readline("Message-ID to be used as In-Reply-To for the first email? ", $initial_reply_to);
 499                 last if defined $_;
 500                 print "\n";
 501         }
 502
 503         $initial_reply_to = $_;
 504 }
 505 if (defined $initial_reply_to) {
 506         $initial_reply_to =~ s/^\s*<?//;
 507         $initial_reply_to =~ s/>?\s*$//;
 508         $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
 509 }
 510
 511 if (!defined $smtp_server) {
 512         foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
 513                 if (-x $_) {
 514                         $smtp_server = $_;
 515                         last;
 516                 }
 517         }
 518         $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
 519 }
 520
 521 if ($compose) {
 522         # Note that this does not need to be secure, but we will make a small
 523         # effort to have it be unique
 524         open(C,">",$compose_filename)
 525                 or die "Failed to open for writing $compose_filename: $!";
 526         print C "From $sender # This line is ignored.\n";
 527         printf C "Subject: %s\n\n", $initial_subject;
 528         printf C <<EOT;
 529 GIT: Please enter your email below.
 530 GIT: Lines beginning in "GIT: " will be removed.
 531 GIT: Consider including an overall diffstat or table of contents
 532 GIT: for the patch you are writing.
 533
 534 EOT
 535         close(C);
 536
 537         my $editor = $ENV{GIT_EDITOR} || Git::config(@repo, "core.editor") || $ENV{VISUAL} || $ENV{EDITOR} || "vi";
 538         system('sh', '-c', $editor.' "$@"', $editor, $compose_filename);
 539
 540         open(C2,">",$compose_filename . ".final")
 541                 or die "Failed to open $compose_filename.final : " . $!;
 542
 543         open(C,"<",$compose_filename)
 544                 or die "Failed to open $compose_filename : " . $!;
 545
 546         my $need_8bit_cte = file_has_nonascii($compose_filename);
 547         my $in_body = 0;
 548         while(<C>) {
 549                 next if m/^GIT: /;
 550                 if (!$in_body && /^\n$/) {
 551                         $in_body = 1;
 552                         if ($need_8bit_cte) {
 553                                 print C2 "MIME-Version: 1.0\n",
 554                                          "Content-Type: text/plain; ",
 555                                            "charset=utf-8\n",
 556                                          "Content-Transfer-Encoding: 8bit\n";
 557                         }
 558                 }
 559                 if (!$in_body && /^MIME-Version:/i) {
 560                         $need_8bit_cte = 0;
 561                 }
 562                 if (!$in_body && /^Subject: ?(.*)/i) {
 563                         my $subject = $1;
 564                         $_ = "Subject: " .
 565                                 ($subject =~ /[^[:ascii:]]/ ?
 566                                  quote_rfc2047($subject) :
 567                                  $subject) .
 568                                 "\n";
 569                 }
 570                 print C2 $_;
 571         }
 572         close(C);
 573         close(C2);
 574
 575         while (1) {
 576                 $_ = $term->readline("Send this email? (y|n) ");
 577                 last if defined $_;
 578                 print "\n";
 579         }
 580
 581         if (uc substr($_,0,1) ne 'Y') {
 582                 cleanup_compose_files();
 583                 exit(0);
 584         }
 585
 586         @files = ($compose_filename . ".final", @files);
 587 }
 588
 589 # Variables we set as part of the loop over files
 590 our ($message_id, %mail, $subject, $reply_to, $references, $message);
 591
 592 sub extract_valid_address {
 593         my $address = shift;
 594         my $local_part_regexp = '[^<>"\s@]+';
 595         my $domain_regexp = '[^.<>"\s@]+(?:\.[^.<>"\s@]+)+';
 596
 597         # check for a local address:
 598         return $address if ($address =~ /^($local_part_regexp)$/);
 599
 600         $address =~ s/^\s*<(.*)>\s*$/$1/;
 601         if ($have_email_valid) {
 602                 return scalar Email::Valid->address($address);
 603         } else {
 604                 # less robust/correct than the monster regexp in Email::Valid,
 605                 # but still does a 99% job, and one less dependency
 606                 $address =~ /($local_part_regexp\@$domain_regexp)/;
 607                 return $1;
 608         }
 609 }
 610
 611 # Usually don't need to change anything below here.
 612
 613 # we make a "fake" message id by taking the current number
 614 # of seconds since the beginning of Unix time and tacking on
 615 # a random number to the end, in case we are called quicker than
 616 # 1 second since the last time we were called.
 617
 618 # We'll setup a template for the message id, using the "from" address:
 619
 620 my ($message_id_stamp, $message_id_serial);
 621 sub make_message_id
 622 {
 623         my $uniq;
 624         if (!defined $message_id_stamp) {
 625                 $message_id_stamp = sprintf("%s-%s", time, $$);
 626                 $message_id_serial = 0;
 627         }
 628         $message_id_serial++;
 629         $uniq = "$message_id_stamp-$message_id_serial";
 630
 631         my $du_part;
 632         for ($sender, $repocommitter, $repoauthor) {
 633                 $du_part = extract_valid_address(sanitize_address($_));
 634                 last if (defined $du_part and $du_part ne '');
 635         }
 636         if (not defined $du_part or $du_part eq '') {
 637                 use Sys::Hostname qw();
 638                 $du_part = 'user@' . Sys::Hostname::hostname();
 639         }
 640         my $message_id_template = "<%s-git-send-email-%s>";
 641         $message_id = sprintf($message_id_template, $uniq, $du_part);
 642         #print "new message id = $message_id\n"; # Was useful for debugging
 643 }
 644
 645
 646
 647 $time = time - scalar $#files;
 648
 649 sub unquote_rfc2047 {
 650         local ($_) = @_;
 651         my $encoding;
 652         if (s/=\?([^?]+)\?q\?(.*)\?=/$2/g) {
 653                 $encoding = $1;
 654                 s/_/ /g;
 655                 s/=([0-9A-F]{2})/chr(hex($1))/eg;
 656         }
 657         return wantarray ? ($_, $encoding) : $_;
 658 }
 659
 660 sub quote_rfc2047 {
 661         local $_ = shift;
 662         my $encoding = shift || 'utf-8';
 663         s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
 664         s/(.*)/=\?$encoding\?q\?$1\?=/;
 665         return $_;
 666 }
 667
 668 # use the simplest quoting being able to handle the recipient
 669 sub sanitize_address
 670 {
 671         my ($recipient) = @_;
 672         my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
 673
 674         if (not $recipient_name) {
 675                 return "$recipient";
 676         }
 677
 678         # if recipient_name is already quoted, do nothing
 679         if ($recipient_name =~ /^(".*"|=\?utf-8\?q\?.*\?=)$/) {
 680                 return $recipient;
 681         }
 682
 683         # rfc2047 is needed if a non-ascii char is included
 684         if ($recipient_name =~ /[^[:ascii:]]/) {
 685                 $recipient_name = quote_rfc2047($recipient_name);
 686         }
 687
 688         # double quotes are needed if specials or CTLs are included
 689         elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
 690                 $recipient_name =~ s/(["\\\r])/\\$1/g;
 691                 $recipient_name = "\"$recipient_name\"";
 692         }
 693
 694         return "$recipient_name $recipient_addr";
 695
 696 }
 697
 698 sub send_message
 699 {
 700         my @recipients = unique_email_list(@to);
 701         @cc = (grep { my $cc = extract_valid_address($_);
 702                       not grep { $cc eq $_ } @recipients
 703                     }
 704                map { sanitize_address($_) }
 705                @cc);
 706         my $to = join (",\n\t", @recipients);
 707         @recipients = unique_email_list(@recipients,@cc,@bcclist);
 708         @recipients = (map { extract_valid_address($_) } @recipients);
 709         my $date = format_2822_time($time++);
 710         my $gitversion = '@@GIT_VERSION@@';
 711         if ($gitversion =~ m/..GIT_VERSION../) {
 712             $gitversion = Git::version();
 713         }
 714
 715         my $cc = join(", ", unique_email_list(@cc));
 716         my $ccline = "";
 717         if ($cc ne '') {
 718                 $ccline = "\nCc: $cc";
 719         }
 720         my $sanitized_sender = sanitize_address($sender);
 721         make_message_id() unless defined($message_id);
 722
 723         my $header = "From: $sanitized_sender
 724 To: $to${ccline}
 725 Subject: $subject
 726 Date: $date
 727 Message-Id: $message_id
 728 X-Mailer: git-send-email $gitversion
 729 ";
 730         if ($thread && $reply_to) {
 731
 732                 $header .= "In-Reply-To: $reply_to\n";
 733                 $header .= "References: $references\n";
 734         }
 735         if (@xh) {
 736                 $header .= join("\n", @xh) . "\n";
 737         }
 738
 739         my @sendmail_parameters = ('-i', @recipients);
 740         my $raw_from = $sanitized_sender;
 741         $raw_from = $envelope_sender if (defined $envelope_sender);
 742         $raw_from = extract_valid_address($raw_from);
 743         unshift (@sendmail_parameters,
 744                         '-f', $raw_from) if(defined $envelope_sender);
 745
 746         if ($dry_run) {
 747                 # We don't want to send the email.
 748         } elsif ($smtp_server =~ m#^/#) {
 749                 my $pid = open my $sm, '|-';
 750                 defined $pid or die $!;
 751                 if (!$pid) {
 752                         exec($smtp_server, @sendmail_parameters) or die $!;
 753                 }
 754                 print $sm "$header\n$message";
 755                 close $sm or die $?;
 756         } else {
 757
 758                 if (!defined $smtp_server) {
 759                         die "The required SMTP server is not properly defined."
 760                 }
 761
 762                 if ($smtp_encryption eq 'ssl') {
 763                         $smtp_server_port ||= 465; # ssmtp
 764                         require Net::SMTP::SSL;
 765                         $smtp ||= Net::SMTP::SSL->new($smtp_server, Port => $smtp_server_port);
 766                 }
 767                 else {
 768                         require Net::SMTP;
 769                         $smtp ||= Net::SMTP->new((defined $smtp_server_port)
 770                                                  ? "$smtp_server:$smtp_server_port"
 771                                                  : $smtp_server);
 772                         if ($smtp_encryption eq 'tls') {
 773                                 require Net::SMTP::SSL;
 774                                 $smtp->command('STARTTLS');
 775                                 $smtp->response();
 776                                 if ($smtp->code == 220) {
 777                                         $smtp = Net::SMTP::SSL->start_SSL($smtp)
 778                                                 or die "STARTTLS failed! ".$smtp->message;
 779                                         $smtp_encryption = '';
 780                                         # Send EHLO again to receive fresh
 781                                         # supported commands
 782                                         $smtp->hello();
 783                                 } else {
 784                                         die "Server does not support STARTTLS! ".$smtp->message;
 785                                 }
 786                         }
 787                 }
 788
 789                 if (!$smtp) {
 790                         die "Unable to initialize SMTP properly.  Is there something wrong with your config?";
 791                 }
 792
 793                 if (defined $smtp_authuser) {
 794
 795                         if (!defined $smtp_authpass) {
 796
 797                                 system "stty -echo";
 798
 799                                 do {
 800                                         print "Password: ";
 801                                         $_ = <STDIN>;
 802                                         print "\n";
 803                                 } while (!defined $_);
 804
 805                                 chomp($smtp_authpass = $_);
 806
 807                                 system "stty echo";
 808                         }
 809
 810                         $auth ||= $smtp->auth( $smtp_authuser, $smtp_authpass ) or die $smtp->message;
 811                 }
 812
 813                 $smtp->mail( $raw_from ) or die $smtp->message;
 814                 $smtp->to( @recipients ) or die $smtp->message;
 815                 $smtp->data or die $smtp->message;
 816                 $smtp->datasend("$header\n$message") or die $smtp->message;
 817                 $smtp->dataend() or die $smtp->message;
 818                 $smtp->ok or die "Failed to send $subject\n".$smtp->message;
 819         }
 820         if ($quiet) {
 821                 printf (($dry_run ? "Dry-" : "")."Sent %s\n", $subject);
 822         } else {
 823                 print (($dry_run ? "Dry-" : "")."OK. Log says:\n");
 824                 if ($smtp_server !~ m#^/#) {
 825                         print "Server: $smtp_server\n";
 826                         print "MAIL FROM:<$raw_from>\n";
 827                         print "RCPT TO:".join(',',(map { "<$_>" } @recipients))."\n";
 828                 } else {
 829                         print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
 830                 }
 831                 print $header, "\n";
 832                 if ($smtp) {
 833                         print "Result: ", $smtp->code, ' ',
 834                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
 835                 } else {
 836                         print "Result: OK\n";
 837                 }
 838         }
 839 }
 840
 841 $reply_to = $initial_reply_to;
 842 $references = $initial_reply_to || '';
 843 $subject = $initial_subject;
 844
 845 foreach my $t (@files) {
 846         open(F,"<",$t) or die "can't open file $t";
 847
 848         my $author = undef;
 849         my $author_encoding;
 850         my $has_content_type;
 851         my $body_encoding;
 852         @cc = @initial_cc;
 853         @xh = ();
 854         my $input_format = undef;
 855         my $header_done = 0;
 856         $message = "";
 857         while(<F>) {
 858                 if (!$header_done) {
 859                         if (/^From /) {
 860                                 $input_format = 'mbox';
 861                                 next;
 862                         }
 863                         chomp;
 864                         if (!defined $input_format && /^[-A-Za-z]+:\s/) {
 865                                 $input_format = 'mbox';
 866                         }
 867
 868                         if (defined $input_format && $input_format eq 'mbox') {
 869                                 if (/^Subject:\s+(.*)$/) {
 870                                         $subject = $1;
 871
 872                                 } elsif (/^(Cc|From):\s+(.*)$/) {
 873                                         if (unquote_rfc2047($2) eq $sender) {
 874                                                 next if ($suppress_cc{'self'});
 875                                         }
 876                                         elsif ($1 eq 'From') {
 877                                                 ($author, $author_encoding)
 878                                                   = unquote_rfc2047($2);
 879                                                 next if ($suppress_cc{'author'});
 880                                         } else {
 881                                                 next if ($suppress_cc{'cc'});
 882                                         }
 883                                         printf("(mbox) Adding cc: %s from line '%s'\n",
 884                                                 $2, $_) unless $quiet;
 885                                         push @cc, $2;
 886                                 }
 887                                 elsif (/^Content-type:/i) {
 888                                         $has_content_type = 1;
 889                                         if (/charset="?([^ "]+)/) {
 890                                                 $body_encoding = $1;
 891                                         }
 892                                         push @xh, $_;
 893                                 }
 894                                 elsif (/^Message-Id: (.*)/i) {
 895                                         $message_id = $1;
 896                                 }
 897                                 elsif (!/^Date:\s/ && /^[-A-Za-z]+:\s+\S/) {
 898                                         push @xh, $_;
 899                                 }
 900
 901                         } else {
 902                                 # In the traditional
 903                                 # "send lots of email" format,
 904                                 # line 1 = cc
 905                                 # line 2 = subject
 906                                 # So let's support that, too.
 907                                 $input_format = 'lots';
 908                                 if (@cc == 0 && !$suppress_cc{'cc'}) {
 909                                         printf("(non-mbox) Adding cc: %s from line '%s'\n",
 910                                                 $_, $_) unless $quiet;
 911
 912                                         push @cc, $_;
 913
 914                                 } elsif (!defined $subject) {
 915                                         $subject = $_;
 916                                 }
 917                         }
 918
 919                         # A whitespace line will terminate the headers
 920                         if (m/^\s*$/) {
 921                                 $header_done = 1;
 922                         }
 923                 } else {
 924                         $message .=  $_;
 925                         if (/^(Signed-off-by|Cc): (.*)$/i) {
 926                                 next if ($suppress_cc{'sob'});
 927                                 chomp;
 928                                 my $c = $2;
 929                                 chomp $c;
 930                                 next if ($c eq $sender and $suppress_cc{'self'});
 931                                 push @cc, $c;
 932                                 printf("(sob) Adding cc: %s from line '%s'\n",
 933                                         $c, $_) unless $quiet;
 934                         }
 935                 }
 936         }
 937         close F;
 938
 939         if (defined $cc_cmd && !$suppress_cc{'cccmd'}) {
 940                 open(F, "$cc_cmd $t |")
 941                         or die "(cc-cmd) Could not execute '$cc_cmd'";
 942                 while(<F>) {
 943                         my $c = $_;
 944                         $c =~ s/^\s*//g;
 945                         $c =~ s/\n$//g;
 946                         next if ($c eq $sender and $suppress_from);
 947                         push @cc, $c;
 948                         printf("(cc-cmd) Adding cc: %s from: '%s'\n",
 949                                 $c, $cc_cmd) unless $quiet;
 950                 }
 951                 close F
 952                         or die "(cc-cmd) failed to close pipe to '$cc_cmd'";
 953         }
 954
 955         if (defined $author) {
 956                 $message = "From: $author\n\n$message";
 957                 if (defined $author_encoding) {
 958                         if ($has_content_type) {
 959                                 if ($body_encoding eq $author_encoding) {
 960                                         # ok, we already have the right encoding
 961                                 }
 962                                 else {
 963                                         # uh oh, we should re-encode
 964                                 }
 965                         }
 966                         else {
 967                                 push @xh,
 968                                   'MIME-Version: 1.0',
 969                                   "Content-Type: text/plain; charset=$author_encoding",
 970                                   'Content-Transfer-Encoding: 8bit';
 971                         }
 972                 }
 973         }
 974
 975         send_message();
 976
 977         # set up for the next message
 978         if ($chain_reply_to || !defined $reply_to || length($reply_to) == 0) {
 979                 $reply_to = $message_id;
 980                 if (length $references > 0) {
 981                         $references .= "\n $message_id";
 982                 } else {
 983                         $references = "$message_id";
 984                 }
 985         }
 986         $message_id = undef;
 987 }
 988
 989 if ($compose) {
 990         cleanup_compose_files();
 991 }
 992
 993 sub cleanup_compose_files() {
 994         unlink($compose_filename, $compose_filename . ".final");
 995
 996 }
 997
 998 $smtp->quit if $smtp;
 999
1000 sub unique_email_list(@) {
1001         my %seen;
1002         my @emails;
1003
1004         foreach my $entry (@_) {
1005                 if (my $clean = extract_valid_address($entry)) {
1006                         $seen{$clean} ||= 0;
1007                         next if $seen{$clean}++;
1008                         push @emails, $entry;
1009                 } else {
1010                         print STDERR "W: unable to extract a valid address",
1011                                         " from: $entry\n";
1012                 }
1013         }
1014         return @emails;
1015 }
1016
1017 sub validate_patch {
1018         my $fn = shift;
1019         open(my $fh, '<', $fn)
1020                 or die "unable to open $fn: $!\n";
1021         while (my $line = <$fh>) {
1022                 if (length($line) > 998) {
1023                         return "$.: patch contains a line longer than 998 characters";
1024                 }
1025         }
1026         return undef;
1027 }
1028
1029 sub file_has_nonascii {
1030         my $fn = shift;
1031         open(my $fh, '<', $fn)
1032                 or die "unable to open $fn: $!\n";
1033         while (my $line = <$fh>) {
1034                 return 1 if $line =~ /[^[:ascii:]]/;
1035         }
1036         return 0;
1037 }