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