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