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 @files = handle_backup_files(@files);
 815
 816 if (@files) {
 817         unless ($quiet) {
 818                 print $_,"\n" for (@files);
 819         }
 820 } else {
 821         print STDERR __("\nNo patch files specified!\n\n");
 822         usage();
 823 }
 824
 825 sub get_patch_subject {
 826         my $fn = shift;
 827         open (my $fh, '<', $fn);
 828         while (my $line = <$fh>) {
 829                 next unless ($line =~ /^Subject: (.*)$/);
 830                 close $fh;
 831                 return "GIT: $1\n";
 832         }
 833         close $fh;
 834         die sprintf(__("No subject line in %s?"), $fn);
 835 }
 836
 837 if ($compose) {
 838         # Note that this does not need to be secure, but we will make a small
 839         # effort to have it be unique
 840         require File::Temp;
 841         $compose_filename = ($repo ?
 842                 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
 843                 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
 844         open my $c, ">", $compose_filename
 845                 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 846
 847
 848         my $tpl_sender = $sender || $repoauthor->() || $repocommitter->() || '';
 849         my $tpl_subject = $initial_subject || '';
 850         my $tpl_in_reply_to = $initial_in_reply_to || '';
 851         my $tpl_reply_to = $reply_to || '';
 852
 853         print $c <<EOT1, Git::prefix_lines("GIT: ", __(<<EOT2)), <<EOT3;
 854 From $tpl_sender # This line is ignored.
 855 EOT1
 856 Lines beginning in "GIT:" will be removed.
 857 Consider including an overall diffstat or table of contents
 858 for the patch you are writing.
 859
 860 Clear the body content if you don't wish to send a summary.
 861 EOT2
 862 From: $tpl_sender
 863 Reply-To: $tpl_reply_to
 864 Subject: $tpl_subject
 865 In-Reply-To: $tpl_in_reply_to
 866
 867 EOT3
 868         for my $f (@files) {
 869                 print $c get_patch_subject($f);
 870         }
 871         close $c;
 872
 873         if ($annotate) {
 874                 do_edit($compose_filename, @files);
 875         } else {
 876                 do_edit($compose_filename);
 877         }
 878
 879         open $c, "<", $compose_filename
 880                 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 881
 882         if (!defined $compose_encoding) {
 883                 $compose_encoding = "UTF-8";
 884         }
 885
 886         my %parsed_email;
 887         while (my $line = <$c>) {
 888                 next if $line =~ m/^GIT:/;
 889                 parse_header_line($line, \%parsed_email);
 890                 if ($line =~ /^$/) {
 891                         $parsed_email{'body'} = filter_body($c);
 892                 }
 893         }
 894         close $c;
 895
 896         open my $c2, ">", $compose_filename . ".final"
 897         or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 898
 899
 900         if ($parsed_email{'From'}) {
 901                 $sender = delete($parsed_email{'From'});
 902         }
 903         if ($parsed_email{'In-Reply-To'}) {
 904                 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
 905         }
 906         if ($parsed_email{'Reply-To'}) {
 907                 $reply_to = delete($parsed_email{'Reply-To'});
 908         }
 909         if ($parsed_email{'Subject'}) {
 910                 $initial_subject = delete($parsed_email{'Subject'});
 911                 print $c2 "Subject: " .
 912                         quote_subject($initial_subject, $compose_encoding) .
 913                         "\n";
 914         }
 915
 916         if ($parsed_email{'MIME-Version'}) {
 917                 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
 918                                 "Content-Type: $parsed_email{'Content-Type'};\n",
 919                                 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
 920                 delete($parsed_email{'MIME-Version'});
 921                 delete($parsed_email{'Content-Type'});
 922                 delete($parsed_email{'Content-Transfer-Encoding'});
 923         } elsif (file_has_nonascii($compose_filename)) {
 924                 my $content_type = (delete($parsed_email{'Content-Type'}) or
 925                         "text/plain; charset=$compose_encoding");
 926                 print $c2 "MIME-Version: 1.0\n",
 927                         "Content-Type: $content_type\n",
 928                         "Content-Transfer-Encoding: 8bit\n";
 929         }
 930         # Preserve unknown headers
 931         foreach my $key (keys %parsed_email) {
 932                 next if $key eq 'body';
 933                 print $c2 "$key: $parsed_email{$key}";
 934         }
 935
 936         if ($parsed_email{'body'}) {
 937                 print $c2 "\n$parsed_email{'body'}\n";
 938                 delete($parsed_email{'body'});
 939         } else {
 940                 print __("Summary email is empty, skipping it\n");
 941                 $compose = -1;
 942         }
 943
 944         close $c2;
 945
 946 } elsif ($annotate) {
 947         do_edit(@files);
 948 }
 949
 950 sub term {
 951         my $term = eval {
 952                 require Term::ReadLine;
 953                 $ENV{"GIT_SEND_EMAIL_NOTTY"}
 954                         ? Term::ReadLine->new('git-send-email', \*STDIN, \*STDOUT)
 955                         : Term::ReadLine->new('git-send-email');
 956         };
 957         if ($@) {
 958                 $term = FakeTerm->new("$@: going non-interactive");
 959         }
 960         return $term;
 961 }
 962
 963 sub ask {
 964         my ($prompt, %arg) = @_;
 965         my $valid_re = $arg{valid_re};
 966         my $default = $arg{default};
 967         my $confirm_only = $arg{confirm_only};
 968         my $resp;
 969         my $i = 0;
 970         my $term = term();
 971         return defined $default ? $default : undef
 972                 unless defined $term->IN and defined fileno($term->IN) and
 973                        defined $term->OUT and defined fileno($term->OUT);
 974         while ($i++ < 10) {
 975                 $resp = $term->readline($prompt);
 976                 if (!defined $resp) { # EOF
 977                         print "\n";
 978                         return defined $default ? $default : undef;
 979                 }
 980                 if ($resp eq '' and defined $default) {
 981                         return $default;
 982                 }
 983                 if (!defined $valid_re or $resp =~ /$valid_re/) {
 984                         return $resp;
 985                 }
 986                 if ($confirm_only) {
 987                         my $yesno = $term->readline(
 988                                 # TRANSLATORS: please keep [y/N] as is.
 989                                 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
 990                         if (defined $yesno && $yesno =~ /y/i) {
 991                                 return $resp;
 992                         }
 993                 }
 994         }
 995         return;
 996 }
 997
 998 sub parse_header_line {
 999         my $lines = shift;
1000         my $parsed_line = shift;
1001         my $addr_pat = join "|", qw(To Cc Bcc);
1002
1003         foreach (split(/\n/, $lines)) {
1004                 if (/^($addr_pat):\s*(.+)$/i) {
1005                         $parsed_line->{$1} = [ parse_address_line($2) ];
1006                 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
1007                         $parsed_line->{$1} = $2;
1008                 }
1009         }
1010 }
1011
1012 sub filter_body {
1013         my $c = shift;
1014         my $body = "";
1015         while (my $body_line = <$c>) {
1016                 if ($body_line !~ m/^GIT:/) {
1017                         $body .= $body_line;
1018                 }
1019         }
1020         return $body;
1021 }
1022
1023
1024 my %broken_encoding;
1025
1026 sub file_declares_8bit_cte {
1027         my $fn = shift;
1028         open (my $fh, '<', $fn);
1029         while (my $line = <$fh>) {
1030                 last if ($line =~ /^$/);
1031                 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
1032         }
1033         close $fh;
1034         return 0;
1035 }
1036
1037 foreach my $f (@files) {
1038         next unless (body_or_subject_has_nonascii($f)
1039                      && !file_declares_8bit_cte($f));
1040         $broken_encoding{$f} = 1;
1041 }
1042
1043 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
1044         print __("The following files are 8bit, but do not declare " .
1045                  "a Content-Transfer-Encoding.\n");
1046         foreach my $f (sort keys %broken_encoding) {
1047                 print "    $f\n";
1048         }
1049         $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
1050                                   valid_re => qr/.{4}/, confirm_only => 1,
1051                                   default => "UTF-8");
1052 }
1053
1054 if (!$force) {
1055         for my $f (@files) {
1056                 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
1057                         die sprintf(__("Refusing to send because the patch\n\t%s\n"
1058                                 . "has the template subject '*** SUBJECT HERE ***'. "
1059                                 . "Pass --force if you really want to send.\n"), $f);
1060                 }
1061         }
1062 }
1063
1064 my $to_whom = __("To whom should the emails be sent (if anyone)?");
1065 my $prompting = 0;
1066 if (!@initial_to && !defined $to_cmd) {
1067         my $to = ask("$to_whom ",
1068                      default => "",
1069                      valid_re => qr/\@.*\./, confirm_only => 1);
1070         push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
1071         $prompting++;
1072 }
1073
1074 sub expand_aliases {
1075         return map { expand_one_alias($_) } @_;
1076 }
1077
1078 my %EXPANDED_ALIASES;
1079 sub expand_one_alias {
1080         my $alias = shift;
1081         if ($EXPANDED_ALIASES{$alias}) {
1082                 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
1083         }
1084         local $EXPANDED_ALIASES{$alias} = 1;
1085         return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
1086 }
1087
1088 @initial_to = process_address_list(@initial_to);
1089 @initial_cc = process_address_list(@initial_cc);
1090 @initial_bcc = process_address_list(@initial_bcc);
1091
1092 if ($thread && !defined $initial_in_reply_to && $prompting) {
1093         $initial_in_reply_to = ask(
1094                 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
1095                 default => "",
1096                 valid_re => qr/\@.*\./, confirm_only => 1);
1097 }
1098 if (defined $initial_in_reply_to) {
1099         $initial_in_reply_to =~ s/^\s*<?//;
1100         $initial_in_reply_to =~ s/>?\s*$//;
1101         $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
1102 }
1103
1104 if (defined $reply_to) {
1105         $reply_to =~ s/^\s+|\s+$//g;
1106         ($reply_to) = expand_aliases($reply_to);
1107         $reply_to = sanitize_address($reply_to);
1108 }
1109
1110 if (!defined $sendmail_cmd && !defined $smtp_server) {
1111         my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1112         push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
1113         foreach (@sendmail_paths) {
1114                 if (-x $_) {
1115                         $sendmail_cmd = $_;
1116                         last;
1117                 }
1118         }
1119
1120         if (!defined $sendmail_cmd) {
1121                 $smtp_server = 'localhost'; # could be 127.0.0.1, too... *shrug*
1122         }
1123 }
1124
1125 if ($compose && $compose > 0) {
1126         @files = ($compose_filename . ".final", @files);
1127 }
1128
1129 # Variables we set as part of the loop over files
1130 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
1131         $needs_confirm, $message_num, $ask_default);
1132
1133 sub extract_valid_address {
1134         my $address = shift;
1135         my $local_part_regexp = qr/[^<>"\s@]+/;
1136         my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
1137
1138         # check for a local address:
1139         return $address if ($address =~ /^($local_part_regexp)$/);
1140
1141         $address =~ s/^\s*<(.*)>\s*$/$1/;
1142         my $have_email_valid = eval { require Email::Valid; 1 };
1143         if ($have_email_valid) {
1144                 return scalar Email::Valid->address($address);
1145         }
1146
1147         # less robust/correct than the monster regexp in Email::Valid,
1148         # but still does a 99% job, and one less dependency
1149         return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1150         return;
1151 }
1152
1153 sub extract_valid_address_or_die {
1154         my $address = shift;
1155         $address = extract_valid_address($address);
1156         die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1157                 if !$address;
1158         return $address;
1159 }
1160
1161 sub validate_address {
1162         my $address = shift;
1163         while (!extract_valid_address($address)) {
1164                 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1165                 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1166                 # translation. The program will only accept English input
1167                 # at this point.
1168                 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1169                         valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1170                         default => 'q');
1171                 if (/^d/i) {
1172                         return undef;
1173                 } elsif (/^q/i) {
1174                         cleanup_compose_files();
1175                         exit(0);
1176                 }
1177                 $address = ask("$to_whom ",
1178                         default => "",
1179                         valid_re => qr/\@.*\./, confirm_only => 1);
1180         }
1181         return $address;
1182 }
1183
1184 sub validate_address_list {
1185         return (grep { defined $_ }
1186                 map { validate_address($_) } @_);
1187 }
1188
1189 # Usually don't need to change anything below here.
1190
1191 # we make a "fake" message id by taking the current number
1192 # of seconds since the beginning of Unix time and tacking on
1193 # a random number to the end, in case we are called quicker than
1194 # 1 second since the last time we were called.
1195
1196 # We'll setup a template for the message id, using the "from" address:
1197
1198 my ($message_id_stamp, $message_id_serial);
1199 sub make_message_id {
1200         my $uniq;
1201         if (!defined $message_id_stamp) {
1202                 require POSIX;
1203                 $message_id_stamp = POSIX::strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1204                 $message_id_serial = 0;
1205         }
1206         $message_id_serial++;
1207         $uniq = "$message_id_stamp-$message_id_serial";
1208
1209         my $du_part;
1210         for ($sender, $repocommitter->(), $repoauthor->()) {
1211                 $du_part = extract_valid_address(sanitize_address($_));
1212                 last if (defined $du_part and $du_part ne '');
1213         }
1214         if (not defined $du_part or $du_part eq '') {
1215                 require Sys::Hostname;
1216                 $du_part = 'user@' . Sys::Hostname::hostname();
1217         }
1218         my $message_id_template = "<%s-%s>";
1219         $message_id = sprintf($message_id_template, $uniq, $du_part);
1220         #print "new message id = $message_id\n"; # Was useful for debugging
1221 }
1222
1223 sub unquote_rfc2047 {
1224         local ($_) = @_;
1225         my $charset;
1226         my $sep = qr/[ \t]+/;
1227         s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1228                 my @words = split $sep, $&;
1229                 foreach (@words) {
1230                         m/$re_encoded_word/;
1231                         $charset = $1;
1232                         my $encoding = $2;
1233                         my $text = $3;
1234                         if ($encoding eq 'q' || $encoding eq 'Q') {
1235                                 $_ = $text;
1236                                 s/_/ /g;
1237                                 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1238                         } else {
1239                                 # other encodings not supported yet
1240                         }
1241                 }
1242                 join '', @words;
1243         }eg;
1244         return wantarray ? ($_, $charset) : $_;
1245 }
1246
1247 sub quote_rfc2047 {
1248         local $_ = shift;
1249         my $encoding = shift || 'UTF-8';
1250         s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1251         s/(.*)/=\?$encoding\?q\?$1\?=/;
1252         return $_;
1253 }
1254
1255 sub is_rfc2047_quoted {
1256         my $s = shift;
1257         length($s) <= 75 &&
1258         $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1259 }
1260
1261 sub subject_needs_rfc2047_quoting {
1262         my $s = shift;
1263
1264         return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1265 }
1266
1267 sub quote_subject {
1268         local $subject = shift;
1269         my $encoding = shift || 'UTF-8';
1270
1271         if (subject_needs_rfc2047_quoting($subject)) {
1272                 return quote_rfc2047($subject, $encoding);
1273         }
1274         return $subject;
1275 }
1276
1277 # use the simplest quoting being able to handle the recipient
1278 sub sanitize_address {
1279         my ($recipient) = @_;
1280
1281         # remove garbage after email address
1282         $recipient =~ s/(.*>).*$/$1/;
1283
1284         my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1285
1286         if (not $recipient_name) {
1287                 return $recipient;
1288         }
1289
1290         # if recipient_name is already quoted, do nothing
1291         if (is_rfc2047_quoted($recipient_name)) {
1292                 return $recipient;
1293         }
1294
1295         # remove non-escaped quotes
1296         $recipient_name =~ s/(^|[^\\])"/$1/g;
1297
1298         # rfc2047 is needed if a non-ascii char is included
1299         if ($recipient_name =~ /[^[:ascii:]]/) {
1300                 $recipient_name = quote_rfc2047($recipient_name);
1301         }
1302
1303         # double quotes are needed if specials or CTLs are included
1304         elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1305                 $recipient_name =~ s/([\\\r])/\\$1/g;
1306                 $recipient_name = qq["$recipient_name"];
1307         }
1308
1309         return "$recipient_name $recipient_addr";
1310
1311 }
1312
1313 sub strip_garbage_one_address {
1314         my ($addr) = @_;
1315         chomp $addr;
1316         if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1317                 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1318                 # Foo Bar <foobar@example.com> [possibly garbage here]
1319                 return $1;
1320         }
1321         if ($addr =~ /^(<[^>]*>).*/) {
1322                 # <foo@example.com> [possibly garbage here]
1323                 # if garbage contains other addresses, they are ignored.
1324                 return $1;
1325         }
1326         if ($addr =~ /^([^"#,\s]*)/) {
1327                 # address without quoting: remove anything after the address
1328                 return $1;
1329         }
1330         return $addr;
1331 }
1332
1333 sub sanitize_address_list {
1334         return (map { sanitize_address($_) } @_);
1335 }
1336
1337 sub process_address_list {
1338         my @addr_list = map { parse_address_line($_) } @_;
1339         @addr_list = expand_aliases(@addr_list);
1340         @addr_list = sanitize_address_list(@addr_list);
1341         @addr_list = validate_address_list(@addr_list);
1342         return @addr_list;
1343 }
1344
1345 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1346 #
1347 # Tightly configured MTAa require that a caller sends a real DNS
1348 # domain name that corresponds the IP address in the HELO/EHLO
1349 # handshake. This is used to verify the connection and prevent
1350 # spammers from trying to hide their identity. If the DNS and IP don't
1351 # match, the receiving MTA may deny the connection.
1352 #
1353 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1354 #
1355 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1356 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1357 #
1358 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1359 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1360
1361 sub valid_fqdn {
1362         my $domain = shift;
1363         return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1364 }
1365
1366 sub maildomain_net {
1367         my $maildomain;
1368
1369         require Net::Domain;
1370         my $domain = Net::Domain::domainname();
1371         $maildomain = $domain if valid_fqdn($domain);
1372
1373         return $maildomain;
1374 }
1375
1376 sub maildomain_mta {
1377         my $maildomain;
1378
1379         for my $host (qw(mailhost localhost)) {
1380                 require Net::SMTP;
1381                 my $smtp = Net::SMTP->new($host);
1382                 if (defined $smtp) {
1383                         my $domain = $smtp->domain;
1384                         $smtp->quit;
1385
1386                         $maildomain = $domain if valid_fqdn($domain);
1387
1388                         last if $maildomain;
1389                 }
1390         }
1391
1392         return $maildomain;
1393 }
1394
1395 sub maildomain {
1396         return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1397 }
1398
1399 sub smtp_host_string {
1400         if (defined $smtp_server_port) {
1401                 return "$smtp_server:$smtp_server_port";
1402         } else {
1403                 return $smtp_server;
1404         }
1405 }
1406
1407 # Returns 1 if authentication succeeded or was not necessary
1408 # (smtp_user was not specified), and 0 otherwise.
1409
1410 sub smtp_auth_maybe {
1411         if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1412                 return 1;
1413         }
1414
1415         # Workaround AUTH PLAIN/LOGIN interaction defect
1416         # with Authen::SASL::Cyrus
1417         eval {
1418                 require Authen::SASL;
1419                 Authen::SASL->import(qw(Perl));
1420         };
1421
1422         # Check mechanism naming as defined in:
1423         # https://tools.ietf.org/html/rfc4422#page-8
1424         if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1425                 die "invalid smtp auth: '${smtp_auth}'";
1426         }
1427
1428         # TODO: Authentication may fail not because credentials were
1429         # invalid but due to other reasons, in which we should not
1430         # reject credentials.
1431         $auth = Git::credential({
1432                 'protocol' => 'smtp',
1433                 'host' => smtp_host_string(),
1434                 'username' => $smtp_authuser,
1435                 # if there's no password, "git credential fill" will
1436                 # give us one, otherwise it'll just pass this one.
1437                 'password' => $smtp_authpass
1438         }, sub {
1439                 my $cred = shift;
1440
1441                 if ($smtp_auth) {
1442                         my $sasl = Authen::SASL->new(
1443                                 mechanism => $smtp_auth,
1444                                 callback => {
1445                                         user => $cred->{'username'},
1446                                         pass => $cred->{'password'},
1447                                         authname => $cred->{'username'},
1448                                 }
1449                         );
1450
1451                         return !!$smtp->auth($sasl);
1452                 }
1453
1454                 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1455         });
1456
1457         return $auth;
1458 }
1459
1460 sub ssl_verify_params {
1461         eval {
1462                 require IO::Socket::SSL;
1463                 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1464         };
1465         if ($@) {
1466                 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1467                 return;
1468         }
1469
1470         if (!defined $smtp_ssl_cert_path) {
1471                 # use the OpenSSL defaults
1472                 return (SSL_verify_mode => SSL_VERIFY_PEER());
1473         }
1474
1475         if ($smtp_ssl_cert_path eq "") {
1476                 return (SSL_verify_mode => SSL_VERIFY_NONE());
1477         } elsif (-d $smtp_ssl_cert_path) {
1478                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1479                         SSL_ca_path => $smtp_ssl_cert_path);
1480         } elsif (-f $smtp_ssl_cert_path) {
1481                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1482                         SSL_ca_file => $smtp_ssl_cert_path);
1483         } else {
1484                 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1485         }
1486 }
1487
1488 sub file_name_is_absolute {
1489         my ($path) = @_;
1490
1491         # msys does not grok DOS drive-prefixes
1492         if ($^O eq 'msys') {
1493                 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1494         }
1495
1496         require File::Spec::Functions;
1497         return File::Spec::Functions::file_name_is_absolute($path);
1498 }
1499
1500 sub gen_header {
1501         my @recipients = unique_email_list(@to);
1502         @cc = (grep { my $cc = extract_valid_address_or_die($_);
1503                       not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1504                     }
1505                @cc);
1506         my $to = join (",\n\t", @recipients);
1507         @recipients = unique_email_list(@recipients,@cc,@initial_bcc);
1508         @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1509         my $date = format_2822_time($time++);
1510         my $gitversion = '@@GIT_VERSION@@';
1511         if ($gitversion =~ m/..GIT_VERSION../) {
1512             $gitversion = Git::version();
1513         }
1514
1515         my $cc = join(",\n\t", unique_email_list(@cc));
1516         my $ccline = "";
1517         if ($cc ne '') {
1518                 $ccline = "\nCc: $cc";
1519         }
1520         make_message_id() unless defined($message_id);
1521
1522         my $header = "From: $sender
1523 To: $to${ccline}
1524 Subject: $subject
1525 Date: $date
1526 Message-ID: $message_id
1527 ";
1528         if ($use_xmailer) {
1529                 $header .= "X-Mailer: git-send-email $gitversion\n";
1530         }
1531         if ($in_reply_to) {
1532
1533                 $header .= "In-Reply-To: $in_reply_to\n";
1534                 $header .= "References: $references\n";
1535         }
1536         if ($reply_to) {
1537                 $header .= "Reply-To: $reply_to\n";
1538         }
1539         if (@xh) {
1540                 $header .= join("\n", @xh) . "\n";
1541         }
1542         my $recipients_ref = \@recipients;
1543         return ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header);
1544 }
1545
1546 # Prepares the email, then asks the user what to do.
1547 #
1548 # If the user chooses to send the email, it's sent and 1 is returned.
1549 # If the user chooses not to send the email, 0 is returned.
1550 # If the user decides they want to make further edits, -1 is returned and the
1551 # caller is expected to call send_message again after the edits are performed.
1552 #
1553 # If an error occurs sending the email, this just dies.
1554
1555 sub send_message {
1556         my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
1557         my @recipients = @$recipients_ref;
1558
1559         my @sendmail_parameters = ('-i', @recipients);
1560         my $raw_from = $sender;
1561         if (defined $envelope_sender && $envelope_sender ne "auto") {
1562                 $raw_from = $envelope_sender;
1563         }
1564         $raw_from = extract_valid_address($raw_from);
1565         unshift (@sendmail_parameters,
1566                         '-f', $raw_from) if(defined $envelope_sender);
1567
1568         if ($needs_confirm && !$dry_run) {
1569                 print "\n$header\n";
1570                 if ($needs_confirm eq "inform") {
1571                         $confirm_unconfigured = 0; # squelch this message for the rest of this run
1572                         $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1573                         print __ <<EOF ;
1574     The Cc list above has been expanded by additional
1575     addresses found in the patch commit message. By default
1576     send-email prompts before sending whenever this occurs.
1577     This behavior is controlled by the sendemail.confirm
1578     configuration setting.
1579
1580     For additional information, run 'git send-email --help'.
1581     To retain the current behavior, but squelch this message,
1582     run 'git config --global sendemail.confirm auto'.
1583
1584 EOF
1585                 }
1586                 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1587                 # translation. The program will only accept English input
1588                 # at this point.
1589                 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1590                          valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1591                          default => $ask_default);
1592                 die __("Send this email reply required") unless defined $_;
1593                 if (/^n/i) {
1594                         return 0;
1595                 } elsif (/^e/i) {
1596                         return -1;
1597                 } elsif (/^q/i) {
1598                         cleanup_compose_files();
1599                         exit(0);
1600                 } elsif (/^a/i) {
1601                         $confirm = 'never';
1602                 }
1603         }
1604
1605         unshift (@sendmail_parameters, @smtp_server_options);
1606
1607         if ($dry_run) {
1608                 # We don't want to send the email.
1609         } elsif (defined $sendmail_cmd || file_name_is_absolute($smtp_server)) {
1610                 my $pid = open my $sm, '|-';
1611                 defined $pid or die $!;
1612                 if (!$pid) {
1613                         if (defined $sendmail_cmd) {
1614                                 exec ("sh", "-c", "$sendmail_cmd \"\$@\"", "-", @sendmail_parameters)
1615                                         or die $!;
1616                         } else {
1617                                 exec ($smtp_server, @sendmail_parameters)
1618                                         or die $!;
1619                         }
1620                 }
1621                 print $sm "$header\n$message";
1622                 close $sm or die $!;
1623         } else {
1624
1625                 if (!defined $smtp_server) {
1626                         die __("The required SMTP server is not properly defined.")
1627                 }
1628
1629                 require Net::SMTP;
1630                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1631                 $smtp_domain ||= maildomain();
1632
1633                 if ($smtp_encryption eq 'ssl') {
1634                         $smtp_server_port ||= 465; # ssmtp
1635                         require IO::Socket::SSL;
1636
1637                         # Suppress "variable accessed once" warning.
1638                         {
1639                                 no warnings 'once';
1640                                 $IO::Socket::SSL::DEBUG = 1;
1641                         }
1642
1643                         # Net::SMTP::SSL->new() does not forward any SSL options
1644                         IO::Socket::SSL::set_client_defaults(
1645                                 ssl_verify_params());
1646
1647                         if ($use_net_smtp_ssl) {
1648                                 require Net::SMTP::SSL;
1649                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1650                                                               Hello => $smtp_domain,
1651                                                               Port => $smtp_server_port,
1652                                                               Debug => $debug_net_smtp);
1653                         }
1654                         else {
1655                                 $smtp ||= Net::SMTP->new($smtp_server,
1656                                                          Hello => $smtp_domain,
1657                                                          Port => $smtp_server_port,
1658                                                          Debug => $debug_net_smtp,
1659                                                          SSL => 1);
1660                         }
1661                 }
1662                 elsif (!$smtp) {
1663                         $smtp_server_port ||= 25;
1664                         $smtp ||= Net::SMTP->new($smtp_server,
1665                                                  Hello => $smtp_domain,
1666                                                  Debug => $debug_net_smtp,
1667                                                  Port => $smtp_server_port);
1668                         if ($smtp_encryption eq 'tls' && $smtp) {
1669                                 if ($use_net_smtp_ssl) {
1670                                         $smtp->command('STARTTLS');
1671                                         $smtp->response();
1672                                         if ($smtp->code != 220) {
1673                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1674                                         }
1675                                         require Net::SMTP::SSL;
1676                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1677                                                                           ssl_verify_params())
1678                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1679                                 }
1680                                 else {
1681                                         $smtp->starttls(ssl_verify_params())
1682                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1683                                 }
1684                                 # Send EHLO again to receive fresh
1685                                 # supported commands
1686                                 $smtp->hello($smtp_domain);
1687                         }
1688                 }
1689
1690                 if (!$smtp) {
1691                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1692                             " VALUES: server=$smtp_server ",
1693                             "encryption=$smtp_encryption ",
1694                             "hello=$smtp_domain",
1695                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1696                 }
1697
1698                 smtp_auth_maybe or die $smtp->message;
1699
1700                 $smtp->mail( $raw_from ) or die $smtp->message;
1701                 $smtp->to( @recipients ) or die $smtp->message;
1702                 $smtp->data or die $smtp->message;
1703                 $smtp->datasend("$header\n") or die $smtp->message;
1704                 my @lines = split /^/, $message;
1705                 foreach my $line (@lines) {
1706                         $smtp->datasend("$line") or die $smtp->message;
1707                 }
1708                 $smtp->dataend() or die $smtp->message;
1709                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1710         }
1711         if ($quiet) {
1712                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1713         } else {
1714                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1715                 if (!defined $sendmail_cmd && !file_name_is_absolute($smtp_server)) {
1716                         print "Server: $smtp_server\n";
1717                         print "MAIL FROM:<$raw_from>\n";
1718                         foreach my $entry (@recipients) {
1719                             print "RCPT TO:<$entry>\n";
1720                         }
1721                 } else {
1722                         my $sm;
1723                         if (defined $sendmail_cmd) {
1724                                 $sm = $sendmail_cmd;
1725                         } else {
1726                                 $sm = $smtp_server;
1727                         }
1728
1729                         print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1730                 }
1731                 print $header, "\n";
1732                 if ($smtp) {
1733                         print __("Result: "), $smtp->code, ' ',
1734                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1735                 } else {
1736                         print __("Result: OK\n");
1737                 }
1738         }
1739
1740         return 1;
1741 }
1742
1743 sub pre_process_file {
1744         my ($t, $quiet) = @_;
1745
1746         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1747
1748         my $author = undef;
1749         my $sauthor = undef;
1750         my $author_encoding;
1751         my $has_content_type;
1752         my $body_encoding;
1753         my $xfer_encoding;
1754         my $has_mime_version;
1755         @to = ();
1756         @cc = ();
1757         @xh = ();
1758         my $input_format = undef;
1759         my @header = ();
1760         $subject = $initial_subject;
1761         $message = "";
1762         $message_num++;
1763         undef $message_id;
1764         # Retrieve and unfold header fields.
1765         my @header_lines = ();
1766         while(<$fh>) {
1767                 last if /^\s*$/;
1768                 push(@header_lines, $_);
1769         }
1770         @header = unfold_headers(@header_lines);
1771         # Add computed headers, if applicable.
1772         unless ($no_header_cmd || ! $header_cmd) {
1773                 push @header, invoke_header_cmd($header_cmd, $t);
1774         }
1775         # Now parse the header
1776         foreach(@header) {
1777                 if (/^From /) {
1778                         $input_format = 'mbox';
1779                         next;
1780                 }
1781                 chomp;
1782                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1783                         $input_format = 'mbox';
1784                 }
1785
1786                 if (defined $input_format && $input_format eq 'mbox') {
1787                         if (/^Subject:\s+(.*)$/i) {
1788                                 $subject = $1;
1789                         }
1790                         elsif (/^From:\s+(.*)$/i) {
1791                                 ($author, $author_encoding) = unquote_rfc2047($1);
1792                                 $sauthor = sanitize_address($author);
1793                                 next if $suppress_cc{'author'};
1794                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1795                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1796                                         $1, $_) unless $quiet;
1797                                 push @cc, $1;
1798                         }
1799                         elsif (/^To:\s+(.*)$/i) {
1800                                 foreach my $addr (parse_address_line($1)) {
1801                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1802                                                 $addr, $_) unless $quiet;
1803                                         push @to, $addr;
1804                                 }
1805                         }
1806                         elsif (/^Cc:\s+(.*)$/i) {
1807                                 foreach my $addr (parse_address_line($1)) {
1808                                         my $qaddr = unquote_rfc2047($addr);
1809                                         my $saddr = sanitize_address($qaddr);
1810                                         if ($saddr eq $sender) {
1811                                                 next if ($suppress_cc{'self'});
1812                                         } else {
1813                                                 next if ($suppress_cc{'cc'});
1814                                         }
1815                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1816                                                 $addr, $_) unless $quiet;
1817                                         push @cc, $addr;
1818                                 }
1819                         }
1820                         elsif (/^Content-type:/i) {
1821                                 $has_content_type = 1;
1822                                 if (/charset="?([^ "]+)/) {
1823                                         $body_encoding = $1;
1824                                 }
1825                                 push @xh, $_;
1826                         }
1827                         elsif (/^MIME-Version/i) {
1828                                 $has_mime_version = 1;
1829                                 push @xh, $_;
1830                         }
1831                         elsif (/^Message-ID: (.*)/i) {
1832                                 $message_id = $1;
1833                         }
1834                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1835                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1836                         }
1837                         elsif (/^In-Reply-To: (.*)/i) {
1838                                 if (!$initial_in_reply_to || $thread) {
1839                                         $in_reply_to = $1;
1840                                 }
1841                         }
1842                         elsif (/^References: (.*)/i) {
1843                                 if (!$initial_in_reply_to || $thread) {
1844                                         $references = $1;
1845                                 }
1846                         }
1847                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1848                                 push @xh, $_;
1849                         }
1850                 } else {
1851                         # In the traditional
1852                         # "send lots of email" format,
1853                         # line 1 = cc
1854                         # line 2 = subject
1855                         # So let's support that, too.
1856                         $input_format = 'lots';
1857                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1858                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1859                                         $_, $_) unless $quiet;
1860                                 push @cc, $_;
1861                         } elsif (!defined $subject) {
1862                                 $subject = $_;
1863                         }
1864                 }
1865         }
1866         # Now parse the message body
1867         while(<$fh>) {
1868                 $message .=  $_;
1869                 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1870                         chomp;
1871                         my ($what, $c) = ($1, $2);
1872                         # strip garbage for the address we'll use:
1873                         $c = strip_garbage_one_address($c);
1874                         # sanitize a bit more to decide whether to suppress the address:
1875                         my $sc = sanitize_address($c);
1876                         if ($sc eq $sender) {
1877                                 next if ($suppress_cc{'self'});
1878                         } else {
1879                                 if ($what =~ /^Signed-off-by$/i) {
1880                                         next if $suppress_cc{'sob'};
1881                                 } elsif ($what =~ /-by$/i) {
1882                                         next if $suppress_cc{'misc-by'};
1883                                 } elsif ($what =~ /Cc/i) {
1884                                         next if $suppress_cc{'bodycc'};
1885                                 }
1886                         }
1887                         if ($c !~ /.+@.+|<.+>/) {
1888                                 printf("(body) Ignoring %s from line '%s'\n",
1889                                         $what, $_) unless $quiet;
1890                                 next;
1891                         }
1892                         push @cc, $c;
1893                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1894                                 $c, $_) unless $quiet;
1895                 }
1896         }
1897         close $fh;
1898
1899         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t, $quiet)
1900                 if defined $to_cmd;
1901         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1902                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1903
1904         if ($broken_encoding{$t} && !$has_content_type) {
1905                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1906                 $has_content_type = 1;
1907                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1908                 $body_encoding = $auto_8bit_encoding;
1909         }
1910
1911         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1912                 $subject = quote_subject($subject, $auto_8bit_encoding);
1913         }
1914
1915         if (defined $sauthor and $sauthor ne $sender) {
1916                 $message = "From: $author\n\n$message";
1917                 if (defined $author_encoding) {
1918                         if ($has_content_type) {
1919                                 if ($body_encoding eq $author_encoding) {
1920                                         # ok, we already have the right encoding
1921                                 }
1922                                 else {
1923                                         # uh oh, we should re-encode
1924                                 }
1925                         }
1926                         else {
1927                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1928                                 $has_content_type = 1;
1929                                 push @xh,
1930                                   "Content-Type: text/plain; charset=$author_encoding";
1931                         }
1932                 }
1933         }
1934         $xfer_encoding = '8bit' if not defined $xfer_encoding;
1935         ($message, $xfer_encoding) = apply_transfer_encoding(
1936                 $message, $xfer_encoding, $target_xfer_encoding);
1937         push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1938         unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1939
1940         $needs_confirm = (
1941                 $confirm eq "always" or
1942                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1943                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1944         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1945
1946         @to = process_address_list(@to);
1947         @cc = process_address_list(@cc);
1948
1949         @to = (@initial_to, @to);
1950         @cc = (@initial_cc, @cc);
1951
1952         if ($message_num == 1) {
1953                 if (defined $cover_cc and $cover_cc) {
1954                         @initial_cc = @cc;
1955                 }
1956                 if (defined $cover_to and $cover_to) {
1957                         @initial_to = @to;
1958                 }
1959         }
1960 }
1961
1962 # Prepares the email, prompts the user, and sends it out
1963 # Returns 0 if an edit was done and the function should be called again, or 1
1964 # on the email being successfully sent out.
1965 sub process_file {
1966         my ($t) = @_;
1967
1968         pre_process_file($t, $quiet);
1969
1970         my $message_was_sent = send_message();
1971         if ($message_was_sent == -1) {
1972                 do_edit($t);
1973                 return 0;
1974         }
1975
1976         # set up for the next message
1977         if ($thread) {
1978                 if ($message_was_sent &&
1979                   ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1980                   $message_num == 1)) {
1981                         $in_reply_to = $message_id;
1982                         if (length $references > 0) {
1983                                 $references .= "\n $message_id";
1984                         } else {
1985                                 $references = "$message_id";
1986                         }
1987                 }
1988         } elsif (!defined $initial_in_reply_to) {
1989                 # --thread and --in-reply-to manage the "In-Reply-To" header and by
1990                 # extension the "References" header. If these commands are not used, reset
1991                 # the header values to their defaults.
1992                 $in_reply_to = undef;
1993                 $references = '';
1994         }
1995         $message_id = undef;
1996         $num_sent++;
1997         if (defined $batch_size && $num_sent == $batch_size) {
1998                 $num_sent = 0;
1999                 $smtp->quit if defined $smtp;
2000                 undef $smtp;
2001                 undef $auth;
2002                 sleep($relogin_delay) if defined $relogin_delay;
2003         }
2004
2005         return 1;
2006 }
2007
2008 sub initialize_modified_loop_vars {
2009         $in_reply_to = $initial_in_reply_to;
2010         $references = $initial_in_reply_to || '';
2011         $message_num = 0;
2012 }
2013
2014 if ($validate) {
2015         # FIFOs can only be read once, exclude them from validation.
2016         my @real_files = ();
2017         foreach my $f (@files) {
2018                 unless (-p $f) {
2019                         push(@real_files, $f);
2020                 }
2021         }
2022
2023         # Run the loop once again to avoid gaps in the counter due to FIFO
2024         # arguments provided by the user.
2025         my $num = 1;
2026         my $num_files = scalar @real_files;
2027         $ENV{GIT_SENDEMAIL_FILE_TOTAL} = "$num_files";
2028         initialize_modified_loop_vars();
2029         foreach my $r (@real_files) {
2030                 $ENV{GIT_SENDEMAIL_FILE_COUNTER} = "$num";
2031                 pre_process_file($r, 1);
2032                 validate_patch($r, $target_xfer_encoding);
2033                 $num += 1;
2034         }
2035         delete $ENV{GIT_SENDEMAIL_FILE_COUNTER};
2036         delete $ENV{GIT_SENDEMAIL_FILE_TOTAL};
2037 }
2038
2039 initialize_modified_loop_vars();
2040 foreach my $t (@files) {
2041         while (!process_file($t)) {
2042                 # user edited the file
2043         }
2044 }
2045
2046 # Execute a command and return its output lines as an array.  Blank
2047 # lines which do not appear at the end of the output are reported as
2048 # errors.
2049 sub execute_cmd {
2050         my ($prefix, $cmd, $file) = @_;
2051         my @lines = ();
2052         my $seen_blank_line = 0;
2053         open my $fh, "-|", "$cmd \Q$file\E"
2054                 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
2055         while (my $line = <$fh>) {
2056                 die sprintf(__("(%s) Malformed output from '%s'"), $prefix, $cmd)
2057                     if $seen_blank_line;
2058                 if ($line =~ /^$/) {
2059                         $seen_blank_line = $line =~ /^$/;
2060                         next;
2061                 }
2062                 push @lines, $line;
2063         }
2064         close $fh
2065             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2066         return @lines;
2067 }
2068
2069 # Process headers lines, unfolding multiline headers as defined by RFC
2070 # 2822.
2071 sub unfold_headers {
2072         my @headers;
2073         foreach(@_) {
2074                 last if /^\s*$/;
2075                 if (/^\s+\S/ and @headers) {
2076                         chomp($headers[$#headers]);
2077                         s/^\s+/ /;
2078                         $headers[$#headers] .= $_;
2079                 } else {
2080                         push(@headers, $_);
2081                 }
2082         }
2083         return @headers;
2084 }
2085
2086 # Invoke the provided CMD with FILE as an argument, which should
2087 # output RFC 2822 email headers. Fold multiline headers and return the
2088 # headers as an array.
2089 sub invoke_header_cmd {
2090         my ($cmd, $file) = @_;
2091         my @lines = execute_cmd("header-cmd", $header_cmd, $file);
2092         return unfold_headers(@lines);
2093 }
2094
2095 # Execute a command (e.g. $to_cmd) to get a list of email addresses
2096 # and return a results array
2097 sub recipients_cmd {
2098         my ($prefix, $what, $cmd, $file, $quiet) = @_;
2099         my @lines = ();
2100         my @addresses = ();
2101
2102         @lines = execute_cmd($prefix, $cmd, $file);
2103         for my $address (@lines) {
2104                 $address =~ s/^\s*//g;
2105                 $address =~ s/\s*$//g;
2106                 $address = sanitize_address($address);
2107                 next if ($address eq $sender and $suppress_cc{'self'});
2108                 push @addresses, $address;
2109                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
2110                        $prefix, $what, $address, $cmd) unless $quiet;
2111                 }
2112         return @addresses;
2113 }
2114
2115 cleanup_compose_files();
2116
2117 sub cleanup_compose_files {
2118         unlink($compose_filename, $compose_filename . ".final") if $compose;
2119 }
2120
2121 $smtp->quit if $smtp;
2122
2123 sub apply_transfer_encoding {
2124         my $message = shift;
2125         my $from = shift;
2126         my $to = shift;
2127
2128         return ($message, $to) if ($from eq $to and $from ne '7bit');
2129
2130         require MIME::QuotedPrint;
2131         require MIME::Base64;
2132
2133         $message = MIME::QuotedPrint::decode($message)
2134                 if ($from eq 'quoted-printable');
2135         $message = MIME::Base64::decode($message)
2136                 if ($from eq 'base64');
2137
2138         $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2139                 if $to eq 'auto';
2140
2141         die __("cannot send message as 7bit")
2142                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2143         return ($message, $to)
2144                 if ($to eq '7bit' or $to eq '8bit');
2145         return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2146                 if ($to eq 'quoted-printable');
2147         return (MIME::Base64::encode($message, "\n"), $to)
2148                 if ($to eq 'base64');
2149         die __("invalid transfer encoding");
2150 }
2151
2152 sub unique_email_list {
2153         my %seen;
2154         my @emails;
2155
2156         foreach my $entry (@_) {
2157                 my $clean = extract_valid_address_or_die($entry);
2158                 $seen{$clean} ||= 0;
2159                 next if $seen{$clean}++;
2160                 push @emails, $entry;
2161         }
2162         return @emails;
2163 }
2164
2165 sub validate_patch {
2166         my ($fn, $xfer_encoding) = @_;
2167
2168         if ($repo) {
2169                 my $hook_name = 'sendemail-validate';
2170                 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2171                 require File::Spec;
2172                 my $validate_hook = File::Spec->catfile($hooks_path, $hook_name);
2173                 my $hook_error;
2174                 if (-x $validate_hook) {
2175                         require Cwd;
2176                         my $target = Cwd::abs_path($fn);
2177                         # The hook needs a correct cwd and GIT_DIR.
2178                         my $cwd_save = Cwd::getcwd();
2179                         chdir($repo->wc_path() or $repo->repo_path())
2180                                 or die("chdir: $!");
2181                         local $ENV{"GIT_DIR"} = $repo->repo_path();
2182
2183                         my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
2184
2185                         require File::Temp;
2186                         my ($header_filehandle, $header_filename) = File::Temp::tempfile(
2187                             TEMPLATE => ".gitsendemail.header.XXXXXX",
2188                             DIR => $repo->repo_path(),
2189                             UNLINK => 1,
2190                         );
2191                         print $header_filehandle $header;
2192
2193                         my @cmd = ("git", "hook", "run", "--ignore-missing",
2194                                     $hook_name, "--");
2195                         my @cmd_msg = (@cmd, "<patch>", "<header>");
2196                         my @cmd_run = (@cmd, $target, $header_filename);
2197                         $hook_error = system_or_msg(\@cmd_run, undef, "@cmd_msg");
2198                         chdir($cwd_save) or die("chdir: $!");
2199                 }
2200                 if ($hook_error) {
2201                         $hook_error = sprintf(
2202                             __("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2203                             $fn, $hook_name, $hook_error);
2204                         die $hook_error;
2205                 }
2206         }
2207
2208         # Any long lines will be automatically fixed if we use a suitable transfer
2209         # encoding.
2210         unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2211                 open(my $fh, '<', $fn)
2212                         or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2213                 while (my $line = <$fh>) {
2214                         if (length($line) > 998) {
2215                                 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2216                                                "warning: no patches were sent\n"), $fn, $.);
2217                         }
2218                 }
2219         }
2220         return;
2221 }
2222
2223 sub handle_backup {
2224         my ($last, $lastlen, $file, $known_suffix) = @_;
2225         my ($suffix, $skip);
2226
2227         $skip = 0;
2228         if (defined $last &&
2229             ($lastlen < length($file)) &&
2230             (substr($file, 0, $lastlen) eq $last) &&
2231             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2232                 if (defined $known_suffix && $suffix eq $known_suffix) {
2233                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2234                         $skip = 1;
2235                 } else {
2236                         # TRANSLATORS: please keep "[y|N]" as is.
2237                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2238                                          valid_re => qr/^(?:y|n)/i,
2239                                          default => 'n');
2240                         $skip = ($answer ne 'y');
2241                         if ($skip) {
2242                                 $known_suffix = $suffix;
2243                         }
2244                 }
2245         }
2246         return ($skip, $known_suffix);
2247 }
2248
2249 sub handle_backup_files {
2250         my @file = @_;
2251         my ($last, $lastlen, $known_suffix, $skip, @result);
2252         for my $file (@file) {
2253                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2254                                                        $file, $known_suffix);
2255                 push @result, $file unless $skip;
2256                 $last = $file;
2257                 $lastlen = length($file);
2258         }
2259         return @result;
2260 }
2261
2262 sub file_has_nonascii {
2263         my $fn = shift;
2264         open(my $fh, '<', $fn)
2265                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2266         while (my $line = <$fh>) {
2267                 return 1 if $line =~ /[^[:ascii:]]/;
2268         }
2269         return 0;
2270 }
2271
2272 sub body_or_subject_has_nonascii {
2273         my $fn = shift;
2274         open(my $fh, '<', $fn)
2275                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2276         while (my $line = <$fh>) {
2277                 last if $line =~ /^$/;
2278                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2279         }
2280         while (my $line = <$fh>) {
2281                 return 1 if $line =~ /[^[:ascii:]]/;
2282         }
2283         return 0;
2284 }