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