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