git-send-email.perl

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