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 sanitize_address_list {
1093         return (map { sanitize_address($_) } @_);
1094 }
1095
1096 sub process_address_list {
1097         my @addr_list = map { parse_address_line($_) } @_;
1098         @addr_list = expand_aliases(@addr_list);
1099         @addr_list = sanitize_address_list(@addr_list);
1100         @addr_list = validate_address_list(@addr_list);
1101         return @addr_list;
1102 }
1103
1104 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1105 #
1106 # Tightly configured MTAa require that a caller sends a real DNS
1107 # domain name that corresponds the IP address in the HELO/EHLO
1108 # handshake. This is used to verify the connection and prevent
1109 # spammers from trying to hide their identity. If the DNS and IP don't
1110 # match, the receiveing MTA may deny the connection.
1111 #
1112 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1113 #
1114 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1115 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1116 #
1117 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1118 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1119
1120 sub valid_fqdn {
1121         my $domain = shift;
1122         return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1123 }
1124
1125 sub maildomain_net {
1126         my $maildomain;
1127
1128         if (eval { require Net::Domain; 1 }) {
1129                 my $domain = Net::Domain::domainname();
1130                 $maildomain = $domain if valid_fqdn($domain);
1131         }
1132
1133         return $maildomain;
1134 }
1135
1136 sub maildomain_mta {
1137         my $maildomain;
1138
1139         if (eval { require Net::SMTP; 1 }) {
1140                 for my $host (qw(mailhost localhost)) {
1141                         my $smtp = Net::SMTP->new($host);
1142                         if (defined $smtp) {
1143                                 my $domain = $smtp->domain;
1144                                 $smtp->quit;
1145
1146                                 $maildomain = $domain if valid_fqdn($domain);
1147
1148                                 last if $maildomain;
1149                         }
1150                 }
1151         }
1152
1153         return $maildomain;
1154 }
1155
1156 sub maildomain {
1157         return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1158 }
1159
1160 sub smtp_host_string {
1161         if (defined $smtp_server_port) {
1162                 return "$smtp_server:$smtp_server_port";
1163         } else {
1164                 return $smtp_server;
1165         }
1166 }
1167
1168 # Returns 1 if authentication succeeded or was not necessary
1169 # (smtp_user was not specified), and 0 otherwise.
1170
1171 sub smtp_auth_maybe {
1172         if (!defined $smtp_authuser || $auth) {
1173                 return 1;
1174         }
1175
1176         # Workaround AUTH PLAIN/LOGIN interaction defect
1177         # with Authen::SASL::Cyrus
1178         eval {
1179                 require Authen::SASL;
1180                 Authen::SASL->import(qw(Perl));
1181         };
1182
1183         # Check mechanism naming as defined in:
1184         # https://tools.ietf.org/html/rfc4422#page-8
1185         if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1186                 die "invalid smtp auth: '${smtp_auth}'";
1187         }
1188
1189         # TODO: Authentication may fail not because credentials were
1190         # invalid but due to other reasons, in which we should not
1191         # reject credentials.
1192         $auth = Git::credential({
1193                 'protocol' => 'smtp',
1194                 'host' => smtp_host_string(),
1195                 'username' => $smtp_authuser,
1196                 # if there's no password, "git credential fill" will
1197                 # give us one, otherwise it'll just pass this one.
1198                 'password' => $smtp_authpass
1199         }, sub {
1200                 my $cred = shift;
1201
1202                 if ($smtp_auth) {
1203                         my $sasl = Authen::SASL->new(
1204                                 mechanism => $smtp_auth,
1205                                 callback => {
1206                                         user => $cred->{'username'},
1207                                         pass => $cred->{'password'},
1208                                         authname => $cred->{'username'},
1209                                 }
1210                         );
1211
1212                         return !!$smtp->auth($sasl);
1213                 }
1214
1215                 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1216         });
1217
1218         return $auth;
1219 }
1220
1221 sub ssl_verify_params {
1222         eval {
1223                 require IO::Socket::SSL;
1224                 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1225         };
1226         if ($@) {
1227                 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1228                 return;
1229         }
1230
1231         if (!defined $smtp_ssl_cert_path) {
1232                 # use the OpenSSL defaults
1233                 return (SSL_verify_mode => SSL_VERIFY_PEER());
1234         }
1235
1236         if ($smtp_ssl_cert_path eq "") {
1237                 return (SSL_verify_mode => SSL_VERIFY_NONE());
1238         } elsif (-d $smtp_ssl_cert_path) {
1239                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1240                         SSL_ca_path => $smtp_ssl_cert_path);
1241         } elsif (-f $smtp_ssl_cert_path) {
1242                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1243                         SSL_ca_file => $smtp_ssl_cert_path);
1244         } else {
1245                 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1246         }
1247 }
1248
1249 sub file_name_is_absolute {
1250         my ($path) = @_;
1251
1252         # msys does not grok DOS drive-prefixes
1253         if ($^O eq 'msys') {
1254                 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1255         }
1256
1257         require File::Spec::Functions;
1258         return File::Spec::Functions::file_name_is_absolute($path);
1259 }
1260
1261 # Returns 1 if the message was sent, and 0 otherwise.
1262 # In actuality, the whole program dies when there
1263 # is an error sending a message.
1264
1265 sub send_message {
1266         my @recipients = unique_email_list(@to);
1267         @cc = (grep { my $cc = extract_valid_address_or_die($_);
1268                       not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1269                     }
1270                @cc);
1271         my $to = join (",\n\t", @recipients);
1272         @recipients = unique_email_list(@recipients,@cc,@bcclist);
1273         @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1274         my $date = format_2822_time($time++);
1275         my $gitversion = '@@GIT_VERSION@@';
1276         if ($gitversion =~ m/..GIT_VERSION../) {
1277             $gitversion = Git::version();
1278         }
1279
1280         my $cc = join(",\n\t", unique_email_list(@cc));
1281         my $ccline = "";
1282         if ($cc ne '') {
1283                 $ccline = "\nCc: $cc";
1284         }
1285         make_message_id() unless defined($message_id);
1286
1287         my $header = "From: $sender
1288 To: $to${ccline}
1289 Subject: $subject
1290 Date: $date
1291 Message-Id: $message_id
1292 ";
1293         if ($use_xmailer) {
1294                 $header .= "X-Mailer: git-send-email $gitversion\n";
1295         }
1296         if ($reply_to) {
1297
1298                 $header .= "In-Reply-To: $reply_to\n";
1299                 $header .= "References: $references\n";
1300         }
1301         if (@xh) {
1302                 $header .= join("\n", @xh) . "\n";
1303         }
1304
1305         my @sendmail_parameters = ('-i', @recipients);
1306         my $raw_from = $sender;
1307         if (defined $envelope_sender && $envelope_sender ne "auto") {
1308                 $raw_from = $envelope_sender;
1309         }
1310         $raw_from = extract_valid_address($raw_from);
1311         unshift (@sendmail_parameters,
1312                         '-f', $raw_from) if(defined $envelope_sender);
1313
1314         if ($needs_confirm && !$dry_run) {
1315                 print "\n$header\n";
1316                 if ($needs_confirm eq "inform") {
1317                         $confirm_unconfigured = 0; # squelch this message for the rest of this run
1318                         $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1319                         print __ <<EOF ;
1320     The Cc list above has been expanded by additional
1321     addresses found in the patch commit message. By default
1322     send-email prompts before sending whenever this occurs.
1323     This behavior is controlled by the sendemail.confirm
1324     configuration setting.
1325
1326     For additional information, run 'git send-email --help'.
1327     To retain the current behavior, but squelch this message,
1328     run 'git config --global sendemail.confirm auto'.
1329
1330 EOF
1331                 }
1332                 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1333                 # translation. The program will only accept English input
1334                 # at this point.
1335                 $_ = ask(__("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1336                          valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1337                          default => $ask_default);
1338                 die __("Send this email reply required") unless defined $_;
1339                 if (/^n/i) {
1340                         return 0;
1341                 } elsif (/^q/i) {
1342                         cleanup_compose_files();
1343                         exit(0);
1344                 } elsif (/^a/i) {
1345                         $confirm = 'never';
1346                 }
1347         }
1348
1349         unshift (@sendmail_parameters, @smtp_server_options);
1350
1351         if ($dry_run) {
1352                 # We don't want to send the email.
1353         } elsif (file_name_is_absolute($smtp_server)) {
1354                 my $pid = open my $sm, '|-';
1355                 defined $pid or die $!;
1356                 if (!$pid) {
1357                         exec($smtp_server, @sendmail_parameters) or die $!;
1358                 }
1359                 print $sm "$header\n$message";
1360                 close $sm or die $!;
1361         } else {
1362
1363                 if (!defined $smtp_server) {
1364                         die __("The required SMTP server is not properly defined.")
1365                 }
1366
1367                 require Net::SMTP;
1368                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1369                 $smtp_domain ||= maildomain();
1370
1371                 if ($smtp_encryption eq 'ssl') {
1372                         $smtp_server_port ||= 465; # ssmtp
1373                         require IO::Socket::SSL;
1374
1375                         # Suppress "variable accessed once" warning.
1376                         {
1377                                 no warnings 'once';
1378                                 $IO::Socket::SSL::DEBUG = 1;
1379                         }
1380
1381                         # Net::SMTP::SSL->new() does not forward any SSL options
1382                         IO::Socket::SSL::set_client_defaults(
1383                                 ssl_verify_params());
1384
1385                         if ($use_net_smtp_ssl) {
1386                                 require Net::SMTP::SSL;
1387                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1388                                                               Hello => $smtp_domain,
1389                                                               Port => $smtp_server_port,
1390                                                               Debug => $debug_net_smtp);
1391                         }
1392                         else {
1393                                 $smtp ||= Net::SMTP->new($smtp_server,
1394                                                          Hello => $smtp_domain,
1395                                                          Port => $smtp_server_port,
1396                                                          Debug => $debug_net_smtp,
1397                                                          SSL => 1);
1398                         }
1399                 }
1400                 else {
1401                         $smtp_server_port ||= 25;
1402                         $smtp ||= Net::SMTP->new($smtp_server,
1403                                                  Hello => $smtp_domain,
1404                                                  Debug => $debug_net_smtp,
1405                                                  Port => $smtp_server_port);
1406                         if ($smtp_encryption eq 'tls' && $smtp) {
1407                                 if ($use_net_smtp_ssl) {
1408                                         $smtp->command('STARTTLS');
1409                                         $smtp->response();
1410                                         if ($smtp->code != 220) {
1411                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1412                                         }
1413                                         require Net::SMTP::SSL;
1414                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1415                                                                           ssl_verify_params())
1416                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1417                                 }
1418                                 else {
1419                                         $smtp->starttls(ssl_verify_params())
1420                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1421                                 }
1422                                 $smtp_encryption = '';
1423                                 # Send EHLO again to receive fresh
1424                                 # supported commands
1425                                 $smtp->hello($smtp_domain);
1426                         }
1427                 }
1428
1429                 if (!$smtp) {
1430                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1431                             " VALUES: server=$smtp_server ",
1432                             "encryption=$smtp_encryption ",
1433                             "hello=$smtp_domain",
1434                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1435                 }
1436
1437                 smtp_auth_maybe or die $smtp->message;
1438
1439                 $smtp->mail( $raw_from ) or die $smtp->message;
1440                 $smtp->to( @recipients ) or die $smtp->message;
1441                 $smtp->data or die $smtp->message;
1442                 $smtp->datasend("$header\n") or die $smtp->message;
1443                 my @lines = split /^/, $message;
1444                 foreach my $line (@lines) {
1445                         $smtp->datasend("$line") or die $smtp->message;
1446                 }
1447                 $smtp->dataend() or die $smtp->message;
1448                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1449         }
1450         if ($quiet) {
1451                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1452         } else {
1453                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1454                 if (!file_name_is_absolute($smtp_server)) {
1455                         print "Server: $smtp_server\n";
1456                         print "MAIL FROM:<$raw_from>\n";
1457                         foreach my $entry (@recipients) {
1458                             print "RCPT TO:<$entry>\n";
1459                         }
1460                 } else {
1461                         print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1462                 }
1463                 print $header, "\n";
1464                 if ($smtp) {
1465                         print __("Result: "), $smtp->code, ' ',
1466                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1467                 } else {
1468                         print __("Result: OK\n");
1469                 }
1470         }
1471
1472         return 1;
1473 }
1474
1475 $reply_to = $initial_reply_to;
1476 $references = $initial_reply_to || '';
1477 $subject = $initial_subject;
1478 $message_num = 0;
1479
1480 foreach my $t (@files) {
1481         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1482
1483         my $author = undef;
1484         my $sauthor = undef;
1485         my $author_encoding;
1486         my $has_content_type;
1487         my $body_encoding;
1488         my $xfer_encoding;
1489         my $has_mime_version;
1490         @to = ();
1491         @cc = ();
1492         @xh = ();
1493         my $input_format = undef;
1494         my @header = ();
1495         $message = "";
1496         $message_num++;
1497         # First unfold multiline header fields
1498         while(<$fh>) {
1499                 last if /^\s*$/;
1500                 if (/^\s+\S/ and @header) {
1501                         chomp($header[$#header]);
1502                         s/^\s+/ /;
1503                         $header[$#header] .= $_;
1504             } else {
1505                         push(@header, $_);
1506                 }
1507         }
1508         # Now parse the header
1509         foreach(@header) {
1510                 if (/^From /) {
1511                         $input_format = 'mbox';
1512                         next;
1513                 }
1514                 chomp;
1515                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1516                         $input_format = 'mbox';
1517                 }
1518
1519                 if (defined $input_format && $input_format eq 'mbox') {
1520                         if (/^Subject:\s+(.*)$/i) {
1521                                 $subject = $1;
1522                         }
1523                         elsif (/^From:\s+(.*)$/i) {
1524                                 ($author, $author_encoding) = unquote_rfc2047($1);
1525                                 $sauthor = sanitize_address($author);
1526                                 next if $suppress_cc{'author'};
1527                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1528                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1529                                         $1, $_) unless $quiet;
1530                                 push @cc, $1;
1531                         }
1532                         elsif (/^To:\s+(.*)$/i) {
1533                                 foreach my $addr (parse_address_line($1)) {
1534                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1535                                                 $addr, $_) unless $quiet;
1536                                         push @to, $addr;
1537                                 }
1538                         }
1539                         elsif (/^Cc:\s+(.*)$/i) {
1540                                 foreach my $addr (parse_address_line($1)) {
1541                                         my $qaddr = unquote_rfc2047($addr);
1542                                         my $saddr = sanitize_address($qaddr);
1543                                         if ($saddr eq $sender) {
1544                                                 next if ($suppress_cc{'self'});
1545                                         } else {
1546                                                 next if ($suppress_cc{'cc'});
1547                                         }
1548                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1549                                                 $addr, $_) unless $quiet;
1550                                         push @cc, $addr;
1551                                 }
1552                         }
1553                         elsif (/^Content-type:/i) {
1554                                 $has_content_type = 1;
1555                                 if (/charset="?([^ "]+)/) {
1556                                         $body_encoding = $1;
1557                                 }
1558                                 push @xh, $_;
1559                         }
1560                         elsif (/^MIME-Version/i) {
1561                                 $has_mime_version = 1;
1562                                 push @xh, $_;
1563                         }
1564                         elsif (/^Message-Id: (.*)/i) {
1565                                 $message_id = $1;
1566                         }
1567                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1568                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1569                         }
1570                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1571                                 push @xh, $_;
1572                         }
1573
1574                 } else {
1575                         # In the traditional
1576                         # "send lots of email" format,
1577                         # line 1 = cc
1578                         # line 2 = subject
1579                         # So let's support that, too.
1580                         $input_format = 'lots';
1581                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1582                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1583                                         $_, $_) unless $quiet;
1584                                 push @cc, $_;
1585                         } elsif (!defined $subject) {
1586                                 $subject = $_;
1587                         }
1588                 }
1589         }
1590         # Now parse the message body
1591         while(<$fh>) {
1592                 $message .=  $_;
1593                 if (/^(Signed-off-by|Cc): ([^>]*>?)/i) {
1594                         chomp;
1595                         my ($what, $c) = ($1, $2);
1596                         chomp $c;
1597                         my $sc = sanitize_address($c);
1598                         if ($sc eq $sender) {
1599                                 next if ($suppress_cc{'self'});
1600                         } else {
1601                                 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1602                                 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1603                         }
1604                         push @cc, $c;
1605                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1606                                 $c, $_) unless $quiet;
1607                 }
1608         }
1609         close $fh;
1610
1611         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1612                 if defined $to_cmd;
1613         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1614                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1615
1616         if ($broken_encoding{$t} && !$has_content_type) {
1617                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1618                 $has_content_type = 1;
1619                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1620                 $body_encoding = $auto_8bit_encoding;
1621         }
1622
1623         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1624                 $subject = quote_subject($subject, $auto_8bit_encoding);
1625         }
1626
1627         if (defined $sauthor and $sauthor ne $sender) {
1628                 $message = "From: $author\n\n$message";
1629                 if (defined $author_encoding) {
1630                         if ($has_content_type) {
1631                                 if ($body_encoding eq $author_encoding) {
1632                                         # ok, we already have the right encoding
1633                                 }
1634                                 else {
1635                                         # uh oh, we should re-encode
1636                                 }
1637                         }
1638                         else {
1639                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1640                                 $has_content_type = 1;
1641                                 push @xh,
1642                                   "Content-Type: text/plain; charset=$author_encoding";
1643                         }
1644                 }
1645         }
1646         if (defined $target_xfer_encoding) {
1647                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1648                 $message = apply_transfer_encoding(
1649                         $message, $xfer_encoding, $target_xfer_encoding);
1650                 $xfer_encoding = $target_xfer_encoding;
1651         }
1652         if (defined $xfer_encoding) {
1653                 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1654         }
1655         if (defined $xfer_encoding or $has_content_type) {
1656                 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1657         }
1658
1659         $needs_confirm = (
1660                 $confirm eq "always" or
1661                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1662                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1663         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1664
1665         @to = process_address_list(@to);
1666         @cc = process_address_list(@cc);
1667
1668         @to = (@initial_to, @to);
1669         @cc = (@initial_cc, @cc);
1670
1671         if ($message_num == 1) {
1672                 if (defined $cover_cc and $cover_cc) {
1673                         @initial_cc = @cc;
1674                 }
1675                 if (defined $cover_to and $cover_to) {
1676                         @initial_to = @to;
1677                 }
1678         }
1679
1680         my $message_was_sent = send_message();
1681
1682         # set up for the next message
1683         if ($thread && $message_was_sent &&
1684                 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1685                 $message_num == 1)) {
1686                 $reply_to = $message_id;
1687                 if (length $references > 0) {
1688                         $references .= "\n $message_id";
1689                 } else {
1690                         $references = "$message_id";
1691                 }
1692         }
1693         $message_id = undef;
1694         $num_sent++;
1695         if (defined $batch_size && $num_sent == $batch_size) {
1696                 $num_sent = 0;
1697                 $smtp->quit if defined $smtp;
1698                 undef $smtp;
1699                 undef $auth;
1700                 sleep($relogin_delay) if defined $relogin_delay;
1701         }
1702 }
1703
1704 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1705 # and return a results array
1706 sub recipients_cmd {
1707         my ($prefix, $what, $cmd, $file) = @_;
1708
1709         my @addresses = ();
1710         open my $fh, "-|", "$cmd \Q$file\E"
1711             or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1712         while (my $address = <$fh>) {
1713                 $address =~ s/^\s*//g;
1714                 $address =~ s/\s*$//g;
1715                 $address = sanitize_address($address);
1716                 next if ($address eq $sender and $suppress_cc{'self'});
1717                 push @addresses, $address;
1718                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1719                        $prefix, $what, $address, $cmd) unless $quiet;
1720                 }
1721         close $fh
1722             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1723         return @addresses;
1724 }
1725
1726 cleanup_compose_files();
1727
1728 sub cleanup_compose_files {
1729         unlink($compose_filename, $compose_filename . ".final") if $compose;
1730 }
1731
1732 $smtp->quit if $smtp;
1733
1734 sub apply_transfer_encoding {
1735         my $message = shift;
1736         my $from = shift;
1737         my $to = shift;
1738
1739         return $message if ($from eq $to and $from ne '7bit');
1740
1741         require MIME::QuotedPrint;
1742         require MIME::Base64;
1743
1744         $message = MIME::QuotedPrint::decode($message)
1745                 if ($from eq 'quoted-printable');
1746         $message = MIME::Base64::decode($message)
1747                 if ($from eq 'base64');
1748
1749         die __("cannot send message as 7bit")
1750                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1751         return $message
1752                 if ($to eq '7bit' or $to eq '8bit');
1753         return MIME::QuotedPrint::encode($message, "\n", 0)
1754                 if ($to eq 'quoted-printable');
1755         return MIME::Base64::encode($message, "\n")
1756                 if ($to eq 'base64');
1757         die __("invalid transfer encoding");
1758 }
1759
1760 sub unique_email_list {
1761         my %seen;
1762         my @emails;
1763
1764         foreach my $entry (@_) {
1765                 my $clean = extract_valid_address_or_die($entry);
1766                 $seen{$clean} ||= 0;
1767                 next if $seen{$clean}++;
1768                 push @emails, $entry;
1769         }
1770         return @emails;
1771 }
1772
1773 sub validate_patch {
1774         my $fn = shift;
1775
1776         if ($repo) {
1777                 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1778                                             'sendemail-validate');
1779                 my $hook_error;
1780                 if (-x $validate_hook) {
1781                         my $target = abs_path($fn);
1782                         # The hook needs a correct cwd and GIT_DIR.
1783                         my $cwd_save = cwd();
1784                         chdir($repo->wc_path() or $repo->repo_path())
1785                                 or die("chdir: $!");
1786                         local $ENV{"GIT_DIR"} = $repo->repo_path();
1787                         $hook_error = "rejected by sendemail-validate hook"
1788                                 if system($validate_hook, $target);
1789                         chdir($cwd_save) or die("chdir: $!");
1790                 }
1791                 return $hook_error if $hook_error;
1792         }
1793
1794         open(my $fh, '<', $fn)
1795                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1796         while (my $line = <$fh>) {
1797                 if (length($line) > 998) {
1798                         return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1799                 }
1800         }
1801         return;
1802 }
1803
1804 sub handle_backup {
1805         my ($last, $lastlen, $file, $known_suffix) = @_;
1806         my ($suffix, $skip);
1807
1808         $skip = 0;
1809         if (defined $last &&
1810             ($lastlen < length($file)) &&
1811             (substr($file, 0, $lastlen) eq $last) &&
1812             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1813                 if (defined $known_suffix && $suffix eq $known_suffix) {
1814                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1815                         $skip = 1;
1816                 } else {
1817                         # TRANSLATORS: please keep "[y|N]" as is.
1818                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1819                                          valid_re => qr/^(?:y|n)/i,
1820                                          default => 'n');
1821                         $skip = ($answer ne 'y');
1822                         if ($skip) {
1823                                 $known_suffix = $suffix;
1824                         }
1825                 }
1826         }
1827         return ($skip, $known_suffix);
1828 }
1829
1830 sub handle_backup_files {
1831         my @file = @_;
1832         my ($last, $lastlen, $known_suffix, $skip, @result);
1833         for my $file (@file) {
1834                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1835                                                        $file, $known_suffix);
1836                 push @result, $file unless $skip;
1837                 $last = $file;
1838                 $lastlen = length($file);
1839         }
1840         return @result;
1841 }
1842
1843 sub file_has_nonascii {
1844         my $fn = shift;
1845         open(my $fh, '<', $fn)
1846                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1847         while (my $line = <$fh>) {
1848                 return 1 if $line =~ /[^[:ascii:]]/;
1849         }
1850         return 0;
1851 }
1852
1853 sub body_or_subject_has_nonascii {
1854         my $fn = shift;
1855         open(my $fh, '<', $fn)
1856                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1857         while (my $line = <$fh>) {
1858                 last if $line =~ /^$/;
1859                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1860         }
1861         while (my $line = <$fh>) {
1862                 return 1 if $line =~ /[^[:ascii:]]/;
1863         }
1864         return 0;
1865 }