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\n") : __("Sent %s\n"), $subject);
1668         } else {
1669                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1670                 if (!defined $sendmail_cmd && !file_name_is_absolute($smtp_server)) {
1671                         print "Server: $smtp_server\n";
1672                         print "MAIL FROM:<$raw_from>\n";
1673                         foreach my $entry (@recipients) {
1674                             print "RCPT TO:<$entry>\n";
1675                         }
1676                 } else {
1677                         my $sm;
1678                         if (defined $sendmail_cmd) {
1679                                 $sm = $sendmail_cmd;
1680                         } else {
1681                                 $sm = $smtp_server;
1682                         }
1683
1684                         print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1685                 }
1686                 print $header, "\n";
1687                 if ($smtp) {
1688                         print __("Result: "), $smtp->code, ' ',
1689                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1690                 } else {
1691                         print __("Result: OK\n");
1692                 }
1693         }
1694
1695         return 1;
1696 }
1697
1698 sub pre_process_file {
1699         my ($t, $quiet) = @_;
1700
1701         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1702
1703         my $author = undef;
1704         my $sauthor = undef;
1705         my $author_encoding;
1706         my $has_content_type;
1707         my $body_encoding;
1708         my $xfer_encoding;
1709         my $has_mime_version;
1710         @to = ();
1711         @cc = ();
1712         @xh = ();
1713         my $input_format = undef;
1714         my @header = ();
1715         $subject = $initial_subject;
1716         $message = "";
1717         $message_num++;
1718         undef $message_id;
1719         # Retrieve and unfold header fields.
1720         my @header_lines = ();
1721         while(<$fh>) {
1722                 last if /^\s*$/;
1723                 push(@header_lines, $_);
1724         }
1725         @header = unfold_headers(@header_lines);
1726         # Add computed headers, if applicable.
1727         unless ($no_header_cmd || ! $header_cmd) {
1728                 push @header, invoke_header_cmd($header_cmd, $t);
1729         }
1730         # Now parse the header
1731         foreach(@header) {
1732                 if (/^From /) {
1733                         $input_format = 'mbox';
1734                         next;
1735                 }
1736                 chomp;
1737                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1738                         $input_format = 'mbox';
1739                 }
1740
1741                 if (defined $input_format && $input_format eq 'mbox') {
1742                         if (/^Subject:\s+(.*)$/i) {
1743                                 $subject = $1;
1744                         }
1745                         elsif (/^From:\s+(.*)$/i) {
1746                                 ($author, $author_encoding) = unquote_rfc2047($1);
1747                                 $sauthor = sanitize_address($author);
1748                                 next if $suppress_cc{'author'};
1749                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1750                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1751                                         $1, $_) unless $quiet;
1752                                 push @cc, $1;
1753                         }
1754                         elsif (/^To:\s+(.*)$/i) {
1755                                 foreach my $addr (parse_address_line($1)) {
1756                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1757                                                 $addr, $_) unless $quiet;
1758                                         push @to, $addr;
1759                                 }
1760                         }
1761                         elsif (/^Cc:\s+(.*)$/i) {
1762                                 foreach my $addr (parse_address_line($1)) {
1763                                         my $qaddr = unquote_rfc2047($addr);
1764                                         my $saddr = sanitize_address($qaddr);
1765                                         if ($saddr eq $sender) {
1766                                                 next if ($suppress_cc{'self'});
1767                                         } else {
1768                                                 next if ($suppress_cc{'cc'});
1769                                         }
1770                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1771                                                 $addr, $_) unless $quiet;
1772                                         push @cc, $addr;
1773                                 }
1774                         }
1775                         elsif (/^Content-type:/i) {
1776                                 $has_content_type = 1;
1777                                 if (/charset="?([^ "]+)/) {
1778                                         $body_encoding = $1;
1779                                 }
1780                                 push @xh, $_;
1781                         }
1782                         elsif (/^MIME-Version/i) {
1783                                 $has_mime_version = 1;
1784                                 push @xh, $_;
1785                         }
1786                         elsif (/^Message-ID: (.*)/i) {
1787                                 $message_id = $1;
1788                         }
1789                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1790                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1791                         }
1792                         elsif (/^In-Reply-To: (.*)/i) {
1793                                 if (!$initial_in_reply_to || $thread) {
1794                                         $in_reply_to = $1;
1795                                 }
1796                         }
1797                         elsif (/^References: (.*)/i) {
1798                                 if (!$initial_in_reply_to || $thread) {
1799                                         $references = $1;
1800                                 }
1801                         }
1802                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1803                                 push @xh, $_;
1804                         }
1805                 } else {
1806                         # In the traditional
1807                         # "send lots of email" format,
1808                         # line 1 = cc
1809                         # line 2 = subject
1810                         # So let's support that, too.
1811                         $input_format = 'lots';
1812                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1813                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1814                                         $_, $_) unless $quiet;
1815                                 push @cc, $_;
1816                         } elsif (!defined $subject) {
1817                                 $subject = $_;
1818                         }
1819                 }
1820         }
1821         # Now parse the message body
1822         while(<$fh>) {
1823                 $message .=  $_;
1824                 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1825                         chomp;
1826                         my ($what, $c) = ($1, $2);
1827                         # strip garbage for the address we'll use:
1828                         $c = strip_garbage_one_address($c);
1829                         # sanitize a bit more to decide whether to suppress the address:
1830                         my $sc = sanitize_address($c);
1831                         if ($sc eq $sender) {
1832                                 next if ($suppress_cc{'self'});
1833                         } else {
1834                                 if ($what =~ /^Signed-off-by$/i) {
1835                                         next if $suppress_cc{'sob'};
1836                                 } elsif ($what =~ /-by$/i) {
1837                                         next if $suppress_cc{'misc-by'};
1838                                 } elsif ($what =~ /Cc/i) {
1839                                         next if $suppress_cc{'bodycc'};
1840                                 }
1841                         }
1842                         if ($c !~ /.+@.+|<.+>/) {
1843                                 printf("(body) Ignoring %s from line '%s'\n",
1844                                         $what, $_) unless $quiet;
1845                                 next;
1846                         }
1847                         push @cc, $c;
1848                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1849                                 $c, $_) unless $quiet;
1850                 }
1851         }
1852         close $fh;
1853
1854         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t, $quiet)
1855                 if defined $to_cmd;
1856         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1857                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1858
1859         if ($broken_encoding{$t} && !$has_content_type) {
1860                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1861                 $has_content_type = 1;
1862                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1863                 $body_encoding = $auto_8bit_encoding;
1864         }
1865
1866         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1867                 $subject = quote_subject($subject, $auto_8bit_encoding);
1868         }
1869
1870         if (defined $sauthor and $sauthor ne $sender) {
1871                 $message = "From: $author\n\n$message";
1872                 if (defined $author_encoding) {
1873                         if ($has_content_type) {
1874                                 if ($body_encoding eq $author_encoding) {
1875                                         # ok, we already have the right encoding
1876                                 }
1877                                 else {
1878                                         # uh oh, we should re-encode
1879                                 }
1880                         }
1881                         else {
1882                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1883                                 $has_content_type = 1;
1884                                 push @xh,
1885                                   "Content-Type: text/plain; charset=$author_encoding";
1886                         }
1887                 }
1888         }
1889         $xfer_encoding = '8bit' if not defined $xfer_encoding;
1890         ($message, $xfer_encoding) = apply_transfer_encoding(
1891                 $message, $xfer_encoding, $target_xfer_encoding);
1892         push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1893         unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1894
1895         $needs_confirm = (
1896                 $confirm eq "always" or
1897                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1898                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1899         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1900
1901         @to = process_address_list(@to);
1902         @cc = process_address_list(@cc);
1903
1904         @to = (@initial_to, @to);
1905         @cc = (@initial_cc, @cc);
1906
1907         if ($message_num == 1) {
1908                 if (defined $cover_cc and $cover_cc) {
1909                         @initial_cc = @cc;
1910                 }
1911                 if (defined $cover_to and $cover_to) {
1912                         @initial_to = @to;
1913                 }
1914         }
1915 }
1916
1917 # Prepares the email, prompts the user, and sends it out
1918 # Returns 0 if an edit was done and the function should be called again, or 1
1919 # on the email being successfully sent out.
1920 sub process_file {
1921         my ($t) = @_;
1922
1923         pre_process_file($t, $quiet);
1924
1925         my $message_was_sent = send_message();
1926         if ($message_was_sent == -1) {
1927                 do_edit($t);
1928                 return 0;
1929         }
1930
1931         # set up for the next message
1932         if ($thread) {
1933                 if ($message_was_sent &&
1934                   ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1935                   $message_num == 1)) {
1936                         $in_reply_to = $message_id;
1937                         if (length $references > 0) {
1938                                 $references .= "\n $message_id";
1939                         } else {
1940                                 $references = "$message_id";
1941                         }
1942                 }
1943         } elsif (!defined $initial_in_reply_to) {
1944                 # --thread and --in-reply-to manage the "In-Reply-To" header and by
1945                 # extension the "References" header. If these commands are not used, reset
1946                 # the header values to their defaults.
1947                 $in_reply_to = undef;
1948                 $references = '';
1949         }
1950         $message_id = undef;
1951         $num_sent++;
1952         if (defined $batch_size && $num_sent == $batch_size) {
1953                 $num_sent = 0;
1954                 $smtp->quit if defined $smtp;
1955                 undef $smtp;
1956                 undef $auth;
1957                 sleep($relogin_delay) if defined $relogin_delay;
1958         }
1959
1960         return 1;
1961 }
1962
1963 sub initialize_modified_loop_vars {
1964         $in_reply_to = $initial_in_reply_to;
1965         $references = $initial_in_reply_to || '';
1966         $message_num = 0;
1967 }
1968
1969 if ($validate) {
1970         # FIFOs can only be read once, exclude them from validation.
1971         my @real_files = ();
1972         foreach my $f (@files) {
1973                 unless (-p $f) {
1974                         push(@real_files, $f);
1975                 }
1976         }
1977
1978         # Run the loop once again to avoid gaps in the counter due to FIFO
1979         # arguments provided by the user.
1980         my $num = 1;
1981         my $num_files = scalar @real_files;
1982         $ENV{GIT_SENDEMAIL_FILE_TOTAL} = "$num_files";
1983         initialize_modified_loop_vars();
1984         foreach my $r (@real_files) {
1985                 $ENV{GIT_SENDEMAIL_FILE_COUNTER} = "$num";
1986                 pre_process_file($r, 1);
1987                 validate_patch($r, $target_xfer_encoding);
1988                 $num += 1;
1989         }
1990         delete $ENV{GIT_SENDEMAIL_FILE_COUNTER};
1991         delete $ENV{GIT_SENDEMAIL_FILE_TOTAL};
1992 }
1993
1994 initialize_modified_loop_vars();
1995 foreach my $t (@files) {
1996         while (!process_file($t)) {
1997                 # user edited the file
1998         }
1999 }
2000
2001 # Execute a command and return its output lines as an array.  Blank
2002 # lines which do not appear at the end of the output are reported as
2003 # errors.
2004 sub execute_cmd {
2005         my ($prefix, $cmd, $file) = @_;
2006         my @lines = ();
2007         my $seen_blank_line = 0;
2008         open my $fh, "-|", "$cmd \Q$file\E"
2009                 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
2010         while (my $line = <$fh>) {
2011                 die sprintf(__("(%s) Malformed output from '%s'"), $prefix, $cmd)
2012                     if $seen_blank_line;
2013                 if ($line =~ /^$/) {
2014                         $seen_blank_line = $line =~ /^$/;
2015                         next;
2016                 }
2017                 push @lines, $line;
2018         }
2019         close $fh
2020             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2021         return @lines;
2022 }
2023
2024 # Process headers lines, unfolding multiline headers as defined by RFC
2025 # 2822.
2026 sub unfold_headers {
2027         my @headers;
2028         foreach(@_) {
2029                 last if /^\s*$/;
2030                 if (/^\s+\S/ and @headers) {
2031                         chomp($headers[$#headers]);
2032                         s/^\s+/ /;
2033                         $headers[$#headers] .= $_;
2034                 } else {
2035                         push(@headers, $_);
2036                 }
2037         }
2038         return @headers;
2039 }
2040
2041 # Invoke the provided CMD with FILE as an argument, which should
2042 # output RFC 2822 email headers. Fold multiline headers and return the
2043 # headers as an array.
2044 sub invoke_header_cmd {
2045         my ($cmd, $file) = @_;
2046         my @lines = execute_cmd("header-cmd", $header_cmd, $file);
2047         return unfold_headers(@lines);
2048 }
2049
2050 # Execute a command (e.g. $to_cmd) to get a list of email addresses
2051 # and return a results array
2052 sub recipients_cmd {
2053         my ($prefix, $what, $cmd, $file, $quiet) = @_;
2054         my @lines = ();
2055         my @addresses = ();
2056
2057         @lines = execute_cmd($prefix, $cmd, $file);
2058         for my $address (@lines) {
2059                 $address =~ s/^\s*//g;
2060                 $address =~ s/\s*$//g;
2061                 $address = sanitize_address($address);
2062                 next if ($address eq $sender and $suppress_cc{'self'});
2063                 push @addresses, $address;
2064                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
2065                        $prefix, $what, $address, $cmd) unless $quiet;
2066                 }
2067         return @addresses;
2068 }
2069
2070 cleanup_compose_files();
2071
2072 sub cleanup_compose_files {
2073         unlink($compose_filename, $compose_filename . ".final") if $compose;
2074 }
2075
2076 $smtp->quit if $smtp;
2077
2078 sub apply_transfer_encoding {
2079         my $message = shift;
2080         my $from = shift;
2081         my $to = shift;
2082
2083         return ($message, $to) if ($from eq $to and $from ne '7bit');
2084
2085         require MIME::QuotedPrint;
2086         require MIME::Base64;
2087
2088         $message = MIME::QuotedPrint::decode($message)
2089                 if ($from eq 'quoted-printable');
2090         $message = MIME::Base64::decode($message)
2091                 if ($from eq 'base64');
2092
2093         $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2094                 if $to eq 'auto';
2095
2096         die __("cannot send message as 7bit")
2097                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2098         return ($message, $to)
2099                 if ($to eq '7bit' or $to eq '8bit');
2100         return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2101                 if ($to eq 'quoted-printable');
2102         return (MIME::Base64::encode($message, "\n"), $to)
2103                 if ($to eq 'base64');
2104         die __("invalid transfer encoding");
2105 }
2106
2107 sub unique_email_list {
2108         my %seen;
2109         my @emails;
2110
2111         foreach my $entry (@_) {
2112                 my $clean = extract_valid_address_or_die($entry);
2113                 $seen{$clean} ||= 0;
2114                 next if $seen{$clean}++;
2115                 push @emails, $entry;
2116         }
2117         return @emails;
2118 }
2119
2120 sub validate_patch {
2121         my ($fn, $xfer_encoding) = @_;
2122
2123         if ($repo) {
2124                 my $hook_name = 'sendemail-validate';
2125                 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2126                 require File::Spec;
2127                 my $validate_hook = File::Spec->catfile($hooks_path, $hook_name);
2128                 my $hook_error;
2129                 if (-x $validate_hook) {
2130                         require Cwd;
2131                         my $target = Cwd::abs_path($fn);
2132                         # The hook needs a correct cwd and GIT_DIR.
2133                         my $cwd_save = Cwd::getcwd();
2134                         chdir($repo->wc_path() or $repo->repo_path())
2135                                 or die("chdir: $!");
2136                         local $ENV{"GIT_DIR"} = $repo->repo_path();
2137
2138                         my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
2139
2140                         require File::Temp;
2141                         my ($header_filehandle, $header_filename) = File::Temp::tempfile(
2142                             TEMPLATE => ".gitsendemail.header.XXXXXX",
2143                             DIR => $repo->repo_path(),
2144                             UNLINK => 1,
2145                         );
2146                         print $header_filehandle $header;
2147
2148                         my @cmd = ("git", "hook", "run", "--ignore-missing",
2149                                     $hook_name, "--");
2150                         my @cmd_msg = (@cmd, "<patch>", "<header>");
2151                         my @cmd_run = (@cmd, $target, $header_filename);
2152                         $hook_error = system_or_msg(\@cmd_run, undef, "@cmd_msg");
2153                         chdir($cwd_save) or die("chdir: $!");
2154                 }
2155                 if ($hook_error) {
2156                         $hook_error = sprintf(
2157                             __("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2158                             $fn, $hook_name, $hook_error);
2159                         die $hook_error;
2160                 }
2161         }
2162
2163         # Any long lines will be automatically fixed if we use a suitable transfer
2164         # encoding.
2165         unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2166                 open(my $fh, '<', $fn)
2167                         or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2168                 while (my $line = <$fh>) {
2169                         if (length($line) > 998) {
2170                                 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2171                                                "warning: no patches were sent\n"), $fn, $.);
2172                         }
2173                 }
2174         }
2175         return;
2176 }
2177
2178 sub handle_backup {
2179         my ($last, $lastlen, $file, $known_suffix) = @_;
2180         my ($suffix, $skip);
2181
2182         $skip = 0;
2183         if (defined $last &&
2184             ($lastlen < length($file)) &&
2185             (substr($file, 0, $lastlen) eq $last) &&
2186             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2187                 if (defined $known_suffix && $suffix eq $known_suffix) {
2188                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2189                         $skip = 1;
2190                 } else {
2191                         # TRANSLATORS: please keep "[y|N]" as is.
2192                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2193                                          valid_re => qr/^(?:y|n)/i,
2194                                          default => 'n');
2195                         $skip = ($answer ne 'y');
2196                         if ($skip) {
2197                                 $known_suffix = $suffix;
2198                         }
2199                 }
2200         }
2201         return ($skip, $known_suffix);
2202 }
2203
2204 sub handle_backup_files {
2205         my @file = @_;
2206         my ($last, $lastlen, $known_suffix, $skip, @result);
2207         for my $file (@file) {
2208                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2209                                                        $file, $known_suffix);
2210                 push @result, $file unless $skip;
2211                 $last = $file;
2212                 $lastlen = length($file);
2213         }
2214         return @result;
2215 }
2216
2217 sub file_has_nonascii {
2218         my $fn = shift;
2219         open(my $fh, '<', $fn)
2220                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2221         while (my $line = <$fh>) {
2222                 return 1 if $line =~ /[^[:ascii:]]/;
2223         }
2224         return 0;
2225 }
2226
2227 sub body_or_subject_has_nonascii {
2228         my $fn = shift;
2229         open(my $fh, '<', $fn)
2230                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2231         while (my $line = <$fh>) {
2232                 last if $line =~ /^$/;
2233                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2234         }
2235         while (my $line = <$fh>) {
2236                 return 1 if $line =~ /[^[:ascii:]]/;
2237         }
2238         return 0;
2239 }