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