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