git-send-email.perl

   1 #!/usr/bin/perl
   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 5.008;
  20 use strict;
  21 use warnings;
  22 use POSIX qw/strftime/;
  23 use Term::ReadLine;
  24 use Getopt::Long;
  25 use Text::ParseWords;
  26 use Term::ANSIColor;
  27 use File::Temp qw/ tempdir tempfile /;
  28 use File::Spec::Functions qw(catfile);
  29 use Error qw(:try);
  30 use Git;
  31 use Git::I18N;
  32
  33 Getopt::Long::Configure qw/ pass_through /;
  34
  35 package FakeTerm;
  36 sub new {
  37         my ($class, $reason) = @_;
  38         return bless \$reason, shift;
  39 }
  40 sub readline {
  41         my $self = shift;
  42         die "Cannot use readline on FakeTerm: $$self";
  43 }
  44 package main;
  45
  46
  47 sub usage {
  48         print <<EOT;
  49 git send-email [options] <file | directory | rev-list options >
  50 git send-email --dump-aliases
  51
  52   Composing:
  53     --from                  <str>  * Email From:
  54     --[no-]to               <str>  * Email To:
  55     --[no-]cc               <str>  * Email Cc:
  56     --[no-]bcc              <str>  * Email Bcc:
  57     --subject               <str>  * Email "Subject:"
  58     --in-reply-to           <str>  * Email "In-Reply-To:"
  59     --[no-]xmailer                 * Add "X-Mailer:" header (default).
  60     --[no-]annotate                * Review each patch that will be sent in an editor.
  61     --compose                      * Open an editor for introduction.
  62     --compose-encoding      <str>  * Encoding to assume for introduction.
  63     --8bit-encoding         <str>  * Encoding to assume 8bit mails if undeclared
  64     --transfer-encoding     <str>  * Transfer encoding to use (quoted-printable, 8bit, base64)
  65
  66   Sending:
  67     --envelope-sender       <str>  * Email envelope sender.
  68     --smtp-server       <str:int>  * Outgoing SMTP server to use. The port
  69                                      is optional. Default 'localhost'.
  70     --smtp-server-option    <str>  * Outgoing SMTP server option to use.
  71     --smtp-server-port      <int>  * Outgoing SMTP server port.
  72     --smtp-user             <str>  * Username for SMTP-AUTH.
  73     --smtp-pass             <str>  * Password for SMTP-AUTH; not necessary.
  74     --smtp-encryption       <str>  * tls or ssl; anything else disables.
  75     --smtp-ssl                     * Deprecated. Use '--smtp-encryption ssl'.
  76     --smtp-ssl-cert-path    <str>  * Path to ca-certificates (either directory or file).
  77                                      Pass an empty string to disable certificate
  78                                      verification.
  79     --smtp-domain           <str>  * The domain name sent to HELO/EHLO handshake
  80     --smtp-auth             <str>  * Space-separated list of allowed AUTH mechanisms.
  81                                      This setting forces to use one of the listed mechanisms.
  82     --smtp-debug            <0|1>  * Disable, enable Net::SMTP debug.
  83
  84     --batch-size            <int>  * send max <int> message per connection.
  85     --relogin-delay         <int>  * delay <int> seconds between two successive login.
  86                                      This option can only be used with --batch-size
  87
  88   Automating:
  89     --identity              <str>  * Use the sendemail.<id> options.
  90     --to-cmd                <str>  * Email To: via `<str> \$patch_path`
  91     --cc-cmd                <str>  * Email Cc: via `<str> \$patch_path`
  92     --suppress-cc           <str>  * author, self, sob, cc, cccmd, body, bodycc, all.
  93     --[no-]cc-cover                * Email Cc: addresses in the cover letter.
  94     --[no-]to-cover                * Email To: addresses in the cover letter.
  95     --[no-]signed-off-by-cc        * Send to Signed-off-by: addresses. Default on.
  96     --[no-]suppress-from           * Send to self. Default off.
  97     --[no-]chain-reply-to          * Chain In-Reply-To: fields. Default off.
  98     --[no-]thread                  * Use In-Reply-To: field. Default on.
  99
 100   Administering:
 101     --confirm               <str>  * Confirm recipients before sending;
 102                                      auto, cc, compose, always, or never.
 103     --quiet                        * Output one line of info per email.
 104     --dry-run                      * Don't actually send the emails.
 105     --[no-]validate                * Perform patch sanity checks. Default on.
 106     --[no-]format-patch            * understand any non optional arguments as
 107                                      `git format-patch` ones.
 108     --force                        * Send even if safety checks would prevent it.
 109
 110   Information:
 111     --dump-aliases                 * Dump configured aliases and exit.
 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 $have_mail_address = eval { require Mail::Address; 1 };
 158 my $smtp;
 159 my $auth;
 160 my $num_sent = 0;
 161
 162 # Regexes for RFC 2047 productions.
 163 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
 164 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
 165 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
 166
 167 # Variables we fill in automatically, or via prompting:
 168 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
 169         $initial_reply_to,$initial_subject,@files,
 170         $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
 171
 172 my $envelope_sender;
 173
 174 # Example reply to:
 175 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
 176
 177 my $repo = eval { Git->repository() };
 178 my @repo = $repo ? ($repo) : ();
 179 my $term = eval {
 180         $ENV{"GIT_SEND_EMAIL_NOTTY"}
 181                 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
 182                 : new Term::ReadLine 'git-send-email';
 183 };
 184 if ($@) {
 185         $term = new FakeTerm "$@: going non-interactive";
 186 }
 187
 188 # Behavior modification variables
 189 my ($quiet, $dry_run) = (0, 0);
 190 my $format_patch;
 191 my $compose_filename;
 192 my $force = 0;
 193 my $dump_aliases = 0;
 194
 195 # Handle interactive edition of files.
 196 my $multiedit;
 197 my $editor;
 198
 199 sub do_edit {
 200         if (!defined($editor)) {
 201                 $editor = Git::command_oneline('var', 'GIT_EDITOR');
 202         }
 203         if (defined($multiedit) && !$multiedit) {
 204                 map {
 205                         system('sh', '-c', $editor.' "$@"', $editor, $_);
 206                         if (($? & 127) || ($? >> 8)) {
 207                                 die(__("the editor exited uncleanly, aborting everything"));
 208                         }
 209                 } @_;
 210         } else {
 211                 system('sh', '-c', $editor.' "$@"', $editor, @_);
 212                 if (($? & 127) || ($? >> 8)) {
 213                         die(__("the editor exited uncleanly, aborting everything"));
 214                 }
 215         }
 216 }
 217
 218 # Variables with corresponding config settings
 219 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
 220 my ($cover_cc, $cover_to);
 221 my ($to_cmd, $cc_cmd);
 222 my ($smtp_server, $smtp_server_port, @smtp_server_options);
 223 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
 224 my ($batch_size, $relogin_delay);
 225 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
 226 my ($validate, $confirm);
 227 my (@suppress_cc);
 228 my ($auto_8bit_encoding);
 229 my ($compose_encoding);
 230 my ($target_xfer_encoding);
 231
 232 my ($debug_net_smtp) = 0;               # Net::SMTP, see send_message()
 233
 234 my %config_bool_settings = (
 235     "thread" => [\$thread, 1],
 236     "chainreplyto" => [\$chain_reply_to, 0],
 237     "suppressfrom" => [\$suppress_from, undef],
 238     "signedoffbycc" => [\$signed_off_by_cc, undef],
 239     "cccover" => [\$cover_cc, undef],
 240     "tocover" => [\$cover_to, undef],
 241     "signedoffcc" => [\$signed_off_by_cc, undef],      # Deprecated
 242     "validate" => [\$validate, 1],
 243     "multiedit" => [\$multiedit, undef],
 244     "annotate" => [\$annotate, undef],
 245     "xmailer" => [\$use_xmailer, 1]
 246 );
 247
 248 my %config_settings = (
 249     "smtpserver" => \$smtp_server,
 250     "smtpserverport" => \$smtp_server_port,
 251     "smtpserveroption" => \@smtp_server_options,
 252     "smtpuser" => \$smtp_authuser,
 253     "smtppass" => \$smtp_authpass,
 254     "smtpdomain" => \$smtp_domain,
 255     "smtpauth" => \$smtp_auth,
 256     "smtpbatchsize" => \$batch_size,
 257     "smtprelogindelay" => \$relogin_delay,
 258     "to" => \@initial_to,
 259     "tocmd" => \$to_cmd,
 260     "cc" => \@initial_cc,
 261     "cccmd" => \$cc_cmd,
 262     "aliasfiletype" => \$aliasfiletype,
 263     "bcc" => \@bcclist,
 264     "suppresscc" => \@suppress_cc,
 265     "envelopesender" => \$envelope_sender,
 266     "confirm"   => \$confirm,
 267     "from" => \$sender,
 268     "assume8bitencoding" => \$auto_8bit_encoding,
 269     "composeencoding" => \$compose_encoding,
 270     "transferencoding" => \$target_xfer_encoding,
 271 );
 272
 273 my %config_path_settings = (
 274     "aliasesfile" => \@alias_files,
 275     "smtpsslcertpath" => \$smtp_ssl_cert_path,
 276 );
 277
 278 # Handle Uncouth Termination
 279 sub signal_handler {
 280
 281         # Make text normal
 282         print color("reset"), "\n";
 283
 284         # SMTP password masked
 285         system "stty echo";
 286
 287         # tmp files from --compose
 288         if (defined $compose_filename) {
 289                 if (-e $compose_filename) {
 290                         printf __("'%s' contains an intermediate version ".
 291                                   "of the email you were composing.\n"),
 292                                   $compose_filename;
 293                 }
 294                 if (-e ($compose_filename . ".final")) {
 295                         printf __("'%s.final' contains the composed email.\n"),
 296                                   $compose_filename;
 297                 }
 298         }
 299
 300         exit;
 301 };
 302
 303 $SIG{TERM} = \&signal_handler;
 304 $SIG{INT}  = \&signal_handler;
 305
 306 # Begin by accumulating all the variables (defined above), that we will end up
 307 # needing, first, from the command line:
 308
 309 my $help;
 310 my $rc = GetOptions("h" => \$help,
 311                     "dump-aliases" => \$dump_aliases);
 312 usage() unless $rc;
 313 die __("--dump-aliases incompatible with other options\n")
 314     if !$help and $dump_aliases and @ARGV;
 315 $rc = GetOptions(
 316                     "sender|from=s" => \$sender,
 317                     "in-reply-to=s" => \$initial_reply_to,
 318                     "subject=s" => \$initial_subject,
 319                     "to=s" => \@initial_to,
 320                     "to-cmd=s" => \$to_cmd,
 321                     "no-to" => \$no_to,
 322                     "cc=s" => \@initial_cc,
 323                     "no-cc" => \$no_cc,
 324                     "bcc=s" => \@bcclist,
 325                     "no-bcc" => \$no_bcc,
 326                     "chain-reply-to!" => \$chain_reply_to,
 327                     "no-chain-reply-to" => sub {$chain_reply_to = 0},
 328                     "smtp-server=s" => \$smtp_server,
 329                     "smtp-server-option=s" => \@smtp_server_options,
 330                     "smtp-server-port=s" => \$smtp_server_port,
 331                     "smtp-user=s" => \$smtp_authuser,
 332                     "smtp-pass:s" => \$smtp_authpass,
 333                     "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
 334                     "smtp-encryption=s" => \$smtp_encryption,
 335                     "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
 336                     "smtp-debug:i" => \$debug_net_smtp,
 337                     "smtp-domain:s" => \$smtp_domain,
 338                     "smtp-auth=s" => \$smtp_auth,
 339                     "identity=s" => \$identity,
 340                     "annotate!" => \$annotate,
 341                     "no-annotate" => sub {$annotate = 0},
 342                     "compose" => \$compose,
 343                     "quiet" => \$quiet,
 344                     "cc-cmd=s" => \$cc_cmd,
 345                     "suppress-from!" => \$suppress_from,
 346                     "no-suppress-from" => sub {$suppress_from = 0},
 347                     "suppress-cc=s" => \@suppress_cc,
 348                     "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
 349                     "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
 350                     "cc-cover|cc-cover!" => \$cover_cc,
 351                     "no-cc-cover" => sub {$cover_cc = 0},
 352                     "to-cover|to-cover!" => \$cover_to,
 353                     "no-to-cover" => sub {$cover_to = 0},
 354                     "confirm=s" => \$confirm,
 355                     "dry-run" => \$dry_run,
 356                     "envelope-sender=s" => \$envelope_sender,
 357                     "thread!" => \$thread,
 358                     "no-thread" => sub {$thread = 0},
 359                     "validate!" => \$validate,
 360                     "no-validate" => sub {$validate = 0},
 361                     "transfer-encoding=s" => \$target_xfer_encoding,
 362                     "format-patch!" => \$format_patch,
 363                     "no-format-patch" => sub {$format_patch = 0},
 364                     "8bit-encoding=s" => \$auto_8bit_encoding,
 365                     "compose-encoding=s" => \$compose_encoding,
 366                     "force" => \$force,
 367                     "xmailer!" => \$use_xmailer,
 368                     "no-xmailer" => sub {$use_xmailer = 0},
 369                     "batch-size=i" => \$batch_size,
 370                     "relogin-delay=i" => \$relogin_delay,
 371          );
 372
 373 usage() if $help;
 374 unless ($rc) {
 375     usage();
 376 }
 377
 378 die __("Cannot run git format-patch from outside a repository\n")
 379         if $format_patch and not $repo;
 380
 381 # Now, let's fill any that aren't set in with defaults:
 382
 383 sub read_config {
 384         my ($prefix) = @_;
 385
 386         foreach my $setting (keys %config_bool_settings) {
 387                 my $target = $config_bool_settings{$setting}->[0];
 388                 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
 389         }
 390
 391         foreach my $setting (keys %config_path_settings) {
 392                 my $target = $config_path_settings{$setting};
 393                 if (ref($target) eq "ARRAY") {
 394                         unless (@$target) {
 395                                 my @values = Git::config_path(@repo, "$prefix.$setting");
 396                                 @$target = @values if (@values && defined $values[0]);
 397                         }
 398                 }
 399                 else {
 400                         $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
 401                 }
 402         }
 403
 404         foreach my $setting (keys %config_settings) {
 405                 my $target = $config_settings{$setting};
 406                 next if $setting eq "to" and defined $no_to;
 407                 next if $setting eq "cc" and defined $no_cc;
 408                 next if $setting eq "bcc" and defined $no_bcc;
 409                 if (ref($target) eq "ARRAY") {
 410                         unless (@$target) {
 411                                 my @values = Git::config(@repo, "$prefix.$setting");
 412                                 @$target = @values if (@values && defined $values[0]);
 413                         }
 414                 }
 415                 else {
 416                         $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
 417                 }
 418         }
 419
 420         if (!defined $smtp_encryption) {
 421                 my $enc = Git::config(@repo, "$prefix.smtpencryption");
 422                 if (defined $enc) {
 423                         $smtp_encryption = $enc;
 424                 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
 425                         $smtp_encryption = 'ssl';
 426                 }
 427         }
 428 }
 429
 430 # read configuration from [sendemail "$identity"], fall back on [sendemail]
 431 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
 432 read_config("sendemail.$identity") if (defined $identity);
 433 read_config("sendemail");
 434
 435 # fall back on builtin bool defaults
 436 foreach my $setting (values %config_bool_settings) {
 437         ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
 438 }
 439
 440 # 'default' encryption is none -- this only prevents a warning
 441 $smtp_encryption = '' unless (defined $smtp_encryption);
 442
 443 # Set CC suppressions
 444 my(%suppress_cc);
 445 if (@suppress_cc) {
 446         foreach my $entry (@suppress_cc) {
 447                 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
 448                         unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
 449                 $suppress_cc{$entry} = 1;
 450         }
 451 }
 452
 453 if ($suppress_cc{'all'}) {
 454         foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
 455                 $suppress_cc{$entry} = 1;
 456         }
 457         delete $suppress_cc{'all'};
 458 }
 459
 460 # If explicit old-style ones are specified, they trump --suppress-cc.
 461 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
 462 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
 463
 464 if ($suppress_cc{'body'}) {
 465         foreach my $entry (qw (sob bodycc)) {
 466                 $suppress_cc{$entry} = 1;
 467         }
 468         delete $suppress_cc{'body'};
 469 }
 470
 471 # Set confirm's default value
 472 my $confirm_unconfigured = !defined $confirm;
 473 if ($confirm_unconfigured) {
 474         $confirm = scalar %suppress_cc ? 'compose' : 'auto';
 475 };
 476 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
 477         unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
 478
 479 # Debugging, print out the suppressions.
 480 if (0) {
 481         print "suppressions:\n";
 482         foreach my $entry (keys %suppress_cc) {
 483                 printf "  %-5s -> $suppress_cc{$entry}\n", $entry;
 484         }
 485 }
 486
 487 my ($repoauthor, $repocommitter);
 488 ($repoauthor) = Git::ident_person(@repo, 'author');
 489 ($repocommitter) = Git::ident_person(@repo, 'committer');
 490
 491 sub parse_address_line {
 492         if ($have_mail_address) {
 493                 return map { $_->format } Mail::Address->parse($_[0]);
 494         } else {
 495                 return Git::parse_mailboxes($_[0]);
 496         }
 497 }
 498
 499 sub split_addrs {
 500         return quotewords('\s*,\s*', 1, @_);
 501 }
 502
 503 my %aliases;
 504
 505 sub parse_sendmail_alias {
 506         local $_ = shift;
 507         if (/"/) {
 508                 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
 509         } elsif (/:include:/) {
 510                 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
 511         } elsif (/[\/|]/) {
 512                 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
 513         } elsif (/^(\S+?)\s*:\s*(.+)$/) {
 514                 my ($alias, $addr) = ($1, $2);
 515                 $aliases{$alias} = [ split_addrs($addr) ];
 516         } else {
 517                 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
 518         }
 519 }
 520
 521 sub parse_sendmail_aliases {
 522         my $fh = shift;
 523         my $s = '';
 524         while (<$fh>) {
 525                 chomp;
 526                 next if /^\s*$/ || /^\s*#/;
 527                 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
 528                 parse_sendmail_alias($s) if $s;
 529                 $s = $_;
 530         }
 531         $s =~ s/\\$//; # silently tolerate stray '\' on last line
 532         parse_sendmail_alias($s) if $s;
 533 }
 534
 535 my %parse_alias = (
 536         # multiline formats can be supported in the future
 537         mutt => sub { my $fh = shift; while (<$fh>) {
 538                 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
 539                         my ($alias, $addr) = ($1, $2);
 540                         $addr =~ s/#.*$//; # mutt allows # comments
 541                         # commas delimit multiple addresses
 542                         my @addr = split_addrs($addr);
 543
 544                         # quotes may be escaped in the file,
 545                         # unescape them so we do not double-escape them later.
 546                         s/\\"/"/g foreach @addr;
 547                         $aliases{$alias} = \@addr
 548                 }}},
 549         mailrc => sub { my $fh = shift; while (<$fh>) {
 550                 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
 551                         # spaces delimit multiple addresses
 552                         $aliases{$1} = [ quotewords('\s+', 0, $2) ];
 553                 }}},
 554         pine => sub { my $fh = shift; my $f='\t[^\t]*';
 555                 for (my $x = ''; defined($x); $x = $_) {
 556                         chomp $x;
 557                         $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
 558                         $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
 559                         $aliases{$1} = [ split_addrs($2) ];
 560                 }},
 561         elm => sub  { my $fh = shift;
 562                       while (<$fh>) {
 563                           if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
 564                               my ($alias, $addr) = ($1, $2);
 565                                $aliases{$alias} = [ split_addrs($addr) ];
 566                           }
 567                       } },
 568         sendmail => \&parse_sendmail_aliases,
 569         gnus => sub { my $fh = shift; while (<$fh>) {
 570                 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
 571                         $aliases{$1} = [ $2 ];
 572                 }}}
 573 );
 574
 575 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
 576         foreach my $file (@alias_files) {
 577                 open my $fh, '<', $file or die "opening $file: $!\n";
 578                 $parse_alias{$aliasfiletype}->($fh);
 579                 close $fh;
 580         }
 581 }
 582
 583 if ($dump_aliases) {
 584     print "$_\n" for (sort keys %aliases);
 585     exit(0);
 586 }
 587
 588 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
 589 # $f is a revision list specification to be passed to format-patch.
 590 sub is_format_patch_arg {
 591         return unless $repo;
 592         my $f = shift;
 593         try {
 594                 $repo->command('rev-parse', '--verify', '--quiet', $f);
 595                 if (defined($format_patch)) {
 596                         return $format_patch;
 597                 }
 598                 die sprintf(__ <<EOF, $f, $f);
 599 File '%s' exists but it could also be the range of commits
 600 to produce patches for.  Please disambiguate by...
 601
 602     * Saying "./%s" if you mean a file; or
 603     * Giving --format-patch option if you mean a range.
 604 EOF
 605         } catch Git::Error::Command with {
 606                 # Not a valid revision.  Treat it as a filename.
 607                 return 0;
 608         }
 609 }
 610
 611 # Now that all the defaults are set, process the rest of the command line
 612 # arguments and collect up the files that need to be processed.
 613 my @rev_list_opts;
 614 while (defined(my $f = shift @ARGV)) {
 615         if ($f eq "--") {
 616                 push @rev_list_opts, "--", @ARGV;
 617                 @ARGV = ();
 618         } elsif (-d $f and !is_format_patch_arg($f)) {
 619                 opendir my $dh, $f
 620                         or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
 621
 622                 push @files, grep { -f $_ } map { catfile($f, $_) }
 623                                 sort readdir $dh;
 624                 closedir $dh;
 625         } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
 626                 push @files, $f;
 627         } else {
 628                 push @rev_list_opts, $f;
 629         }
 630 }
 631
 632 if (@rev_list_opts) {
 633         die __("Cannot run git format-patch from outside a repository\n")
 634                 unless $repo;
 635         push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
 636 }
 637
 638 @files = handle_backup_files(@files);
 639
 640 if ($validate) {
 641         foreach my $f (@files) {
 642                 unless (-p $f) {
 643                         my $error = validate_patch($f);
 644                         $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
 645                                                   $f, $error);
 646                 }
 647         }
 648 }
 649
 650 if (@files) {
 651         unless ($quiet) {
 652                 print $_,"\n" for (@files);
 653         }
 654 } else {
 655         print STDERR __("\nNo patch files specified!\n\n");
 656         usage();
 657 }
 658
 659 sub get_patch_subject {
 660         my $fn = shift;
 661         open (my $fh, '<', $fn);
 662         while (my $line = <$fh>) {
 663                 next unless ($line =~ /^Subject: (.*)$/);
 664                 close $fh;
 665                 return "GIT: $1\n";
 666         }
 667         close $fh;
 668         die sprintf(__("No subject line in %s?"), $fn);
 669 }
 670
 671 if ($compose) {
 672         # Note that this does not need to be secure, but we will make a small
 673         # effort to have it be unique
 674         $compose_filename = ($repo ?
 675                 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
 676                 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
 677         open my $c, ">", $compose_filename
 678                 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 679
 680
 681         my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
 682         my $tpl_subject = $initial_subject || '';
 683         my $tpl_reply_to = $initial_reply_to || '';
 684
 685         print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
 686 From $tpl_sender # This line is ignored.
 687 EOT1
 688 Lines beginning in "GIT:" will be removed.
 689 Consider including an overall diffstat or table of contents
 690 for the patch you are writing.
 691
 692 Clear the body content if you don't wish to send a summary.
 693 EOT2
 694 From: $tpl_sender
 695 Subject: $tpl_subject
 696 In-Reply-To: $tpl_reply_to
 697
 698 EOT3
 699         for my $f (@files) {
 700                 print $c get_patch_subject($f);
 701         }
 702         close $c;
 703
 704         if ($annotate) {
 705                 do_edit($compose_filename, @files);
 706         } else {
 707                 do_edit($compose_filename);
 708         }
 709
 710         open my $c2, ">", $compose_filename . ".final"
 711                 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 712
 713         open $c, "<", $compose_filename
 714                 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 715
 716         my $need_8bit_cte = file_has_nonascii($compose_filename);
 717         my $in_body = 0;
 718         my $summary_empty = 1;
 719         if (!defined $compose_encoding) {
 720                 $compose_encoding = "UTF-8";
 721         }
 722         while(<$c>) {
 723                 next if m/^GIT:/;
 724                 if ($in_body) {
 725                         $summary_empty = 0 unless (/^\n$/);
 726                 } elsif (/^\n$/) {
 727                         $in_body = 1;
 728                         if ($need_8bit_cte) {
 729                                 print $c2 "MIME-Version: 1.0\n",
 730                                          "Content-Type: text/plain; ",
 731                                            "charset=$compose_encoding\n",
 732                                          "Content-Transfer-Encoding: 8bit\n";
 733                         }
 734                 } elsif (/^MIME-Version:/i) {
 735                         $need_8bit_cte = 0;
 736                 } elsif (/^Subject:\s*(.+)\s*$/i) {
 737                         $initial_subject = $1;
 738                         my $subject = $initial_subject;
 739                         $_ = "Subject: " .
 740                                 quote_subject($subject, $compose_encoding) .
 741                                 "\n";
 742                 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
 743                         $initial_reply_to = $1;
 744                         next;
 745                 } elsif (/^From:\s*(.+)\s*$/i) {
 746                         $sender = $1;
 747                         next;
 748                 } elsif (/^(?:To|Cc|Bcc):/i) {
 749                         print __("To/Cc/Bcc fields are not interpreted yet, they have been ignored\n");
 750                         next;
 751                 }
 752                 print $c2 $_;
 753         }
 754         close $c;
 755         close $c2;
 756
 757         if ($summary_empty) {
 758                 print __("Summary email is empty, skipping it\n");
 759                 $compose = -1;
 760         }
 761 } elsif ($annotate) {
 762         do_edit(@files);
 763 }
 764
 765 sub ask {
 766         my ($prompt, %arg) = @_;
 767         my $valid_re = $arg{valid_re};
 768         my $default = $arg{default};
 769         my $confirm_only = $arg{confirm_only};
 770         my $resp;
 771         my $i = 0;
 772         return defined $default ? $default : undef
 773                 unless defined $term->IN and defined fileno($term->IN) and
 774                        defined $term->OUT and defined fileno($term->OUT);
 775         while ($i++ < 10) {
 776                 $resp = $term->readline($prompt);
 777                 if (!defined $resp) { # EOF
 778                         print "\n";
 779                         return defined $default ? $default : undef;
 780                 }
 781                 if ($resp eq '' and defined $default) {
 782                         return $default;
 783                 }
 784                 if (!defined $valid_re or $resp =~ /$valid_re/) {
 785                         return $resp;
 786                 }
 787                 if ($confirm_only) {
 788                         my $yesno = $term->readline(
 789                                 # TRANSLATORS: please keep [y/N] as is.
 790                                 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
 791                         if (defined $yesno && $yesno =~ /y/i) {
 792                                 return $resp;
 793                         }
 794                 }
 795         }
 796         return;
 797 }
 798
 799 my %broken_encoding;
 800
 801 sub file_declares_8bit_cte {
 802         my $fn = shift;
 803         open (my $fh, '<', $fn);
 804         while (my $line = <$fh>) {
 805                 last if ($line =~ /^$/);
 806                 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
 807         }
 808         close $fh;
 809         return 0;
 810 }
 811
 812 foreach my $f (@files) {
 813         next unless (body_or_subject_has_nonascii($f)
 814                      && !file_declares_8bit_cte($f));
 815         $broken_encoding{$f} = 1;
 816 }
 817
 818 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
 819         print __("The following files are 8bit, but do not declare " .
 820                  "a Content-Transfer-Encoding.\n");
 821         foreach my $f (sort keys %broken_encoding) {
 822                 print "    $f\n";
 823         }
 824         $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
 825                                   valid_re => qr/.{4}/, confirm_only => 1,
 826                                   default => "UTF-8");
 827 }
 828
 829 if (!$force) {
 830         for my $f (@files) {
 831                 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
 832                         die sprintf(__("Refusing to send because the patch\n\t%s\n"
 833                                 . "has the template subject '*** SUBJECT HERE ***'. "
 834                                 . "Pass --force if you really want to send.\n"), $f);
 835                 }
 836         }
 837 }
 838
 839 if (defined $sender) {
 840         $sender =~ s/^\s+|\s+$//g;
 841         ($sender) = expand_aliases($sender);
 842 } else {
 843         $sender = $repoauthor || $repocommitter || '';
 844 }
 845
 846 # $sender could be an already sanitized address
 847 # (e.g. sendemail.from could be manually sanitized by user).
 848 # But it's a no-op to run sanitize_address on an already sanitized address.
 849 $sender = sanitize_address($sender);
 850
 851 my $to_whom = __("To whom should the emails be sent (if anyone)?");
 852 my $prompting = 0;
 853 if (!@initial_to && !defined $to_cmd) {
 854         my $to = ask("$to_whom ",
 855                      default => "",
 856                      valid_re => qr/\@.*\./, confirm_only => 1);
 857         push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
 858         $prompting++;
 859 }
 860
 861 sub expand_aliases {
 862         return map { expand_one_alias($_) } @_;
 863 }
 864
 865 my %EXPANDED_ALIASES;
 866 sub expand_one_alias {
 867         my $alias = shift;
 868         if ($EXPANDED_ALIASES{$alias}) {
 869                 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
 870         }
 871         local $EXPANDED_ALIASES{$alias} = 1;
 872         return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
 873 }
 874
 875 @initial_to = process_address_list(@initial_to);
 876 @initial_cc = process_address_list(@initial_cc);
 877 @bcclist = process_address_list(@bcclist);
 878
 879 if ($thread && !defined $initial_reply_to && $prompting) {
 880         $initial_reply_to = ask(
 881                 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
 882                 default => "",
 883                 valid_re => qr/\@.*\./, confirm_only => 1);
 884 }
 885 if (defined $initial_reply_to) {
 886         $initial_reply_to =~ s/^\s*<?//;
 887         $initial_reply_to =~ s/>?\s*$//;
 888         $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
 889 }
 890
 891 if (!defined $smtp_server) {
 892         foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
 893                 if (-x $_) {
 894                         $smtp_server = $_;
 895                         last;
 896                 }
 897         }
 898         $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
 899 }
 900
 901 if ($compose && $compose > 0) {
 902         @files = ($compose_filename . ".final", @files);
 903 }
 904
 905 # Variables we set as part of the loop over files
 906 our ($message_id, %mail, $subject, $reply_to, $references, $message,
 907         $needs_confirm, $message_num, $ask_default);
 908
 909 sub extract_valid_address {
 910         my $address = shift;
 911         my $local_part_regexp = qr/[^<>"\s@]+/;
 912         my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
 913
 914         # check for a local address:
 915         return $address if ($address =~ /^($local_part_regexp)$/);
 916
 917         $address =~ s/^\s*<(.*)>\s*$/$1/;
 918         if ($have_email_valid) {
 919                 return scalar Email::Valid->address($address);
 920         }
 921
 922         # less robust/correct than the monster regexp in Email::Valid,
 923         # but still does a 99% job, and one less dependency
 924         return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
 925         return;
 926 }
 927
 928 sub extract_valid_address_or_die {
 929         my $address = shift;
 930         $address = extract_valid_address($address);
 931         die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
 932                 if !$address;
 933         return $address;
 934 }
 935
 936 sub validate_address {
 937         my $address = shift;
 938         while (!extract_valid_address($address)) {
 939                 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
 940                 # TRANSLATORS: Make sure to include [q] [d] [e] in your
 941                 # translation. The program will only accept English input
 942                 # at this point.
 943                 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
 944                         valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
 945                         default => 'q');
 946                 if (/^d/i) {
 947                         return undef;
 948                 } elsif (/^q/i) {
 949                         cleanup_compose_files();
 950                         exit(0);
 951                 }
 952                 $address = ask("$to_whom ",
 953                         default => "",
 954                         valid_re => qr/\@.*\./, confirm_only => 1);
 955         }
 956         return $address;
 957 }
 958
 959 sub validate_address_list {
 960         return (grep { defined $_ }
 961                 map { validate_address($_) } @_);
 962 }
 963
 964 # Usually don't need to change anything below here.
 965
 966 # we make a "fake" message id by taking the current number
 967 # of seconds since the beginning of Unix time and tacking on
 968 # a random number to the end, in case we are called quicker than
 969 # 1 second since the last time we were called.
 970
 971 # We'll setup a template for the message id, using the "from" address:
 972
 973 my ($message_id_stamp, $message_id_serial);
 974 sub make_message_id {
 975         my $uniq;
 976         if (!defined $message_id_stamp) {
 977                 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
 978                 $message_id_serial = 0;
 979         }
 980         $message_id_serial++;
 981         $uniq = "$message_id_stamp-$message_id_serial";
 982
 983         my $du_part;
 984         for ($sender, $repocommitter, $repoauthor) {
 985                 $du_part = extract_valid_address(sanitize_address($_));
 986                 last if (defined $du_part and $du_part ne '');
 987         }
 988         if (not defined $du_part or $du_part eq '') {
 989                 require Sys::Hostname;
 990                 $du_part = 'user@' . Sys::Hostname::hostname();
 991         }
 992         my $message_id_template = "<%s-%s>";
 993         $message_id = sprintf($message_id_template, $uniq, $du_part);
 994         #print "new message id = $message_id\n"; # Was useful for debugging
 995 }
 996
 997
 998
 999 $time = time - scalar $#files;
1000
1001 sub unquote_rfc2047 {
1002         local ($_) = @_;
1003         my $charset;
1004         my $sep = qr/[ \t]+/;
1005         s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1006                 my @words = split $sep, $&;
1007                 foreach (@words) {
1008                         m/$re_encoded_word/;
1009                         $charset = $1;
1010                         my $encoding = $2;
1011                         my $text = $3;
1012                         if ($encoding eq 'q' || $encoding eq 'Q') {
1013                                 $_ = $text;
1014                                 s/_/ /g;
1015                                 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1016                         } else {
1017                                 # other encodings not supported yet
1018                         }
1019                 }
1020                 join '', @words;
1021         }eg;
1022         return wantarray ? ($_, $charset) : $_;
1023 }
1024
1025 sub quote_rfc2047 {
1026         local $_ = shift;
1027         my $encoding = shift || 'UTF-8';
1028         s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1029         s/(.*)/=\?$encoding\?q\?$1\?=/;
1030         return $_;
1031 }
1032
1033 sub is_rfc2047_quoted {
1034         my $s = shift;
1035         length($s) <= 75 &&
1036         $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1037 }
1038
1039 sub subject_needs_rfc2047_quoting {
1040         my $s = shift;
1041
1042         return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1043 }
1044
1045 sub quote_subject {
1046         local $subject = shift;
1047         my $encoding = shift || 'UTF-8';
1048
1049         if (subject_needs_rfc2047_quoting($subject)) {
1050                 return quote_rfc2047($subject, $encoding);
1051         }
1052         return $subject;
1053 }
1054
1055 # use the simplest quoting being able to handle the recipient
1056 sub sanitize_address {
1057         my ($recipient) = @_;
1058
1059         # remove garbage after email address
1060         $recipient =~ s/(.*>).*$/$1/;
1061
1062         my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1063
1064         if (not $recipient_name) {
1065                 return $recipient;
1066         }
1067
1068         # if recipient_name is already quoted, do nothing
1069         if (is_rfc2047_quoted($recipient_name)) {
1070                 return $recipient;
1071         }
1072
1073         # remove non-escaped quotes
1074         $recipient_name =~ s/(^|[^\\])"/$1/g;
1075
1076         # rfc2047 is needed if a non-ascii char is included
1077         if ($recipient_name =~ /[^[:ascii:]]/) {
1078                 $recipient_name = quote_rfc2047($recipient_name);
1079         }
1080
1081         # double quotes are needed if specials or CTLs are included
1082         elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1083                 $recipient_name =~ s/([\\\r])/\\$1/g;
1084                 $recipient_name = qq["$recipient_name"];
1085         }
1086
1087         return "$recipient_name $recipient_addr";
1088
1089 }
1090
1091 sub sanitize_address_list {
1092         return (map { sanitize_address($_) } @_);
1093 }
1094
1095 sub process_address_list {
1096         my @addr_list = map { parse_address_line($_) } @_;
1097         @addr_list = expand_aliases(@addr_list);
1098         @addr_list = sanitize_address_list(@addr_list);
1099         @addr_list = validate_address_list(@addr_list);
1100         return @addr_list;
1101 }
1102
1103 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1104 #
1105 # Tightly configured MTAa require that a caller sends a real DNS
1106 # domain name that corresponds the IP address in the HELO/EHLO
1107 # handshake. This is used to verify the connection and prevent
1108 # spammers from trying to hide their identity. If the DNS and IP don't
1109 # match, the receiveing MTA may deny the connection.
1110 #
1111 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1112 #
1113 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1114 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1115 #
1116 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1117 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1118
1119 sub valid_fqdn {
1120         my $domain = shift;
1121         return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1122 }
1123
1124 sub maildomain_net {
1125         my $maildomain;
1126
1127         if (eval { require Net::Domain; 1 }) {
1128                 my $domain = Net::Domain::domainname();
1129                 $maildomain = $domain if valid_fqdn($domain);
1130         }
1131
1132         return $maildomain;
1133 }
1134
1135 sub maildomain_mta {
1136         my $maildomain;
1137
1138         if (eval { require Net::SMTP; 1 }) {
1139                 for my $host (qw(mailhost localhost)) {
1140                         my $smtp = Net::SMTP->new($host);
1141                         if (defined $smtp) {
1142                                 my $domain = $smtp->domain;
1143                                 $smtp->quit;
1144
1145                                 $maildomain = $domain if valid_fqdn($domain);
1146
1147                                 last if $maildomain;
1148                         }
1149                 }
1150         }
1151
1152         return $maildomain;
1153 }
1154
1155 sub maildomain {
1156         return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1157 }
1158
1159 sub smtp_host_string {
1160         if (defined $smtp_server_port) {
1161                 return "$smtp_server:$smtp_server_port";
1162         } else {
1163                 return $smtp_server;
1164         }
1165 }
1166
1167 # Returns 1 if authentication succeeded or was not necessary
1168 # (smtp_user was not specified), and 0 otherwise.
1169
1170 sub smtp_auth_maybe {
1171         if (!defined $smtp_authuser || $auth) {
1172                 return 1;
1173         }
1174
1175         # Workaround AUTH PLAIN/LOGIN interaction defect
1176         # with Authen::SASL::Cyrus
1177         eval {
1178                 require Authen::SASL;
1179                 Authen::SASL->import(qw(Perl));
1180         };
1181
1182         # Check mechanism naming as defined in:
1183         # https://tools.ietf.org/html/rfc4422#page-8
1184         if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1185                 die "invalid smtp auth: '${smtp_auth}'";
1186         }
1187
1188         # TODO: Authentication may fail not because credentials were
1189         # invalid but due to other reasons, in which we should not
1190         # reject credentials.
1191         $auth = Git::credential({
1192                 'protocol' => 'smtp',
1193                 'host' => smtp_host_string(),
1194                 'username' => $smtp_authuser,
1195                 # if there's no password, "git credential fill" will
1196                 # give us one, otherwise it'll just pass this one.
1197                 'password' => $smtp_authpass
1198         }, sub {
1199                 my $cred = shift;
1200
1201                 if ($smtp_auth) {
1202                         my $sasl = Authen::SASL->new(
1203                                 mechanism => $smtp_auth,
1204                                 callback => {
1205                                         user => $cred->{'username'},
1206                                         pass => $cred->{'password'},
1207                                         authname => $cred->{'username'},
1208                                 }
1209                         );
1210
1211                         return !!$smtp->auth($sasl);
1212                 }
1213
1214                 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1215         });
1216
1217         return $auth;
1218 }
1219
1220 sub ssl_verify_params {
1221         eval {
1222                 require IO::Socket::SSL;
1223                 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1224         };
1225         if ($@) {
1226                 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1227                 return;
1228         }
1229
1230         if (!defined $smtp_ssl_cert_path) {
1231                 # use the OpenSSL defaults
1232                 return (SSL_verify_mode => SSL_VERIFY_PEER());
1233         }
1234
1235         if ($smtp_ssl_cert_path eq "") {
1236                 return (SSL_verify_mode => SSL_VERIFY_NONE());
1237         } elsif (-d $smtp_ssl_cert_path) {
1238                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1239                         SSL_ca_path => $smtp_ssl_cert_path);
1240         } elsif (-f $smtp_ssl_cert_path) {
1241                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1242                         SSL_ca_file => $smtp_ssl_cert_path);
1243         } else {
1244                 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1245         }
1246 }
1247
1248 sub file_name_is_absolute {
1249         my ($path) = @_;
1250
1251         # msys does not grok DOS drive-prefixes
1252         if ($^O eq 'msys') {
1253                 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1254         }
1255
1256         require File::Spec::Functions;
1257         return File::Spec::Functions::file_name_is_absolute($path);
1258 }
1259
1260 # Returns 1 if the message was sent, and 0 otherwise.
1261 # In actuality, the whole program dies when there
1262 # is an error sending a message.
1263
1264 sub send_message {
1265         my @recipients = unique_email_list(@to);
1266         @cc = (grep { my $cc = extract_valid_address_or_die($_);
1267                       not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1268                     }
1269                @cc);
1270         my $to = join (",\n\t", @recipients);
1271         @recipients = unique_email_list(@recipients,@cc,@bcclist);
1272         @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1273         my $date = format_2822_time($time++);
1274         my $gitversion = '@@GIT_VERSION@@';
1275         if ($gitversion =~ m/..GIT_VERSION../) {
1276             $gitversion = Git::version();
1277         }
1278
1279         my $cc = join(",\n\t", unique_email_list(@cc));
1280         my $ccline = "";
1281         if ($cc ne '') {
1282                 $ccline = "\nCc: $cc";
1283         }
1284         make_message_id() unless defined($message_id);
1285
1286         my $header = "From: $sender
1287 To: $to${ccline}
1288 Subject: $subject
1289 Date: $date
1290 Message-Id: $message_id
1291 ";
1292         if ($use_xmailer) {
1293                 $header .= "X-Mailer: git-send-email $gitversion\n";
1294         }
1295         if ($reply_to) {
1296
1297                 $header .= "In-Reply-To: $reply_to\n";
1298                 $header .= "References: $references\n";
1299         }
1300         if (@xh) {
1301                 $header .= join("\n", @xh) . "\n";
1302         }
1303
1304         my @sendmail_parameters = ('-i', @recipients);
1305         my $raw_from = $sender;
1306         if (defined $envelope_sender && $envelope_sender ne "auto") {
1307                 $raw_from = $envelope_sender;
1308         }
1309         $raw_from = extract_valid_address($raw_from);
1310         unshift (@sendmail_parameters,
1311                         '-f', $raw_from) if(defined $envelope_sender);
1312
1313         if ($needs_confirm && !$dry_run) {
1314                 print "\n$header\n";
1315                 if ($needs_confirm eq "inform") {
1316                         $confirm_unconfigured = 0; # squelch this message for the rest of this run
1317                         $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1318                         print __ <<EOF ;
1319     The Cc list above has been expanded by additional
1320     addresses found in the patch commit message. By default
1321     send-email prompts before sending whenever this occurs.
1322     This behavior is controlled by the sendemail.confirm
1323     configuration setting.
1324
1325     For additional information, run 'git send-email --help'.
1326     To retain the current behavior, but squelch this message,
1327     run 'git config --global sendemail.confirm auto'.
1328
1329 EOF
1330                 }
1331                 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1332                 # translation. The program will only accept English input
1333                 # at this point.
1334                 $_ = ask(__("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1335                          valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1336                          default => $ask_default);
1337                 die __("Send this email reply required") unless defined $_;
1338                 if (/^n/i) {
1339                         return 0;
1340                 } elsif (/^q/i) {
1341                         cleanup_compose_files();
1342                         exit(0);
1343                 } elsif (/^a/i) {
1344                         $confirm = 'never';
1345                 }
1346         }
1347
1348         unshift (@sendmail_parameters, @smtp_server_options);
1349
1350         if ($dry_run) {
1351                 # We don't want to send the email.
1352         } elsif (file_name_is_absolute($smtp_server)) {
1353                 my $pid = open my $sm, '|-';
1354                 defined $pid or die $!;
1355                 if (!$pid) {
1356                         exec($smtp_server, @sendmail_parameters) or die $!;
1357                 }
1358                 print $sm "$header\n$message";
1359                 close $sm or die $!;
1360         } else {
1361
1362                 if (!defined $smtp_server) {
1363                         die __("The required SMTP server is not properly defined.")
1364                 }
1365
1366                 if ($smtp_encryption eq 'ssl') {
1367                         $smtp_server_port ||= 465; # ssmtp
1368                         require Net::SMTP::SSL;
1369                         $smtp_domain ||= maildomain();
1370                         require IO::Socket::SSL;
1371
1372                         # Suppress "variable accessed once" warning.
1373                         {
1374                                 no warnings 'once';
1375                                 $IO::Socket::SSL::DEBUG = 1;
1376                         }
1377
1378                         # Net::SMTP::SSL->new() does not forward any SSL options
1379                         IO::Socket::SSL::set_client_defaults(
1380                                 ssl_verify_params());
1381                         $smtp ||= Net::SMTP::SSL->new($smtp_server,
1382                                                       Hello => $smtp_domain,
1383                                                       Port => $smtp_server_port,
1384                                                       Debug => $debug_net_smtp);
1385                 }
1386                 else {
1387                         require Net::SMTP;
1388                         $smtp_domain ||= maildomain();
1389                         $smtp_server_port ||= 25;
1390                         $smtp ||= Net::SMTP->new($smtp_server,
1391                                                  Hello => $smtp_domain,
1392                                                  Debug => $debug_net_smtp,
1393                                                  Port => $smtp_server_port);
1394                         if ($smtp_encryption eq 'tls' && $smtp) {
1395                                 require Net::SMTP::SSL;
1396                                 $smtp->command('STARTTLS');
1397                                 $smtp->response();
1398                                 if ($smtp->code == 220) {
1399                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1400                                                                           ssl_verify_params())
1401                                                 or die "STARTTLS failed! ".IO::Socket::SSL::errstr();
1402                                         $smtp_encryption = '';
1403                                         # Send EHLO again to receive fresh
1404                                         # supported commands
1405                                         $smtp->hello($smtp_domain);
1406                                 } else {
1407                                         die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1408                                 }
1409                         }
1410                 }
1411
1412                 if (!$smtp) {
1413                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1414                             " VALUES: server=$smtp_server ",
1415                             "encryption=$smtp_encryption ",
1416                             "hello=$smtp_domain",
1417                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1418                 }
1419
1420                 smtp_auth_maybe or die $smtp->message;
1421
1422                 $smtp->mail( $raw_from ) or die $smtp->message;
1423                 $smtp->to( @recipients ) or die $smtp->message;
1424                 $smtp->data or die $smtp->message;
1425                 $smtp->datasend("$header\n") or die $smtp->message;
1426                 my @lines = split /^/, $message;
1427                 foreach my $line (@lines) {
1428                         $smtp->datasend("$line") or die $smtp->message;
1429                 }
1430                 $smtp->dataend() or die $smtp->message;
1431                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1432         }
1433         if ($quiet) {
1434                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1435         } else {
1436                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1437                 if (!file_name_is_absolute($smtp_server)) {
1438                         print "Server: $smtp_server\n";
1439                         print "MAIL FROM:<$raw_from>\n";
1440                         foreach my $entry (@recipients) {
1441                             print "RCPT TO:<$entry>\n";
1442                         }
1443                 } else {
1444                         print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1445                 }
1446                 print $header, "\n";
1447                 if ($smtp) {
1448                         print __("Result: "), $smtp->code, ' ',
1449                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1450                 } else {
1451                         print __("Result: OK\n");
1452                 }
1453         }
1454
1455         return 1;
1456 }
1457
1458 $reply_to = $initial_reply_to;
1459 $references = $initial_reply_to || '';
1460 $subject = $initial_subject;
1461 $message_num = 0;
1462
1463 foreach my $t (@files) {
1464         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1465
1466         my $author = undef;
1467         my $sauthor = undef;
1468         my $author_encoding;
1469         my $has_content_type;
1470         my $body_encoding;
1471         my $xfer_encoding;
1472         my $has_mime_version;
1473         @to = ();
1474         @cc = ();
1475         @xh = ();
1476         my $input_format = undef;
1477         my @header = ();
1478         $message = "";
1479         $message_num++;
1480         # First unfold multiline header fields
1481         while(<$fh>) {
1482                 last if /^\s*$/;
1483                 if (/^\s+\S/ and @header) {
1484                         chomp($header[$#header]);
1485                         s/^\s+/ /;
1486                         $header[$#header] .= $_;
1487             } else {
1488                         push(@header, $_);
1489                 }
1490         }
1491         # Now parse the header
1492         foreach(@header) {
1493                 if (/^From /) {
1494                         $input_format = 'mbox';
1495                         next;
1496                 }
1497                 chomp;
1498                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1499                         $input_format = 'mbox';
1500                 }
1501
1502                 if (defined $input_format && $input_format eq 'mbox') {
1503                         if (/^Subject:\s+(.*)$/i) {
1504                                 $subject = $1;
1505                         }
1506                         elsif (/^From:\s+(.*)$/i) {
1507                                 ($author, $author_encoding) = unquote_rfc2047($1);
1508                                 $sauthor = sanitize_address($author);
1509                                 next if $suppress_cc{'author'};
1510                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1511                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1512                                         $1, $_) unless $quiet;
1513                                 push @cc, $1;
1514                         }
1515                         elsif (/^To:\s+(.*)$/i) {
1516                                 foreach my $addr (parse_address_line($1)) {
1517                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1518                                                 $addr, $_) unless $quiet;
1519                                         push @to, $addr;
1520                                 }
1521                         }
1522                         elsif (/^Cc:\s+(.*)$/i) {
1523                                 foreach my $addr (parse_address_line($1)) {
1524                                         my $qaddr = unquote_rfc2047($addr);
1525                                         my $saddr = sanitize_address($qaddr);
1526                                         if ($saddr eq $sender) {
1527                                                 next if ($suppress_cc{'self'});
1528                                         } else {
1529                                                 next if ($suppress_cc{'cc'});
1530                                         }
1531                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1532                                                 $addr, $_) unless $quiet;
1533                                         push @cc, $addr;
1534                                 }
1535                         }
1536                         elsif (/^Content-type:/i) {
1537                                 $has_content_type = 1;
1538                                 if (/charset="?([^ "]+)/) {
1539                                         $body_encoding = $1;
1540                                 }
1541                                 push @xh, $_;
1542                         }
1543                         elsif (/^MIME-Version/i) {
1544                                 $has_mime_version = 1;
1545                                 push @xh, $_;
1546                         }
1547                         elsif (/^Message-Id: (.*)/i) {
1548                                 $message_id = $1;
1549                         }
1550                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1551                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1552                         }
1553                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1554                                 push @xh, $_;
1555                         }
1556
1557                 } else {
1558                         # In the traditional
1559                         # "send lots of email" format,
1560                         # line 1 = cc
1561                         # line 2 = subject
1562                         # So let's support that, too.
1563                         $input_format = 'lots';
1564                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1565                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1566                                         $_, $_) unless $quiet;
1567                                 push @cc, $_;
1568                         } elsif (!defined $subject) {
1569                                 $subject = $_;
1570                         }
1571                 }
1572         }
1573         # Now parse the message body
1574         while(<$fh>) {
1575                 $message .=  $_;
1576                 if (/^(Signed-off-by|Cc): ([^>]*>?)/i) {
1577                         chomp;
1578                         my ($what, $c) = ($1, $2);
1579                         chomp $c;
1580                         my $sc = sanitize_address($c);
1581                         if ($sc eq $sender) {
1582                                 next if ($suppress_cc{'self'});
1583                         } else {
1584                                 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1585                                 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1586                         }
1587                         push @cc, $c;
1588                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1589                                 $c, $_) unless $quiet;
1590                 }
1591         }
1592         close $fh;
1593
1594         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1595                 if defined $to_cmd;
1596         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1597                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1598
1599         if ($broken_encoding{$t} && !$has_content_type) {
1600                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1601                 $has_content_type = 1;
1602                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1603                 $body_encoding = $auto_8bit_encoding;
1604         }
1605
1606         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1607                 $subject = quote_subject($subject, $auto_8bit_encoding);
1608         }
1609
1610         if (defined $sauthor and $sauthor ne $sender) {
1611                 $message = "From: $author\n\n$message";
1612                 if (defined $author_encoding) {
1613                         if ($has_content_type) {
1614                                 if ($body_encoding eq $author_encoding) {
1615                                         # ok, we already have the right encoding
1616                                 }
1617                                 else {
1618                                         # uh oh, we should re-encode
1619                                 }
1620                         }
1621                         else {
1622                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1623                                 $has_content_type = 1;
1624                                 push @xh,
1625                                   "Content-Type: text/plain; charset=$author_encoding";
1626                         }
1627                 }
1628         }
1629         if (defined $target_xfer_encoding) {
1630                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1631                 $message = apply_transfer_encoding(
1632                         $message, $xfer_encoding, $target_xfer_encoding);
1633                 $xfer_encoding = $target_xfer_encoding;
1634         }
1635         if (defined $xfer_encoding) {
1636                 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1637         }
1638         if (defined $xfer_encoding or $has_content_type) {
1639                 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1640         }
1641
1642         $needs_confirm = (
1643                 $confirm eq "always" or
1644                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1645                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1646         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1647
1648         @to = process_address_list(@to);
1649         @cc = process_address_list(@cc);
1650
1651         @to = (@initial_to, @to);
1652         @cc = (@initial_cc, @cc);
1653
1654         if ($message_num == 1) {
1655                 if (defined $cover_cc and $cover_cc) {
1656                         @initial_cc = @cc;
1657                 }
1658                 if (defined $cover_to and $cover_to) {
1659                         @initial_to = @to;
1660                 }
1661         }
1662
1663         my $message_was_sent = send_message();
1664
1665         # set up for the next message
1666         if ($thread && $message_was_sent &&
1667                 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1668                 $message_num == 1)) {
1669                 $reply_to = $message_id;
1670                 if (length $references > 0) {
1671                         $references .= "\n $message_id";
1672                 } else {
1673                         $references = "$message_id";
1674                 }
1675         }
1676         $message_id = undef;
1677         $num_sent++;
1678         if (defined $batch_size && $num_sent == $batch_size) {
1679                 $num_sent = 0;
1680                 $smtp->quit if defined $smtp;
1681                 undef $smtp;
1682                 undef $auth;
1683                 sleep($relogin_delay) if defined $relogin_delay;
1684         }
1685 }
1686
1687 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1688 # and return a results array
1689 sub recipients_cmd {
1690         my ($prefix, $what, $cmd, $file) = @_;
1691
1692         my @addresses = ();
1693         open my $fh, "-|", "$cmd \Q$file\E"
1694             or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1695         while (my $address = <$fh>) {
1696                 $address =~ s/^\s*//g;
1697                 $address =~ s/\s*$//g;
1698                 $address = sanitize_address($address);
1699                 next if ($address eq $sender and $suppress_cc{'self'});
1700                 push @addresses, $address;
1701                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1702                        $prefix, $what, $address, $cmd) unless $quiet;
1703                 }
1704         close $fh
1705             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1706         return @addresses;
1707 }
1708
1709 cleanup_compose_files();
1710
1711 sub cleanup_compose_files {
1712         unlink($compose_filename, $compose_filename . ".final") if $compose;
1713 }
1714
1715 $smtp->quit if $smtp;
1716
1717 sub apply_transfer_encoding {
1718         my $message = shift;
1719         my $from = shift;
1720         my $to = shift;
1721
1722         return $message if ($from eq $to and $from ne '7bit');
1723
1724         require MIME::QuotedPrint;
1725         require MIME::Base64;
1726
1727         $message = MIME::QuotedPrint::decode($message)
1728                 if ($from eq 'quoted-printable');
1729         $message = MIME::Base64::decode($message)
1730                 if ($from eq 'base64');
1731
1732         die __("cannot send message as 7bit")
1733                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1734         return $message
1735                 if ($to eq '7bit' or $to eq '8bit');
1736         return MIME::QuotedPrint::encode($message, "\n", 0)
1737                 if ($to eq 'quoted-printable');
1738         return MIME::Base64::encode($message, "\n")
1739                 if ($to eq 'base64');
1740         die __("invalid transfer encoding");
1741 }
1742
1743 sub unique_email_list {
1744         my %seen;
1745         my @emails;
1746
1747         foreach my $entry (@_) {
1748                 my $clean = extract_valid_address_or_die($entry);
1749                 $seen{$clean} ||= 0;
1750                 next if $seen{$clean}++;
1751                 push @emails, $entry;
1752         }
1753         return @emails;
1754 }
1755
1756 sub validate_patch {
1757         my $fn = shift;
1758         open(my $fh, '<', $fn)
1759                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1760         while (my $line = <$fh>) {
1761                 if (length($line) > 998) {
1762                         return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1763                 }
1764         }
1765         return;
1766 }
1767
1768 sub handle_backup {
1769         my ($last, $lastlen, $file, $known_suffix) = @_;
1770         my ($suffix, $skip);
1771
1772         $skip = 0;
1773         if (defined $last &&
1774             ($lastlen < length($file)) &&
1775             (substr($file, 0, $lastlen) eq $last) &&
1776             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1777                 if (defined $known_suffix && $suffix eq $known_suffix) {
1778                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1779                         $skip = 1;
1780                 } else {
1781                         # TRANSLATORS: please keep "[y|N]" as is.
1782                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1783                                          valid_re => qr/^(?:y|n)/i,
1784                                          default => 'n');
1785                         $skip = ($answer ne 'y');
1786                         if ($skip) {
1787                                 $known_suffix = $suffix;
1788                         }
1789                 }
1790         }
1791         return ($skip, $known_suffix);
1792 }
1793
1794 sub handle_backup_files {
1795         my @file = @_;
1796         my ($last, $lastlen, $known_suffix, $skip, @result);
1797         for my $file (@file) {
1798                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1799                                                        $file, $known_suffix);
1800                 push @result, $file unless $skip;
1801                 $last = $file;
1802                 $lastlen = length($file);
1803         }
1804         return @result;
1805 }
1806
1807 sub file_has_nonascii {
1808         my $fn = shift;
1809         open(my $fh, '<', $fn)
1810                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1811         while (my $line = <$fh>) {
1812                 return 1 if $line =~ /[^[:ascii:]]/;
1813         }
1814         return 0;
1815 }
1816
1817 sub body_or_subject_has_nonascii {
1818         my $fn = shift;
1819         open(my $fh, '<', $fn)
1820                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1821         while (my $line = <$fh>) {
1822                 last if $line =~ /^$/;
1823                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1824         }
1825         while (my $line = <$fh>) {
1826                 return 1 if $line =~ /[^[:ascii:]]/;
1827         }
1828         return 0;
1829 }