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