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