git.oblomov.eu Git - git/blob - git-send-email.perl

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