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 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 $have_mail_address = eval { require Mail::Address; 1 };
 159 my $smtp;
 160 my $auth;
 161 my $num_sent = 0;
 162
 163 # Regexes for RFC 2047 productions.
 164 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
 165 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
 166 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
 167
 168 # Variables we fill in automatically, or via prompting:
 169 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
 170         $initial_reply_to,$initial_subject,@files,
 171         $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
 172
 173 my $envelope_sender;
 174
 175 # Example reply to:
 176 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
 177
 178 my $repo = eval { Git->repository() };
 179 my @repo = $repo ? ($repo) : ();
 180 my $term = eval {
 181         $ENV{"GIT_SEND_EMAIL_NOTTY"}
 182                 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
 183                 : new Term::ReadLine 'git-send-email';
 184 };
 185 if ($@) {
 186         $term = new FakeTerm "$@: going non-interactive";
 187 }
 188
 189 # Behavior modification variables
 190 my ($quiet, $dry_run) = (0, 0);
 191 my $format_patch;
 192 my $compose_filename;
 193 my $force = 0;
 194 my $dump_aliases = 0;
 195
 196 # Handle interactive edition of files.
 197 my $multiedit;
 198 my $editor;
 199
 200 sub do_edit {
 201         if (!defined($editor)) {
 202                 $editor = Git::command_oneline('var', 'GIT_EDITOR');
 203         }
 204         if (defined($multiedit) && !$multiedit) {
 205                 map {
 206                         system('sh', '-c', $editor.' "$@"', $editor, $_);
 207                         if (($? & 127) || ($? >> 8)) {
 208                                 die(__("the editor exited uncleanly, aborting everything"));
 209                         }
 210                 } @_;
 211         } else {
 212                 system('sh', '-c', $editor.' "$@"', $editor, @_);
 213                 if (($? & 127) || ($? >> 8)) {
 214                         die(__("the editor exited uncleanly, aborting everything"));
 215                 }
 216         }
 217 }
 218
 219 # Variables with corresponding config settings
 220 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
 221 my ($cover_cc, $cover_to);
 222 my ($to_cmd, $cc_cmd);
 223 my ($smtp_server, $smtp_server_port, @smtp_server_options);
 224 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
 225 my ($batch_size, $relogin_delay);
 226 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
 227 my ($validate, $confirm);
 228 my (@suppress_cc);
 229 my ($auto_8bit_encoding);
 230 my ($compose_encoding);
 231 my ($target_xfer_encoding);
 232
 233 my ($debug_net_smtp) = 0;               # Net::SMTP, see send_message()
 234
 235 my %config_bool_settings = (
 236     "thread" => [\$thread, 1],
 237     "chainreplyto" => [\$chain_reply_to, 0],
 238     "suppressfrom" => [\$suppress_from, undef],
 239     "signedoffbycc" => [\$signed_off_by_cc, undef],
 240     "cccover" => [\$cover_cc, undef],
 241     "tocover" => [\$cover_to, undef],
 242     "signedoffcc" => [\$signed_off_by_cc, undef],      # Deprecated
 243     "validate" => [\$validate, 1],
 244     "multiedit" => [\$multiedit, undef],
 245     "annotate" => [\$annotate, undef],
 246     "xmailer" => [\$use_xmailer, 1]
 247 );
 248
 249 my %config_settings = (
 250     "smtpserver" => \$smtp_server,
 251     "smtpserverport" => \$smtp_server_port,
 252     "smtpserveroption" => \@smtp_server_options,
 253     "smtpuser" => \$smtp_authuser,
 254     "smtppass" => \$smtp_authpass,
 255     "smtpdomain" => \$smtp_domain,
 256     "smtpauth" => \$smtp_auth,
 257     "smtpbatchsize" => \$batch_size,
 258     "smtprelogindelay" => \$relogin_delay,
 259     "to" => \@initial_to,
 260     "tocmd" => \$to_cmd,
 261     "cc" => \@initial_cc,
 262     "cccmd" => \$cc_cmd,
 263     "aliasfiletype" => \$aliasfiletype,
 264     "bcc" => \@bcclist,
 265     "suppresscc" => \@suppress_cc,
 266     "envelopesender" => \$envelope_sender,
 267     "confirm"   => \$confirm,
 268     "from" => \$sender,
 269     "assume8bitencoding" => \$auto_8bit_encoding,
 270     "composeencoding" => \$compose_encoding,
 271     "transferencoding" => \$target_xfer_encoding,
 272 );
 273
 274 my %config_path_settings = (
 275     "aliasesfile" => \@alias_files,
 276     "smtpsslcertpath" => \$smtp_ssl_cert_path,
 277 );
 278
 279 # Handle Uncouth Termination
 280 sub signal_handler {
 281
 282         # Make text normal
 283         print color("reset"), "\n";
 284
 285         # SMTP password masked
 286         system "stty echo";
 287
 288         # tmp files from --compose
 289         if (defined $compose_filename) {
 290                 if (-e $compose_filename) {
 291                         printf __("'%s' contains an intermediate version ".
 292                                   "of the email you were composing.\n"),
 293                                   $compose_filename;
 294                 }
 295                 if (-e ($compose_filename . ".final")) {
 296                         printf __("'%s.final' contains the composed email.\n"),
 297                                   $compose_filename;
 298                 }
 299         }
 300
 301         exit;
 302 };
 303
 304 $SIG{TERM} = \&signal_handler;
 305 $SIG{INT}  = \&signal_handler;
 306
 307 # Begin by accumulating all the variables (defined above), that we will end up
 308 # needing, first, from the command line:
 309
 310 my $help;
 311 my $rc = GetOptions("h" => \$help,
 312                     "dump-aliases" => \$dump_aliases);
 313 usage() unless $rc;
 314 die __("--dump-aliases incompatible with other options\n")
 315     if !$help and $dump_aliases and @ARGV;
 316 $rc = GetOptions(
 317                     "sender|from=s" => \$sender,
 318                     "in-reply-to=s" => \$initial_reply_to,
 319                     "subject=s" => \$initial_subject,
 320                     "to=s" => \@initial_to,
 321                     "to-cmd=s" => \$to_cmd,
 322                     "no-to" => \$no_to,
 323                     "cc=s" => \@initial_cc,
 324                     "no-cc" => \$no_cc,
 325                     "bcc=s" => \@bcclist,
 326                     "no-bcc" => \$no_bcc,
 327                     "chain-reply-to!" => \$chain_reply_to,
 328                     "no-chain-reply-to" => sub {$chain_reply_to = 0},
 329                     "smtp-server=s" => \$smtp_server,
 330                     "smtp-server-option=s" => \@smtp_server_options,
 331                     "smtp-server-port=s" => \$smtp_server_port,
 332                     "smtp-user=s" => \$smtp_authuser,
 333                     "smtp-pass:s" => \$smtp_authpass,
 334                     "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
 335                     "smtp-encryption=s" => \$smtp_encryption,
 336                     "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
 337                     "smtp-debug:i" => \$debug_net_smtp,
 338                     "smtp-domain:s" => \$smtp_domain,
 339                     "smtp-auth=s" => \$smtp_auth,
 340                     "identity=s" => \$identity,
 341                     "annotate!" => \$annotate,
 342                     "no-annotate" => sub {$annotate = 0},
 343                     "compose" => \$compose,
 344                     "quiet" => \$quiet,
 345                     "cc-cmd=s" => \$cc_cmd,
 346                     "suppress-from!" => \$suppress_from,
 347                     "no-suppress-from" => sub {$suppress_from = 0},
 348                     "suppress-cc=s" => \@suppress_cc,
 349                     "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
 350                     "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
 351                     "cc-cover|cc-cover!" => \$cover_cc,
 352                     "no-cc-cover" => sub {$cover_cc = 0},
 353                     "to-cover|to-cover!" => \$cover_to,
 354                     "no-to-cover" => sub {$cover_to = 0},
 355                     "confirm=s" => \$confirm,
 356                     "dry-run" => \$dry_run,
 357                     "envelope-sender=s" => \$envelope_sender,
 358                     "thread!" => \$thread,
 359                     "no-thread" => sub {$thread = 0},
 360                     "validate!" => \$validate,
 361                     "no-validate" => sub {$validate = 0},
 362                     "transfer-encoding=s" => \$target_xfer_encoding,
 363                     "format-patch!" => \$format_patch,
 364                     "no-format-patch" => sub {$format_patch = 0},
 365                     "8bit-encoding=s" => \$auto_8bit_encoding,
 366                     "compose-encoding=s" => \$compose_encoding,
 367                     "force" => \$force,
 368                     "xmailer!" => \$use_xmailer,
 369                     "no-xmailer" => sub {$use_xmailer = 0},
 370                     "batch-size=i" => \$batch_size,
 371                     "relogin-delay=i" => \$relogin_delay,
 372          );
 373
 374 usage() if $help;
 375 unless ($rc) {
 376     usage();
 377 }
 378
 379 die __("Cannot run git format-patch from outside a repository\n")
 380         if $format_patch and not $repo;
 381
 382 # Now, let's fill any that aren't set in with defaults:
 383
 384 sub read_config {
 385         my ($prefix) = @_;
 386
 387         foreach my $setting (keys %config_bool_settings) {
 388                 my $target = $config_bool_settings{$setting}->[0];
 389                 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
 390         }
 391
 392         foreach my $setting (keys %config_path_settings) {
 393                 my $target = $config_path_settings{$setting};
 394                 if (ref($target) eq "ARRAY") {
 395                         unless (@$target) {
 396                                 my @values = Git::config_path(@repo, "$prefix.$setting");
 397                                 @$target = @values if (@values && defined $values[0]);
 398                         }
 399                 }
 400                 else {
 401                         $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
 402                 }
 403         }
 404
 405         foreach my $setting (keys %config_settings) {
 406                 my $target = $config_settings{$setting};
 407                 next if $setting eq "to" and defined $no_to;
 408                 next if $setting eq "cc" and defined $no_cc;
 409                 next if $setting eq "bcc" and defined $no_bcc;
 410                 if (ref($target) eq "ARRAY") {
 411                         unless (@$target) {
 412                                 my @values = Git::config(@repo, "$prefix.$setting");
 413                                 @$target = @values if (@values && defined $values[0]);
 414                         }
 415                 }
 416                 else {
 417                         $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
 418                 }
 419         }
 420
 421         if (!defined $smtp_encryption) {
 422                 my $enc = Git::config(@repo, "$prefix.smtpencryption");
 423                 if (defined $enc) {
 424                         $smtp_encryption = $enc;
 425                 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
 426                         $smtp_encryption = 'ssl';
 427                 }
 428         }
 429 }
 430
 431 # read configuration from [sendemail "$identity"], fall back on [sendemail]
 432 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
 433 read_config("sendemail.$identity") if (defined $identity);
 434 read_config("sendemail");
 435
 436 # fall back on builtin bool defaults
 437 foreach my $setting (values %config_bool_settings) {
 438         ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
 439 }
 440
 441 # 'default' encryption is none -- this only prevents a warning
 442 $smtp_encryption = '' unless (defined $smtp_encryption);
 443
 444 # Set CC suppressions
 445 my(%suppress_cc);
 446 if (@suppress_cc) {
 447         foreach my $entry (@suppress_cc) {
 448                 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
 449                         unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
 450                 $suppress_cc{$entry} = 1;
 451         }
 452 }
 453
 454 if ($suppress_cc{'all'}) {
 455         foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
 456                 $suppress_cc{$entry} = 1;
 457         }
 458         delete $suppress_cc{'all'};
 459 }
 460
 461 # If explicit old-style ones are specified, they trump --suppress-cc.
 462 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
 463 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
 464
 465 if ($suppress_cc{'body'}) {
 466         foreach my $entry (qw (sob bodycc)) {
 467                 $suppress_cc{$entry} = 1;
 468         }
 469         delete $suppress_cc{'body'};
 470 }
 471
 472 # Set confirm's default value
 473 my $confirm_unconfigured = !defined $confirm;
 474 if ($confirm_unconfigured) {
 475         $confirm = scalar %suppress_cc ? 'compose' : 'auto';
 476 };
 477 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
 478         unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
 479
 480 # Debugging, print out the suppressions.
 481 if (0) {
 482         print "suppressions:\n";
 483         foreach my $entry (keys %suppress_cc) {
 484                 printf "  %-5s -> $suppress_cc{$entry}\n", $entry;
 485         }
 486 }
 487
 488 my ($repoauthor, $repocommitter);
 489 ($repoauthor) = Git::ident_person(@repo, 'author');
 490 ($repocommitter) = Git::ident_person(@repo, 'committer');
 491
 492 sub parse_address_line {
 493         if ($have_mail_address) {
 494                 return map { $_->format } Mail::Address->parse($_[0]);
 495         } else {
 496                 return Git::parse_mailboxes($_[0]);
 497         }
 498 }
 499
 500 sub split_addrs {
 501         return quotewords('\s*,\s*', 1, @_);
 502 }
 503
 504 my %aliases;
 505
 506 sub parse_sendmail_alias {
 507         local $_ = shift;
 508         if (/"/) {
 509                 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
 510         } elsif (/:include:/) {
 511                 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
 512         } elsif (/[\/|]/) {
 513                 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
 514         } elsif (/^(\S+?)\s*:\s*(.+)$/) {
 515                 my ($alias, $addr) = ($1, $2);
 516                 $aliases{$alias} = [ split_addrs($addr) ];
 517         } else {
 518                 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
 519         }
 520 }
 521
 522 sub parse_sendmail_aliases {
 523         my $fh = shift;
 524         my $s = '';
 525         while (<$fh>) {
 526                 chomp;
 527                 next if /^\s*$/ || /^\s*#/;
 528                 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
 529                 parse_sendmail_alias($s) if $s;
 530                 $s = $_;
 531         }
 532         $s =~ s/\\$//; # silently tolerate stray '\' on last line
 533         parse_sendmail_alias($s) if $s;
 534 }
 535
 536 my %parse_alias = (
 537         # multiline formats can be supported in the future
 538         mutt => sub { my $fh = shift; while (<$fh>) {
 539                 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
 540                         my ($alias, $addr) = ($1, $2);
 541                         $addr =~ s/#.*$//; # mutt allows # comments
 542                         # commas delimit multiple addresses
 543                         my @addr = split_addrs($addr);
 544
 545                         # quotes may be escaped in the file,
 546                         # unescape them so we do not double-escape them later.
 547                         s/\\"/"/g foreach @addr;
 548                         $aliases{$alias} = \@addr
 549                 }}},
 550         mailrc => sub { my $fh = shift; while (<$fh>) {
 551                 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
 552                         # spaces delimit multiple addresses
 553                         $aliases{$1} = [ quotewords('\s+', 0, $2) ];
 554                 }}},
 555         pine => sub { my $fh = shift; my $f='\t[^\t]*';
 556                 for (my $x = ''; defined($x); $x = $_) {
 557                         chomp $x;
 558                         $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
 559                         $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
 560                         $aliases{$1} = [ split_addrs($2) ];
 561                 }},
 562         elm => sub  { my $fh = shift;
 563                       while (<$fh>) {
 564                           if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
 565                               my ($alias, $addr) = ($1, $2);
 566                                $aliases{$alias} = [ split_addrs($addr) ];
 567                           }
 568                       } },
 569         sendmail => \&parse_sendmail_aliases,
 570         gnus => sub { my $fh = shift; while (<$fh>) {
 571                 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
 572                         $aliases{$1} = [ $2 ];
 573                 }}}
 574 );
 575
 576 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
 577         foreach my $file (@alias_files) {
 578                 open my $fh, '<', $file or die "opening $file: $!\n";
 579                 $parse_alias{$aliasfiletype}->($fh);
 580                 close $fh;
 581         }
 582 }
 583
 584 if ($dump_aliases) {
 585     print "$_\n" for (sort keys %aliases);
 586     exit(0);
 587 }
 588
 589 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
 590 # $f is a revision list specification to be passed to format-patch.
 591 sub is_format_patch_arg {
 592         return unless $repo;
 593         my $f = shift;
 594         try {
 595                 $repo->command('rev-parse', '--verify', '--quiet', $f);
 596                 if (defined($format_patch)) {
 597                         return $format_patch;
 598                 }
 599                 die sprintf(__ <<EOF, $f, $f);
 600 File '%s' exists but it could also be the range of commits
 601 to produce patches for.  Please disambiguate by...
 602
 603     * Saying "./%s" if you mean a file; or
 604     * Giving --format-patch option if you mean a range.
 605 EOF
 606         } catch Git::Error::Command with {
 607                 # Not a valid revision.  Treat it as a filename.
 608                 return 0;
 609         }
 610 }
 611
 612 # Now that all the defaults are set, process the rest of the command line
 613 # arguments and collect up the files that need to be processed.
 614 my @rev_list_opts;
 615 while (defined(my $f = shift @ARGV)) {
 616         if ($f eq "--") {
 617                 push @rev_list_opts, "--", @ARGV;
 618                 @ARGV = ();
 619         } elsif (-d $f and !is_format_patch_arg($f)) {
 620                 opendir my $dh, $f
 621                         or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
 622
 623                 push @files, grep { -f $_ } map { catfile($f, $_) }
 624                                 sort readdir $dh;
 625                 closedir $dh;
 626         } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
 627                 push @files, $f;
 628         } else {
 629                 push @rev_list_opts, $f;
 630         }
 631 }
 632
 633 if (@rev_list_opts) {
 634         die __("Cannot run git format-patch from outside a repository\n")
 635                 unless $repo;
 636         push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
 637 }
 638
 639 @files = handle_backup_files(@files);
 640
 641 if ($validate) {
 642         foreach my $f (@files) {
 643                 unless (-p $f) {
 644                         my $error = validate_patch($f);
 645                         $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
 646                                                   $f, $error);
 647                 }
 648         }
 649 }
 650
 651 if (@files) {
 652         unless ($quiet) {
 653                 print $_,"\n" for (@files);
 654         }
 655 } else {
 656         print STDERR __("\nNo patch files specified!\n\n");
 657         usage();
 658 }
 659
 660 sub get_patch_subject {
 661         my $fn = shift;
 662         open (my $fh, '<', $fn);
 663         while (my $line = <$fh>) {
 664                 next unless ($line =~ /^Subject: (.*)$/);
 665                 close $fh;
 666                 return "GIT: $1\n";
 667         }
 668         close $fh;
 669         die sprintf(__("No subject line in %s?"), $fn);
 670 }
 671
 672 if ($compose) {
 673         # Note that this does not need to be secure, but we will make a small
 674         # effort to have it be unique
 675         $compose_filename = ($repo ?
 676                 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
 677                 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
 678         open my $c, ">", $compose_filename
 679                 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 680
 681
 682         my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
 683         my $tpl_subject = $initial_subject || '';
 684         my $tpl_reply_to = $initial_reply_to || '';
 685
 686         print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
 687 From $tpl_sender # This line is ignored.
 688 EOT1
 689 Lines beginning in "GIT:" will be removed.
 690 Consider including an overall diffstat or table of contents
 691 for the patch you are writing.
 692
 693 Clear the body content if you don't wish to send a summary.
 694 EOT2
 695 From: $tpl_sender
 696 Subject: $tpl_subject
 697 In-Reply-To: $tpl_reply_to
 698
 699 EOT3
 700         for my $f (@files) {
 701                 print $c get_patch_subject($f);
 702         }
 703         close $c;
 704
 705         if ($annotate) {
 706                 do_edit($compose_filename, @files);
 707         } else {
 708                 do_edit($compose_filename);
 709         }
 710
 711         open my $c2, ">", $compose_filename . ".final"
 712                 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 713
 714         open $c, "<", $compose_filename
 715                 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 716
 717         my $need_8bit_cte = file_has_nonascii($compose_filename);
 718         my $in_body = 0;
 719         my $summary_empty = 1;
 720         if (!defined $compose_encoding) {
 721                 $compose_encoding = "UTF-8";
 722         }
 723         while(<$c>) {
 724                 next if m/^GIT:/;
 725                 if ($in_body) {
 726                         $summary_empty = 0 unless (/^\n$/);
 727                 } elsif (/^\n$/) {
 728                         $in_body = 1;
 729                         if ($need_8bit_cte) {
 730                                 print $c2 "MIME-Version: 1.0\n",
 731                                          "Content-Type: text/plain; ",
 732                                            "charset=$compose_encoding\n",
 733                                          "Content-Transfer-Encoding: 8bit\n";
 734                         }
 735                 } elsif (/^MIME-Version:/i) {
 736                         $need_8bit_cte = 0;
 737                 } elsif (/^Subject:\s*(.+)\s*$/i) {
 738                         $initial_subject = $1;
 739                         my $subject = $initial_subject;
 740                         $_ = "Subject: " .
 741                                 quote_subject($subject, $compose_encoding) .
 742                                 "\n";
 743                 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
 744                         $initial_reply_to = $1;
 745                         next;
 746                 } elsif (/^From:\s*(.+)\s*$/i) {
 747                         $sender = $1;
 748                         next;
 749                 } elsif (/^(?:To|Cc|Bcc):/i) {
 750                         print __("To/Cc/Bcc fields are not interpreted yet, they have been ignored\n");
 751                         next;
 752                 }
 753                 print $c2 $_;
 754         }
 755         close $c;
 756         close $c2;
 757
 758         if ($summary_empty) {
 759                 print __("Summary email is empty, skipping it\n");
 760                 $compose = -1;
 761         }
 762 } elsif ($annotate) {
 763         do_edit(@files);
 764 }
 765
 766 sub ask {
 767         my ($prompt, %arg) = @_;
 768         my $valid_re = $arg{valid_re};
 769         my $default = $arg{default};
 770         my $confirm_only = $arg{confirm_only};
 771         my $resp;
 772         my $i = 0;
 773         return defined $default ? $default : undef
 774                 unless defined $term->IN and defined fileno($term->IN) and
 775                        defined $term->OUT and defined fileno($term->OUT);
 776         while ($i++ < 10) {
 777                 $resp = $term->readline($prompt);
 778                 if (!defined $resp) { # EOF
 779                         print "\n";
 780                         return defined $default ? $default : undef;
 781                 }
 782                 if ($resp eq '' and defined $default) {
 783                         return $default;
 784                 }
 785                 if (!defined $valid_re or $resp =~ /$valid_re/) {
 786                         return $resp;
 787                 }
 788                 if ($confirm_only) {
 789                         my $yesno = $term->readline(
 790                                 # TRANSLATORS: please keep [y/N] as is.
 791                                 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
 792                         if (defined $yesno && $yesno =~ /y/i) {
 793                                 return $resp;
 794                         }
 795                 }
 796         }
 797         return;
 798 }
 799
 800 my %broken_encoding;
 801
 802 sub file_declares_8bit_cte {
 803         my $fn = shift;
 804         open (my $fh, '<', $fn);
 805         while (my $line = <$fh>) {
 806                 last if ($line =~ /^$/);
 807                 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
 808         }
 809         close $fh;
 810         return 0;
 811 }
 812
 813 foreach my $f (@files) {
 814         next unless (body_or_subject_has_nonascii($f)
 815                      && !file_declares_8bit_cte($f));
 816         $broken_encoding{$f} = 1;
 817 }
 818
 819 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
 820         print __("The following files are 8bit, but do not declare " .
 821                  "a Content-Transfer-Encoding.\n");
 822         foreach my $f (sort keys %broken_encoding) {
 823                 print "    $f\n";
 824         }
 825         $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
 826                                   valid_re => qr/.{4}/, confirm_only => 1,
 827                                   default => "UTF-8");
 828 }
 829
 830 if (!$force) {
 831         for my $f (@files) {
 832                 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
 833                         die sprintf(__("Refusing to send because the patch\n\t%s\n"
 834                                 . "has the template subject '*** SUBJECT HERE ***'. "
 835                                 . "Pass --force if you really want to send.\n"), $f);
 836                 }
 837         }
 838 }
 839
 840 if (defined $sender) {
 841         $sender =~ s/^\s+|\s+$//g;
 842         ($sender) = expand_aliases($sender);
 843 } else {
 844         $sender = $repoauthor || $repocommitter || '';
 845 }
 846
 847 # $sender could be an already sanitized address
 848 # (e.g. sendemail.from could be manually sanitized by user).
 849 # But it's a no-op to run sanitize_address on an already sanitized address.
 850 $sender = sanitize_address($sender);
 851
 852 my $to_whom = __("To whom should the emails be sent (if anyone)?");
 853 my $prompting = 0;
 854 if (!@initial_to && !defined $to_cmd) {
 855         my $to = ask("$to_whom ",
 856                      default => "",
 857                      valid_re => qr/\@.*\./, confirm_only => 1);
 858         push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
 859         $prompting++;
 860 }
 861
 862 sub expand_aliases {
 863         return map { expand_one_alias($_) } @_;
 864 }
 865
 866 my %EXPANDED_ALIASES;
 867 sub expand_one_alias {
 868         my $alias = shift;
 869         if ($EXPANDED_ALIASES{$alias}) {
 870                 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
 871         }
 872         local $EXPANDED_ALIASES{$alias} = 1;
 873         return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
 874 }
 875
 876 @initial_to = process_address_list(@initial_to);
 877 @initial_cc = process_address_list(@initial_cc);
 878 @bcclist = process_address_list(@bcclist);
 879
 880 if ($thread && !defined $initial_reply_to && $prompting) {
 881         $initial_reply_to = ask(
 882                 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
 883                 default => "",
 884                 valid_re => qr/\@.*\./, confirm_only => 1);
 885 }
 886 if (defined $initial_reply_to) {
 887         $initial_reply_to =~ s/^\s*<?//;
 888         $initial_reply_to =~ s/>?\s*$//;
 889         $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
 890 }
 891
 892 if (!defined $smtp_server) {
 893         foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
 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         if (eval { require Net::Domain; 1 }) {
1149                 my $domain = Net::Domain::domainname();
1150                 $maildomain = $domain if valid_fqdn($domain);
1151         }
1152
1153         return $maildomain;
1154 }
1155
1156 sub maildomain_mta {
1157         my $maildomain;
1158
1159         if (eval { require Net::SMTP; 1 }) {
1160                 for my $host (qw(mailhost localhost)) {
1161                         my $smtp = Net::SMTP->new($host);
1162                         if (defined $smtp) {
1163                                 my $domain = $smtp->domain;
1164                                 $smtp->quit;
1165
1166                                 $maildomain = $domain if valid_fqdn($domain);
1167
1168                                 last if $maildomain;
1169                         }
1170                 }
1171         }
1172
1173         return $maildomain;
1174 }
1175
1176 sub maildomain {
1177         return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1178 }
1179
1180 sub smtp_host_string {
1181         if (defined $smtp_server_port) {
1182                 return "$smtp_server:$smtp_server_port";
1183         } else {
1184                 return $smtp_server;
1185         }
1186 }
1187
1188 # Returns 1 if authentication succeeded or was not necessary
1189 # (smtp_user was not specified), and 0 otherwise.
1190
1191 sub smtp_auth_maybe {
1192         if (!defined $smtp_authuser || $auth) {
1193                 return 1;
1194         }
1195
1196         # Workaround AUTH PLAIN/LOGIN interaction defect
1197         # with Authen::SASL::Cyrus
1198         eval {
1199                 require Authen::SASL;
1200                 Authen::SASL->import(qw(Perl));
1201         };
1202
1203         # Check mechanism naming as defined in:
1204         # https://tools.ietf.org/html/rfc4422#page-8
1205         if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1206                 die "invalid smtp auth: '${smtp_auth}'";
1207         }
1208
1209         # TODO: Authentication may fail not because credentials were
1210         # invalid but due to other reasons, in which we should not
1211         # reject credentials.
1212         $auth = Git::credential({
1213                 'protocol' => 'smtp',
1214                 'host' => smtp_host_string(),
1215                 'username' => $smtp_authuser,
1216                 # if there's no password, "git credential fill" will
1217                 # give us one, otherwise it'll just pass this one.
1218                 'password' => $smtp_authpass
1219         }, sub {
1220                 my $cred = shift;
1221
1222                 if ($smtp_auth) {
1223                         my $sasl = Authen::SASL->new(
1224                                 mechanism => $smtp_auth,
1225                                 callback => {
1226                                         user => $cred->{'username'},
1227                                         pass => $cred->{'password'},
1228                                         authname => $cred->{'username'},
1229                                 }
1230                         );
1231
1232                         return !!$smtp->auth($sasl);
1233                 }
1234
1235                 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1236         });
1237
1238         return $auth;
1239 }
1240
1241 sub ssl_verify_params {
1242         eval {
1243                 require IO::Socket::SSL;
1244                 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1245         };
1246         if ($@) {
1247                 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1248                 return;
1249         }
1250
1251         if (!defined $smtp_ssl_cert_path) {
1252                 # use the OpenSSL defaults
1253                 return (SSL_verify_mode => SSL_VERIFY_PEER());
1254         }
1255
1256         if ($smtp_ssl_cert_path eq "") {
1257                 return (SSL_verify_mode => SSL_VERIFY_NONE());
1258         } elsif (-d $smtp_ssl_cert_path) {
1259                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1260                         SSL_ca_path => $smtp_ssl_cert_path);
1261         } elsif (-f $smtp_ssl_cert_path) {
1262                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1263                         SSL_ca_file => $smtp_ssl_cert_path);
1264         } else {
1265                 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1266         }
1267 }
1268
1269 sub file_name_is_absolute {
1270         my ($path) = @_;
1271
1272         # msys does not grok DOS drive-prefixes
1273         if ($^O eq 'msys') {
1274                 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1275         }
1276
1277         require File::Spec::Functions;
1278         return File::Spec::Functions::file_name_is_absolute($path);
1279 }
1280
1281 # Returns 1 if the message was sent, and 0 otherwise.
1282 # In actuality, the whole program dies when there
1283 # is an error sending a message.
1284
1285 sub send_message {
1286         my @recipients = unique_email_list(@to);
1287         @cc = (grep { my $cc = extract_valid_address_or_die($_);
1288                       not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1289                     }
1290                @cc);
1291         my $to = join (",\n\t", @recipients);
1292         @recipients = unique_email_list(@recipients,@cc,@bcclist);
1293         @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1294         my $date = format_2822_time($time++);
1295         my $gitversion = '@@GIT_VERSION@@';
1296         if ($gitversion =~ m/..GIT_VERSION../) {
1297             $gitversion = Git::version();
1298         }
1299
1300         my $cc = join(",\n\t", unique_email_list(@cc));
1301         my $ccline = "";
1302         if ($cc ne '') {
1303                 $ccline = "\nCc: $cc";
1304         }
1305         make_message_id() unless defined($message_id);
1306
1307         my $header = "From: $sender
1308 To: $to${ccline}
1309 Subject: $subject
1310 Date: $date
1311 Message-Id: $message_id
1312 ";
1313         if ($use_xmailer) {
1314                 $header .= "X-Mailer: git-send-email $gitversion\n";
1315         }
1316         if ($reply_to) {
1317
1318                 $header .= "In-Reply-To: $reply_to\n";
1319                 $header .= "References: $references\n";
1320         }
1321         if (@xh) {
1322                 $header .= join("\n", @xh) . "\n";
1323         }
1324
1325         my @sendmail_parameters = ('-i', @recipients);
1326         my $raw_from = $sender;
1327         if (defined $envelope_sender && $envelope_sender ne "auto") {
1328                 $raw_from = $envelope_sender;
1329         }
1330         $raw_from = extract_valid_address($raw_from);
1331         unshift (@sendmail_parameters,
1332                         '-f', $raw_from) if(defined $envelope_sender);
1333
1334         if ($needs_confirm && !$dry_run) {
1335                 print "\n$header\n";
1336                 if ($needs_confirm eq "inform") {
1337                         $confirm_unconfigured = 0; # squelch this message for the rest of this run
1338                         $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1339                         print __ <<EOF ;
1340     The Cc list above has been expanded by additional
1341     addresses found in the patch commit message. By default
1342     send-email prompts before sending whenever this occurs.
1343     This behavior is controlled by the sendemail.confirm
1344     configuration setting.
1345
1346     For additional information, run 'git send-email --help'.
1347     To retain the current behavior, but squelch this message,
1348     run 'git config --global sendemail.confirm auto'.
1349
1350 EOF
1351                 }
1352                 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1353                 # translation. The program will only accept English input
1354                 # at this point.
1355                 $_ = ask(__("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1356                          valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1357                          default => $ask_default);
1358                 die __("Send this email reply required") unless defined $_;
1359                 if (/^n/i) {
1360                         return 0;
1361                 } elsif (/^q/i) {
1362                         cleanup_compose_files();
1363                         exit(0);
1364                 } elsif (/^a/i) {
1365                         $confirm = 'never';
1366                 }
1367         }
1368
1369         unshift (@sendmail_parameters, @smtp_server_options);
1370
1371         if ($dry_run) {
1372                 # We don't want to send the email.
1373         } elsif (file_name_is_absolute($smtp_server)) {
1374                 my $pid = open my $sm, '|-';
1375                 defined $pid or die $!;
1376                 if (!$pid) {
1377                         exec($smtp_server, @sendmail_parameters) or die $!;
1378                 }
1379                 print $sm "$header\n$message";
1380                 close $sm or die $!;
1381         } else {
1382
1383                 if (!defined $smtp_server) {
1384                         die __("The required SMTP server is not properly defined.")
1385                 }
1386
1387                 require Net::SMTP;
1388                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1389                 $smtp_domain ||= maildomain();
1390
1391                 if ($smtp_encryption eq 'ssl') {
1392                         $smtp_server_port ||= 465; # ssmtp
1393                         require IO::Socket::SSL;
1394
1395                         # Suppress "variable accessed once" warning.
1396                         {
1397                                 no warnings 'once';
1398                                 $IO::Socket::SSL::DEBUG = 1;
1399                         }
1400
1401                         # Net::SMTP::SSL->new() does not forward any SSL options
1402                         IO::Socket::SSL::set_client_defaults(
1403                                 ssl_verify_params());
1404
1405                         if ($use_net_smtp_ssl) {
1406                                 require Net::SMTP::SSL;
1407                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1408                                                               Hello => $smtp_domain,
1409                                                               Port => $smtp_server_port,
1410                                                               Debug => $debug_net_smtp);
1411                         }
1412                         else {
1413                                 $smtp ||= Net::SMTP->new($smtp_server,
1414                                                          Hello => $smtp_domain,
1415                                                          Port => $smtp_server_port,
1416                                                          Debug => $debug_net_smtp,
1417                                                          SSL => 1);
1418                         }
1419                 }
1420                 else {
1421                         $smtp_server_port ||= 25;
1422                         $smtp ||= Net::SMTP->new($smtp_server,
1423                                                  Hello => $smtp_domain,
1424                                                  Debug => $debug_net_smtp,
1425                                                  Port => $smtp_server_port);
1426                         if ($smtp_encryption eq 'tls' && $smtp) {
1427                                 if ($use_net_smtp_ssl) {
1428                                         $smtp->command('STARTTLS');
1429                                         $smtp->response();
1430                                         if ($smtp->code != 220) {
1431                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1432                                         }
1433                                         require Net::SMTP::SSL;
1434                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1435                                                                           ssl_verify_params())
1436                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1437                                 }
1438                                 else {
1439                                         $smtp->starttls(ssl_verify_params())
1440                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1441                                 }
1442                                 $smtp_encryption = '';
1443                                 # Send EHLO again to receive fresh
1444                                 # supported commands
1445                                 $smtp->hello($smtp_domain);
1446                         }
1447                 }
1448
1449                 if (!$smtp) {
1450                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1451                             " VALUES: server=$smtp_server ",
1452                             "encryption=$smtp_encryption ",
1453                             "hello=$smtp_domain",
1454                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1455                 }
1456
1457                 smtp_auth_maybe or die $smtp->message;
1458
1459                 $smtp->mail( $raw_from ) or die $smtp->message;
1460                 $smtp->to( @recipients ) or die $smtp->message;
1461                 $smtp->data or die $smtp->message;
1462                 $smtp->datasend("$header\n") or die $smtp->message;
1463                 my @lines = split /^/, $message;
1464                 foreach my $line (@lines) {
1465                         $smtp->datasend("$line") or die $smtp->message;
1466                 }
1467                 $smtp->dataend() or die $smtp->message;
1468                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1469         }
1470         if ($quiet) {
1471                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1472         } else {
1473                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1474                 if (!file_name_is_absolute($smtp_server)) {
1475                         print "Server: $smtp_server\n";
1476                         print "MAIL FROM:<$raw_from>\n";
1477                         foreach my $entry (@recipients) {
1478                             print "RCPT TO:<$entry>\n";
1479                         }
1480                 } else {
1481                         print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1482                 }
1483                 print $header, "\n";
1484                 if ($smtp) {
1485                         print __("Result: "), $smtp->code, ' ',
1486                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1487                 } else {
1488                         print __("Result: OK\n");
1489                 }
1490         }
1491
1492         return 1;
1493 }
1494
1495 $reply_to = $initial_reply_to;
1496 $references = $initial_reply_to || '';
1497 $subject = $initial_subject;
1498 $message_num = 0;
1499
1500 foreach my $t (@files) {
1501         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1502
1503         my $author = undef;
1504         my $sauthor = undef;
1505         my $author_encoding;
1506         my $has_content_type;
1507         my $body_encoding;
1508         my $xfer_encoding;
1509         my $has_mime_version;
1510         @to = ();
1511         @cc = ();
1512         @xh = ();
1513         my $input_format = undef;
1514         my @header = ();
1515         $message = "";
1516         $message_num++;
1517         # First unfold multiline header fields
1518         while(<$fh>) {
1519                 last if /^\s*$/;
1520                 if (/^\s+\S/ and @header) {
1521                         chomp($header[$#header]);
1522                         s/^\s+/ /;
1523                         $header[$#header] .= $_;
1524             } else {
1525                         push(@header, $_);
1526                 }
1527         }
1528         # Now parse the header
1529         foreach(@header) {
1530                 if (/^From /) {
1531                         $input_format = 'mbox';
1532                         next;
1533                 }
1534                 chomp;
1535                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1536                         $input_format = 'mbox';
1537                 }
1538
1539                 if (defined $input_format && $input_format eq 'mbox') {
1540                         if (/^Subject:\s+(.*)$/i) {
1541                                 $subject = $1;
1542                         }
1543                         elsif (/^From:\s+(.*)$/i) {
1544                                 ($author, $author_encoding) = unquote_rfc2047($1);
1545                                 $sauthor = sanitize_address($author);
1546                                 next if $suppress_cc{'author'};
1547                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1548                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1549                                         $1, $_) unless $quiet;
1550                                 push @cc, $1;
1551                         }
1552                         elsif (/^To:\s+(.*)$/i) {
1553                                 foreach my $addr (parse_address_line($1)) {
1554                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1555                                                 $addr, $_) unless $quiet;
1556                                         push @to, $addr;
1557                                 }
1558                         }
1559                         elsif (/^Cc:\s+(.*)$/i) {
1560                                 foreach my $addr (parse_address_line($1)) {
1561                                         my $qaddr = unquote_rfc2047($addr);
1562                                         my $saddr = sanitize_address($qaddr);
1563                                         if ($saddr eq $sender) {
1564                                                 next if ($suppress_cc{'self'});
1565                                         } else {
1566                                                 next if ($suppress_cc{'cc'});
1567                                         }
1568                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1569                                                 $addr, $_) unless $quiet;
1570                                         push @cc, $addr;
1571                                 }
1572                         }
1573                         elsif (/^Content-type:/i) {
1574                                 $has_content_type = 1;
1575                                 if (/charset="?([^ "]+)/) {
1576                                         $body_encoding = $1;
1577                                 }
1578                                 push @xh, $_;
1579                         }
1580                         elsif (/^MIME-Version/i) {
1581                                 $has_mime_version = 1;
1582                                 push @xh, $_;
1583                         }
1584                         elsif (/^Message-Id: (.*)/i) {
1585                                 $message_id = $1;
1586                         }
1587                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1588                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1589                         }
1590                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1591                                 push @xh, $_;
1592                         }
1593
1594                 } else {
1595                         # In the traditional
1596                         # "send lots of email" format,
1597                         # line 1 = cc
1598                         # line 2 = subject
1599                         # So let's support that, too.
1600                         $input_format = 'lots';
1601                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1602                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1603                                         $_, $_) unless $quiet;
1604                                 push @cc, $_;
1605                         } elsif (!defined $subject) {
1606                                 $subject = $_;
1607                         }
1608                 }
1609         }
1610         # Now parse the message body
1611         while(<$fh>) {
1612                 $message .=  $_;
1613                 if (/^(Signed-off-by|Cc): (.*)/i) {
1614                         chomp;
1615                         my ($what, $c) = ($1, $2);
1616                         # strip garbage for the address we'll use:
1617                         $c = strip_garbage_one_address($c);
1618                         # sanitize a bit more to decide whether to suppress the address:
1619                         my $sc = sanitize_address($c);
1620                         if ($sc eq $sender) {
1621                                 next if ($suppress_cc{'self'});
1622                         } else {
1623                                 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1624                                 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1625                         }
1626                         push @cc, $c;
1627                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1628                                 $c, $_) unless $quiet;
1629                 }
1630         }
1631         close $fh;
1632
1633         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1634                 if defined $to_cmd;
1635         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1636                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1637
1638         if ($broken_encoding{$t} && !$has_content_type) {
1639                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1640                 $has_content_type = 1;
1641                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1642                 $body_encoding = $auto_8bit_encoding;
1643         }
1644
1645         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1646                 $subject = quote_subject($subject, $auto_8bit_encoding);
1647         }
1648
1649         if (defined $sauthor and $sauthor ne $sender) {
1650                 $message = "From: $author\n\n$message";
1651                 if (defined $author_encoding) {
1652                         if ($has_content_type) {
1653                                 if ($body_encoding eq $author_encoding) {
1654                                         # ok, we already have the right encoding
1655                                 }
1656                                 else {
1657                                         # uh oh, we should re-encode
1658                                 }
1659                         }
1660                         else {
1661                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1662                                 $has_content_type = 1;
1663                                 push @xh,
1664                                   "Content-Type: text/plain; charset=$author_encoding";
1665                         }
1666                 }
1667         }
1668         if (defined $target_xfer_encoding) {
1669                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1670                 $message = apply_transfer_encoding(
1671                         $message, $xfer_encoding, $target_xfer_encoding);
1672                 $xfer_encoding = $target_xfer_encoding;
1673         }
1674         if (defined $xfer_encoding) {
1675                 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1676         }
1677         if (defined $xfer_encoding or $has_content_type) {
1678                 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1679         }
1680
1681         $needs_confirm = (
1682                 $confirm eq "always" or
1683                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1684                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1685         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1686
1687         @to = process_address_list(@to);
1688         @cc = process_address_list(@cc);
1689
1690         @to = (@initial_to, @to);
1691         @cc = (@initial_cc, @cc);
1692
1693         if ($message_num == 1) {
1694                 if (defined $cover_cc and $cover_cc) {
1695                         @initial_cc = @cc;
1696                 }
1697                 if (defined $cover_to and $cover_to) {
1698                         @initial_to = @to;
1699                 }
1700         }
1701
1702         my $message_was_sent = send_message();
1703
1704         # set up for the next message
1705         if ($thread && $message_was_sent &&
1706                 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1707                 $message_num == 1)) {
1708                 $reply_to = $message_id;
1709                 if (length $references > 0) {
1710                         $references .= "\n $message_id";
1711                 } else {
1712                         $references = "$message_id";
1713                 }
1714         }
1715         $message_id = undef;
1716         $num_sent++;
1717         if (defined $batch_size && $num_sent == $batch_size) {
1718                 $num_sent = 0;
1719                 $smtp->quit if defined $smtp;
1720                 undef $smtp;
1721                 undef $auth;
1722                 sleep($relogin_delay) if defined $relogin_delay;
1723         }
1724 }
1725
1726 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1727 # and return a results array
1728 sub recipients_cmd {
1729         my ($prefix, $what, $cmd, $file) = @_;
1730
1731         my @addresses = ();
1732         open my $fh, "-|", "$cmd \Q$file\E"
1733             or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1734         while (my $address = <$fh>) {
1735                 $address =~ s/^\s*//g;
1736                 $address =~ s/\s*$//g;
1737                 $address = sanitize_address($address);
1738                 next if ($address eq $sender and $suppress_cc{'self'});
1739                 push @addresses, $address;
1740                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1741                        $prefix, $what, $address, $cmd) unless $quiet;
1742                 }
1743         close $fh
1744             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1745         return @addresses;
1746 }
1747
1748 cleanup_compose_files();
1749
1750 sub cleanup_compose_files {
1751         unlink($compose_filename, $compose_filename . ".final") if $compose;
1752 }
1753
1754 $smtp->quit if $smtp;
1755
1756 sub apply_transfer_encoding {
1757         my $message = shift;
1758         my $from = shift;
1759         my $to = shift;
1760
1761         return $message if ($from eq $to and $from ne '7bit');
1762
1763         require MIME::QuotedPrint;
1764         require MIME::Base64;
1765
1766         $message = MIME::QuotedPrint::decode($message)
1767                 if ($from eq 'quoted-printable');
1768         $message = MIME::Base64::decode($message)
1769                 if ($from eq 'base64');
1770
1771         die __("cannot send message as 7bit")
1772                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1773         return $message
1774                 if ($to eq '7bit' or $to eq '8bit');
1775         return MIME::QuotedPrint::encode($message, "\n", 0)
1776                 if ($to eq 'quoted-printable');
1777         return MIME::Base64::encode($message, "\n")
1778                 if ($to eq 'base64');
1779         die __("invalid transfer encoding");
1780 }
1781
1782 sub unique_email_list {
1783         my %seen;
1784         my @emails;
1785
1786         foreach my $entry (@_) {
1787                 my $clean = extract_valid_address_or_die($entry);
1788                 $seen{$clean} ||= 0;
1789                 next if $seen{$clean}++;
1790                 push @emails, $entry;
1791         }
1792         return @emails;
1793 }
1794
1795 sub validate_patch {
1796         my $fn = shift;
1797
1798         if ($repo) {
1799                 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1800                                             'sendemail-validate');
1801                 my $hook_error;
1802                 if (-x $validate_hook) {
1803                         my $target = abs_path($fn);
1804                         # The hook needs a correct cwd and GIT_DIR.
1805                         my $cwd_save = cwd();
1806                         chdir($repo->wc_path() or $repo->repo_path())
1807                                 or die("chdir: $!");
1808                         local $ENV{"GIT_DIR"} = $repo->repo_path();
1809                         $hook_error = "rejected by sendemail-validate hook"
1810                                 if system($validate_hook, $target);
1811                         chdir($cwd_save) or die("chdir: $!");
1812                 }
1813                 return $hook_error if $hook_error;
1814         }
1815
1816         open(my $fh, '<', $fn)
1817                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1818         while (my $line = <$fh>) {
1819                 if (length($line) > 998) {
1820                         return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1821                 }
1822         }
1823         return;
1824 }
1825
1826 sub handle_backup {
1827         my ($last, $lastlen, $file, $known_suffix) = @_;
1828         my ($suffix, $skip);
1829
1830         $skip = 0;
1831         if (defined $last &&
1832             ($lastlen < length($file)) &&
1833             (substr($file, 0, $lastlen) eq $last) &&
1834             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1835                 if (defined $known_suffix && $suffix eq $known_suffix) {
1836                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1837                         $skip = 1;
1838                 } else {
1839                         # TRANSLATORS: please keep "[y|N]" as is.
1840                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1841                                          valid_re => qr/^(?:y|n)/i,
1842                                          default => 'n');
1843                         $skip = ($answer ne 'y');
1844                         if ($skip) {
1845                                 $known_suffix = $suffix;
1846                         }
1847                 }
1848         }
1849         return ($skip, $known_suffix);
1850 }
1851
1852 sub handle_backup_files {
1853         my @file = @_;
1854         my ($last, $lastlen, $known_suffix, $skip, @result);
1855         for my $file (@file) {
1856                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1857                                                        $file, $known_suffix);
1858                 push @result, $file unless $skip;
1859                 $last = $file;
1860                 $lastlen = length($file);
1861         }
1862         return @result;
1863 }
1864
1865 sub file_has_nonascii {
1866         my $fn = shift;
1867         open(my $fh, '<', $fn)
1868                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1869         while (my $line = <$fh>) {
1870                 return 1 if $line =~ /[^[:ascii:]]/;
1871         }
1872         return 0;
1873 }
1874
1875 sub body_or_subject_has_nonascii {
1876         my $fn = shift;
1877         open(my $fh, '<', $fn)
1878                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1879         while (my $line = <$fh>) {
1880                 last if $line =~ /^$/;
1881                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1882         }
1883         while (my $line = <$fh>) {
1884                 return 1 if $line =~ /[^[:ascii:]]/;
1885         }
1886         return 0;
1887 }