git-send-email.perl

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