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