git-send-email.perl

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