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