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