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         undef $message_id;
1792         # Retrieve and unfold header fields.
1793         my @header_lines = ();
1794         while(<$fh>) {
1795                 last if /^\s*$/;
1796                 push(@header_lines, $_);
1797         }
1798         @header = unfold_headers(@header_lines);
1799         # Add computed headers, if applicable.
1800         unless ($no_header_cmd || ! $header_cmd) {
1801                 push @header, invoke_header_cmd($header_cmd, $t);
1802         }
1803         # Now parse the header
1804         foreach(@header) {
1805                 if (/^From /) {
1806                         $input_format = 'mbox';
1807                         next;
1808                 }
1809                 chomp;
1810                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1811                         $input_format = 'mbox';
1812                 }
1813
1814                 if (defined $input_format && $input_format eq 'mbox') {
1815                         if (/^Subject:\s+(.*)$/i) {
1816                                 $subject = $1;
1817                         }
1818                         elsif (/^From:\s+(.*)$/i) {
1819                                 ($author, $author_encoding) = unquote_rfc2047($1);
1820                                 $sauthor = sanitize_address($author);
1821                                 next if $suppress_cc{'author'};
1822                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1823                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1824                                         $1, $_) unless $quiet;
1825                                 push @cc, $1;
1826                         }
1827                         elsif (/^To:\s+(.*)$/i) {
1828                                 foreach my $addr (parse_address_line($1)) {
1829                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1830                                                 $addr, $_) unless $quiet;
1831                                         push @to, $addr;
1832                                 }
1833                         }
1834                         elsif (/^Cc:\s+(.*)$/i) {
1835                                 foreach my $addr (parse_address_line($1)) {
1836                                         my $qaddr = unquote_rfc2047($addr);
1837                                         my $saddr = sanitize_address($qaddr);
1838                                         if ($saddr eq $sender) {
1839                                                 next if ($suppress_cc{'self'});
1840                                         } else {
1841                                                 next if ($suppress_cc{'cc'});
1842                                         }
1843                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1844                                                 $addr, $_) unless $quiet;
1845                                         push @cc, $addr;
1846                                 }
1847                         }
1848                         elsif (/^Content-type:/i) {
1849                                 $has_content_type = 1;
1850                                 if (/charset="?([^ "]+)/) {
1851                                         $body_encoding = $1;
1852                                 }
1853                                 push @xh, $_;
1854                         }
1855                         elsif (/^MIME-Version/i) {
1856                                 $has_mime_version = 1;
1857                                 push @xh, $_;
1858                         }
1859                         elsif (/^Message-ID: (.*)/i) {
1860                                 $message_id = $1;
1861                         }
1862                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1863                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1864                         }
1865                         elsif (/^In-Reply-To: (.*)/i) {
1866                                 if (!$initial_in_reply_to || $thread) {
1867                                         $in_reply_to = $1;
1868                                 }
1869                         }
1870                         elsif (/^References: (.*)/i) {
1871                                 if (!$initial_in_reply_to || $thread) {
1872                                         $references = $1;
1873                                 }
1874                         }
1875                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1876                                 push @xh, $_;
1877                         }
1878                 } else {
1879                         # In the traditional
1880                         # "send lots of email" format,
1881                         # line 1 = cc
1882                         # line 2 = subject
1883                         # So let's support that, too.
1884                         $input_format = 'lots';
1885                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1886                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1887                                         $_, $_) unless $quiet;
1888                                 push @cc, $_;
1889                         } elsif (!defined $subject) {
1890                                 $subject = $_;
1891                         }
1892                 }
1893         }
1894         # Now parse the message body
1895         while(<$fh>) {
1896                 $message .=  $_;
1897                 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1898                         chomp;
1899                         my ($what, $c) = ($1, $2);
1900                         # strip garbage for the address we'll use:
1901                         $c = strip_garbage_one_address($c);
1902                         # sanitize a bit more to decide whether to suppress the address:
1903                         my $sc = sanitize_address($c);
1904                         if ($sc eq $sender) {
1905                                 next if ($suppress_cc{'self'});
1906                         } else {
1907                                 if ($what =~ /^Signed-off-by$/i) {
1908                                         next if $suppress_cc{'sob'};
1909                                 } elsif ($what =~ /-by$/i) {
1910                                         next if $suppress_cc{'misc-by'};
1911                                 } elsif ($what =~ /Cc/i) {
1912                                         next if $suppress_cc{'bodycc'};
1913                                 }
1914                         }
1915                         if ($c !~ /.+@.+|<.+>/) {
1916                                 printf("(body) Ignoring %s from line '%s'\n",
1917                                         $what, $_) unless $quiet;
1918                                 next;
1919                         }
1920                         push @cc, $c;
1921                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1922                                 $c, $_) unless $quiet;
1923                 }
1924         }
1925         close $fh;
1926
1927         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t, $quiet)
1928                 if defined $to_cmd;
1929         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1930                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1931
1932         if ($broken_encoding{$t} && !$has_content_type) {
1933                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1934                 $has_content_type = 1;
1935                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1936                 $body_encoding = $auto_8bit_encoding;
1937         }
1938
1939         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1940                 $subject = quote_subject($subject, $auto_8bit_encoding);
1941         }
1942
1943         if (defined $sauthor and $sauthor ne $sender) {
1944                 $message = "From: $author\n\n$message";
1945                 if (defined $author_encoding) {
1946                         if ($has_content_type) {
1947                                 if ($body_encoding eq $author_encoding) {
1948                                         # ok, we already have the right encoding
1949                                 }
1950                                 else {
1951                                         # uh oh, we should re-encode
1952                                 }
1953                         }
1954                         else {
1955                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1956                                 $has_content_type = 1;
1957                                 push @xh,
1958                                   "Content-Type: text/plain; charset=$author_encoding";
1959                         }
1960                 }
1961         }
1962         $xfer_encoding = '8bit' if not defined $xfer_encoding;
1963         ($message, $xfer_encoding) = apply_transfer_encoding(
1964                 $message, $xfer_encoding, $target_xfer_encoding);
1965         push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1966         unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1967
1968         $needs_confirm = (
1969                 $confirm eq "always" or
1970                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1971                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1972         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1973
1974         @to = process_address_list(@to);
1975         @cc = process_address_list(@cc);
1976
1977         @to = (@initial_to, @to);
1978         @cc = (@initial_cc, @cc);
1979
1980         if ($message_num == 1) {
1981                 if (defined $cover_cc and $cover_cc) {
1982                         @initial_cc = @cc;
1983                 }
1984                 if (defined $cover_to and $cover_to) {
1985                         @initial_to = @to;
1986                 }
1987         }
1988 }
1989
1990 # Prepares the email, prompts the user, and sends it out
1991 # Returns 0 if an edit was done and the function should be called again, or 1
1992 # on the email being successfully sent out.
1993 sub process_file {
1994         my ($t) = @_;
1995
1996         pre_process_file($t, $quiet);
1997
1998         my $message_was_sent = send_message();
1999         if ($message_was_sent == -1) {
2000                 do_edit($t);
2001                 return 0;
2002         }
2003
2004         # set up for the next message
2005         if ($thread) {
2006                 if ($message_was_sent &&
2007                   ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
2008                   $message_num == 1)) {
2009                         $in_reply_to = $message_id;
2010                         if (length $references > 0) {
2011                                 $references .= "\n $message_id";
2012                         } else {
2013                                 $references = "$message_id";
2014                         }
2015                 }
2016         } elsif (!defined $initial_in_reply_to) {
2017                 # --thread and --in-reply-to manage the "In-Reply-To" header and by
2018                 # extension the "References" header. If these commands are not used, reset
2019                 # the header values to their defaults.
2020                 $in_reply_to = undef;
2021                 $references = '';
2022         }
2023         $message_id = undef;
2024         $num_sent++;
2025         if (defined $batch_size && $num_sent == $batch_size) {
2026                 $num_sent = 0;
2027                 $smtp->quit if defined $smtp;
2028                 undef $smtp;
2029                 undef $auth;
2030                 sleep($relogin_delay) if defined $relogin_delay;
2031         }
2032
2033         return 1;
2034 }
2035
2036 foreach my $t (@files) {
2037         while (!process_file($t)) {
2038                 # user edited the file
2039         }
2040 }
2041
2042 # Execute a command and return its output lines as an array.  Blank
2043 # lines which do not appear at the end of the output are reported as
2044 # errors.
2045 sub execute_cmd {
2046         my ($prefix, $cmd, $file) = @_;
2047         my @lines = ();
2048         my $seen_blank_line = 0;
2049         open my $fh, "-|", "$cmd \Q$file\E"
2050                 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
2051         while (my $line = <$fh>) {
2052                 die sprintf(__("(%s) Malformed output from '%s'"), $prefix, $cmd)
2053                     if $seen_blank_line;
2054                 if ($line =~ /^$/) {
2055                         $seen_blank_line = $line =~ /^$/;
2056                         next;
2057                 }
2058                 push @lines, $line;
2059         }
2060         close $fh
2061             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2062         return @lines;
2063 }
2064
2065 # Process headers lines, unfolding multiline headers as defined by RFC
2066 # 2822.
2067 sub unfold_headers {
2068         my @headers;
2069         foreach(@_) {
2070                 last if /^\s*$/;
2071                 if (/^\s+\S/ and @headers) {
2072                         chomp($headers[$#headers]);
2073                         s/^\s+/ /;
2074                         $headers[$#headers] .= $_;
2075                 } else {
2076                         push(@headers, $_);
2077                 }
2078         }
2079         return @headers;
2080 }
2081
2082 # Invoke the provided CMD with FILE as an argument, which should
2083 # output RFC 2822 email headers. Fold multiline headers and return the
2084 # headers as an array.
2085 sub invoke_header_cmd {
2086         my ($cmd, $file) = @_;
2087         my @lines = execute_cmd("header-cmd", $header_cmd, $file);
2088         return unfold_headers(@lines);
2089 }
2090
2091 # Execute a command (e.g. $to_cmd) to get a list of email addresses
2092 # and return a results array
2093 sub recipients_cmd {
2094         my ($prefix, $what, $cmd, $file, $quiet) = @_;
2095         my @lines = ();
2096         my @addresses = ();
2097
2098         @lines = execute_cmd($prefix, $cmd, $file);
2099         for my $address (@lines) {
2100                 $address =~ s/^\s*//g;
2101                 $address =~ s/\s*$//g;
2102                 $address = sanitize_address($address);
2103                 next if ($address eq $sender and $suppress_cc{'self'});
2104                 push @addresses, $address;
2105                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
2106                        $prefix, $what, $address, $cmd) unless $quiet;
2107                 }
2108         return @addresses;
2109 }
2110
2111 cleanup_compose_files();
2112
2113 sub cleanup_compose_files {
2114         unlink($compose_filename, $compose_filename . ".final") if $compose;
2115 }
2116
2117 $smtp->quit if $smtp;
2118
2119 sub apply_transfer_encoding {
2120         my $message = shift;
2121         my $from = shift;
2122         my $to = shift;
2123
2124         return ($message, $to) if ($from eq $to and $from ne '7bit');
2125
2126         require MIME::QuotedPrint;
2127         require MIME::Base64;
2128
2129         $message = MIME::QuotedPrint::decode($message)
2130                 if ($from eq 'quoted-printable');
2131         $message = MIME::Base64::decode($message)
2132                 if ($from eq 'base64');
2133
2134         $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2135                 if $to eq 'auto';
2136
2137         die __("cannot send message as 7bit")
2138                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2139         return ($message, $to)
2140                 if ($to eq '7bit' or $to eq '8bit');
2141         return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2142                 if ($to eq 'quoted-printable');
2143         return (MIME::Base64::encode($message, "\n"), $to)
2144                 if ($to eq 'base64');
2145         die __("invalid transfer encoding");
2146 }
2147
2148 sub unique_email_list {
2149         my %seen;
2150         my @emails;
2151
2152         foreach my $entry (@_) {
2153                 my $clean = extract_valid_address_or_die($entry);
2154                 $seen{$clean} ||= 0;
2155                 next if $seen{$clean}++;
2156                 push @emails, $entry;
2157         }
2158         return @emails;
2159 }
2160
2161 sub validate_patch {
2162         my ($fn, $xfer_encoding) = @_;
2163
2164         if ($repo) {
2165                 my $hook_name = 'sendemail-validate';
2166                 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2167                 require File::Spec;
2168                 my $validate_hook = File::Spec->catfile($hooks_path, $hook_name);
2169                 my $hook_error;
2170                 if (-x $validate_hook) {
2171                         require Cwd;
2172                         my $target = Cwd::abs_path($fn);
2173                         # The hook needs a correct cwd and GIT_DIR.
2174                         my $cwd_save = Cwd::getcwd();
2175                         chdir($repo->wc_path() or $repo->repo_path())
2176                                 or die("chdir: $!");
2177                         local $ENV{"GIT_DIR"} = $repo->repo_path();
2178
2179                         my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
2180
2181                         require File::Temp;
2182                         my ($header_filehandle, $header_filename) = File::Temp::tempfile(
2183                             TEMPLATE => ".gitsendemail.header.XXXXXX",
2184                             DIR => $repo->repo_path(),
2185                             UNLINK => 1,
2186                         );
2187                         print $header_filehandle $header;
2188
2189                         my @cmd = ("git", "hook", "run", "--ignore-missing",
2190                                     $hook_name, "--");
2191                         my @cmd_msg = (@cmd, "<patch>", "<header>");
2192                         my @cmd_run = (@cmd, $target, $header_filename);
2193                         $hook_error = system_or_msg(\@cmd_run, undef, "@cmd_msg");
2194                         chdir($cwd_save) or die("chdir: $!");
2195                 }
2196                 if ($hook_error) {
2197                         $hook_error = sprintf(
2198                             __("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2199                             $fn, $hook_name, $hook_error);
2200                         die $hook_error;
2201                 }
2202         }
2203
2204         # Any long lines will be automatically fixed if we use a suitable transfer
2205         # encoding.
2206         unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2207                 open(my $fh, '<', $fn)
2208                         or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2209                 while (my $line = <$fh>) {
2210                         if (length($line) > 998) {
2211                                 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2212                                                "warning: no patches were sent\n"), $fn, $.);
2213                         }
2214                 }
2215         }
2216         return;
2217 }
2218
2219 sub handle_backup {
2220         my ($last, $lastlen, $file, $known_suffix) = @_;
2221         my ($suffix, $skip);
2222
2223         $skip = 0;
2224         if (defined $last &&
2225             ($lastlen < length($file)) &&
2226             (substr($file, 0, $lastlen) eq $last) &&
2227             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2228                 if (defined $known_suffix && $suffix eq $known_suffix) {
2229                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2230                         $skip = 1;
2231                 } else {
2232                         # TRANSLATORS: please keep "[y|N]" as is.
2233                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2234                                          valid_re => qr/^(?:y|n)/i,
2235                                          default => 'n');
2236                         $skip = ($answer ne 'y');
2237                         if ($skip) {
2238                                 $known_suffix = $suffix;
2239                         }
2240                 }
2241         }
2242         return ($skip, $known_suffix);
2243 }
2244
2245 sub handle_backup_files {
2246         my @file = @_;
2247         my ($last, $lastlen, $known_suffix, $skip, @result);
2248         for my $file (@file) {
2249                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2250                                                        $file, $known_suffix);
2251                 push @result, $file unless $skip;
2252                 $last = $file;
2253                 $lastlen = length($file);
2254         }
2255         return @result;
2256 }
2257
2258 sub file_has_nonascii {
2259         my $fn = shift;
2260         open(my $fh, '<', $fn)
2261                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2262         while (my $line = <$fh>) {
2263                 return 1 if $line =~ /[^[:ascii:]]/;
2264         }
2265         return 0;
2266 }
2267
2268 sub body_or_subject_has_nonascii {
2269         my $fn = shift;
2270         open(my $fh, '<', $fn)
2271                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2272         while (my $line = <$fh>) {
2273                 last if $line =~ /^$/;
2274                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2275         }
2276         while (my $line = <$fh>) {
2277                 return 1 if $line =~ /[^[:ascii:]]/;
2278         }
2279         return 0;
2280 }