git-send-email.perl

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