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