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