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