git-send-email.perl

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