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

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