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