git-send-email.perl

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