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 if ($validate) {
 803         # FIFOs can only be read once, exclude them from validation.
 804         my @real_files = ();
 805         foreach my $f (@files) {
 806                 unless (-p $f) {
 807                         push(@real_files, $f);
 808                 }
 809         }
 810
 811         # Run the loop once again to avoid gaps in the counter due to FIFO
 812         # arguments provided by the user.
 813         my $num = 1;
 814         my $num_files = scalar @real_files;
 815         $ENV{GIT_SENDEMAIL_FILE_TOTAL} = "$num_files";
 816         foreach my $r (@real_files) {
 817                 $ENV{GIT_SENDEMAIL_FILE_COUNTER} = "$num";
 818                 pre_process_file($r, 1);
 819                 validate_patch($r, $target_xfer_encoding);
 820                 $num += 1;
 821         }
 822         delete $ENV{GIT_SENDEMAIL_FILE_COUNTER};
 823         delete $ENV{GIT_SENDEMAIL_FILE_TOTAL};
 824 }
 825
 826 @files = handle_backup_files(@files);
 827
 828 if (@files) {
 829         unless ($quiet) {
 830                 print $_,"\n" for (@files);
 831         }
 832 } else {
 833         print STDERR __("\nNo patch files specified!\n\n");
 834         usage();
 835 }
 836
 837 sub get_patch_subject {
 838         my $fn = shift;
 839         open (my $fh, '<', $fn);
 840         while (my $line = <$fh>) {
 841                 next unless ($line =~ /^Subject: (.*)$/);
 842                 close $fh;
 843                 return "GIT: $1\n";
 844         }
 845         close $fh;
 846         die sprintf(__("No subject line in %s?"), $fn);
 847 }
 848
 849 if ($compose) {
 850         # Note that this does not need to be secure, but we will make a small
 851         # effort to have it be unique
 852         require File::Temp;
 853         $compose_filename = ($repo ?
 854                 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
 855                 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
 856         open my $c, ">", $compose_filename
 857                 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 858
 859
 860         my $tpl_sender = $sender || $repoauthor->() || $repocommitter->() || '';
 861         my $tpl_subject = $initial_subject || '';
 862         my $tpl_in_reply_to = $initial_in_reply_to || '';
 863         my $tpl_reply_to = $reply_to || '';
 864         my $tpl_to = join(',', @initial_to);
 865         my $tpl_cc = join(',', @initial_cc);
 866         my $tpl_bcc = join(', ', @initial_bcc);
 867
 868         print $c <<EOT1, Git::prefix_lines("GIT: ", __(<<EOT2)), <<EOT3;
 869 From $tpl_sender # This line is ignored.
 870 EOT1
 871 Lines beginning in "GIT:" will be removed.
 872 Consider including an overall diffstat or table of contents
 873 for the patch you are writing.
 874
 875 Clear the body content if you don't wish to send a summary.
 876 EOT2
 877 From: $tpl_sender
 878 To: $tpl_to
 879 Cc: $tpl_cc
 880 Bcc: $tpl_bcc
 881 Reply-To: $tpl_reply_to
 882 Subject: $tpl_subject
 883 In-Reply-To: $tpl_in_reply_to
 884
 885 EOT3
 886         for my $f (@files) {
 887                 print $c get_patch_subject($f);
 888         }
 889         close $c;
 890
 891         if ($annotate) {
 892                 do_edit($compose_filename, @files);
 893         } else {
 894                 do_edit($compose_filename);
 895         }
 896
 897         open my $c2, ">", $compose_filename . ".final"
 898                 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 899
 900         open $c, "<", $compose_filename
 901                 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 902
 903         my $need_8bit_cte = file_has_nonascii($compose_filename);
 904         my $in_body = 0;
 905         my $summary_empty = 1;
 906         if (!defined $compose_encoding) {
 907                 $compose_encoding = "UTF-8";
 908         }
 909         while(<$c>) {
 910                 next if m/^GIT:/;
 911                 if ($in_body) {
 912                         $summary_empty = 0 unless (/^\n$/);
 913                 } elsif (/^\n$/) {
 914                         $in_body = 1;
 915                         if ($need_8bit_cte) {
 916                                 print $c2 "MIME-Version: 1.0\n",
 917                                          "Content-Type: text/plain; ",
 918                                            "charset=$compose_encoding\n",
 919                                          "Content-Transfer-Encoding: 8bit\n";
 920                         }
 921                 } elsif (/^MIME-Version:/i) {
 922                         $need_8bit_cte = 0;
 923                 } elsif (/^Subject:\s*(.+)\s*$/i) {
 924                         $initial_subject = $1;
 925                         my $subject = $initial_subject;
 926                         $_ = "Subject: " .
 927                                 quote_subject($subject, $compose_encoding) .
 928                                 "\n";
 929                 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
 930                         $initial_in_reply_to = $1;
 931                         next;
 932                 } elsif (/^Reply-To:\s*(.+)\s*$/i) {
 933                         $reply_to = $1;
 934                 } elsif (/^From:\s*(.+)\s*$/i) {
 935                         $sender = $1;
 936                         next;
 937                 } elsif (/^To:\s*(.+)\s*$/i) {
 938                         @initial_to = parse_address_line($1);
 939                         next;
 940                 } elsif (/^Cc:\s*(.+)\s*$/i) {
 941                         @initial_cc = parse_address_line($1);
 942                         next;
 943                 } elsif (/^Bcc:/i) {
 944                         @initial_bcc = parse_address_line($1);
 945                         next;
 946                 }
 947                 print $c2 $_;
 948         }
 949         close $c;
 950         close $c2;
 951
 952         if ($summary_empty) {
 953                 print __("Summary email is empty, skipping it\n");
 954                 $compose = -1;
 955         }
 956 } elsif ($annotate) {
 957         do_edit(@files);
 958 }
 959
 960 {
 961         # Only instantiate one $term per program run, since some
 962         # Term::ReadLine providers refuse to create a second instance.
 963         my $term;
 964         sub term {
 965                 require Term::ReadLine;
 966                 if (!defined $term) {
 967                         $term = $ENV{"GIT_SEND_EMAIL_NOTTY"}
 968                                 ? Term::ReadLine->new('git-send-email', \*STDIN, \*STDOUT)
 969                                 : Term::ReadLine->new('git-send-email');
 970                 }
 971                 return $term;
 972         }
 973 }
 974
 975 sub ask {
 976         my ($prompt, %arg) = @_;
 977         my $valid_re = $arg{valid_re};
 978         my $default = $arg{default};
 979         my $confirm_only = $arg{confirm_only};
 980         my $resp;
 981         my $i = 0;
 982         my $term = term();
 983         return defined $default ? $default : undef
 984                 unless defined $term->IN and defined fileno($term->IN) and
 985                        defined $term->OUT and defined fileno($term->OUT);
 986         while ($i++ < 10) {
 987                 $resp = $term->readline($prompt);
 988                 if (!defined $resp) { # EOF
 989                         print "\n";
 990                         return defined $default ? $default : undef;
 991                 }
 992                 if ($resp eq '' and defined $default) {
 993                         return $default;
 994                 }
 995                 if (!defined $valid_re or $resp =~ /$valid_re/) {
 996                         return $resp;
 997                 }
 998                 if ($confirm_only) {
 999                         my $yesno = $term->readline(
1000                                 # TRANSLATORS: please keep [y/N] as is.
1001                                 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
1002                         if (defined $yesno && $yesno =~ /y/i) {
1003                                 return $resp;
1004                         }
1005                 }
1006         }
1007         return;
1008 }
1009
1010 my %broken_encoding;
1011
1012 sub file_declares_8bit_cte {
1013         my $fn = shift;
1014         open (my $fh, '<', $fn);
1015         while (my $line = <$fh>) {
1016                 last if ($line =~ /^$/);
1017                 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
1018         }
1019         close $fh;
1020         return 0;
1021 }
1022
1023 foreach my $f (@files) {
1024         next unless (body_or_subject_has_nonascii($f)
1025                      && !file_declares_8bit_cte($f));
1026         $broken_encoding{$f} = 1;
1027 }
1028
1029 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
1030         print __("The following files are 8bit, but do not declare " .
1031                  "a Content-Transfer-Encoding.\n");
1032         foreach my $f (sort keys %broken_encoding) {
1033                 print "    $f\n";
1034         }
1035         $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
1036                                   valid_re => qr/.{4}/, confirm_only => 1,
1037                                   default => "UTF-8");
1038 }
1039
1040 if (!$force) {
1041         for my $f (@files) {
1042                 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
1043                         die sprintf(__("Refusing to send because the patch\n\t%s\n"
1044                                 . "has the template subject '*** SUBJECT HERE ***'. "
1045                                 . "Pass --force if you really want to send.\n"), $f);
1046                 }
1047         }
1048 }
1049
1050 my $to_whom = __("To whom should the emails be sent (if anyone)?");
1051 my $prompting = 0;
1052 if (!@initial_to && !defined $to_cmd) {
1053         my $to = ask("$to_whom ",
1054                      default => "",
1055                      valid_re => qr/\@.*\./, confirm_only => 1);
1056         push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
1057         $prompting++;
1058 }
1059
1060 sub expand_aliases {
1061         return map { expand_one_alias($_) } @_;
1062 }
1063
1064 my %EXPANDED_ALIASES;
1065 sub expand_one_alias {
1066         my $alias = shift;
1067         if ($EXPANDED_ALIASES{$alias}) {
1068                 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
1069         }
1070         local $EXPANDED_ALIASES{$alias} = 1;
1071         return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
1072 }
1073
1074 @initial_to = process_address_list(@initial_to);
1075 @initial_cc = process_address_list(@initial_cc);
1076 @initial_bcc = process_address_list(@initial_bcc);
1077
1078 if ($thread && !defined $initial_in_reply_to && $prompting) {
1079         $initial_in_reply_to = ask(
1080                 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
1081                 default => "",
1082                 valid_re => qr/\@.*\./, confirm_only => 1);
1083 }
1084 if (defined $initial_in_reply_to) {
1085         $initial_in_reply_to =~ s/^\s*<?//;
1086         $initial_in_reply_to =~ s/>?\s*$//;
1087         $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
1088 }
1089
1090 if (defined $reply_to) {
1091         $reply_to =~ s/^\s+|\s+$//g;
1092         ($reply_to) = expand_aliases($reply_to);
1093         $reply_to = sanitize_address($reply_to);
1094 }
1095
1096 if (!defined $sendmail_cmd && !defined $smtp_server) {
1097         my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1098         push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
1099         foreach (@sendmail_paths) {
1100                 if (-x $_) {
1101                         $sendmail_cmd = $_;
1102                         last;
1103                 }
1104         }
1105
1106         if (!defined $sendmail_cmd) {
1107                 $smtp_server = 'localhost'; # could be 127.0.0.1, too... *shrug*
1108         }
1109 }
1110
1111 if ($compose && $compose > 0) {
1112         @files = ($compose_filename . ".final", @files);
1113 }
1114
1115 # Variables we set as part of the loop over files
1116 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
1117         $needs_confirm, $message_num, $ask_default);
1118
1119 sub extract_valid_address {
1120         my $address = shift;
1121         my $local_part_regexp = qr/[^<>"\s@]+/;
1122         my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
1123
1124         # check for a local address:
1125         return $address if ($address =~ /^($local_part_regexp)$/);
1126
1127         $address =~ s/^\s*<(.*)>\s*$/$1/;
1128         my $have_email_valid = eval { require Email::Valid; 1 };
1129         if ($have_email_valid) {
1130                 return scalar Email::Valid->address($address);
1131         }
1132
1133         # less robust/correct than the monster regexp in Email::Valid,
1134         # but still does a 99% job, and one less dependency
1135         return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1136         return;
1137 }
1138
1139 sub extract_valid_address_or_die {
1140         my $address = shift;
1141         my $valid_address = extract_valid_address($address);
1142         die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1143                 if !$valid_address;
1144         return $valid_address;
1145 }
1146
1147 sub validate_address {
1148         my $address = shift;
1149         while (!extract_valid_address($address)) {
1150                 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1151                 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1152                 # translation. The program will only accept English input
1153                 # at this point.
1154                 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1155                         valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1156                         default => 'q');
1157                 if (/^d/i) {
1158                         return undef;
1159                 } elsif (/^q/i) {
1160                         cleanup_compose_files();
1161                         exit(0);
1162                 }
1163                 $address = ask("$to_whom ",
1164                         default => "",
1165                         valid_re => qr/\@.*\./, confirm_only => 1);
1166         }
1167         return $address;
1168 }
1169
1170 sub validate_address_list {
1171         return (grep { defined $_ }
1172                 map { validate_address($_) } @_);
1173 }
1174
1175 # Usually don't need to change anything below here.
1176
1177 # we make a "fake" message id by taking the current number
1178 # of seconds since the beginning of Unix time and tacking on
1179 # a random number to the end, in case we are called quicker than
1180 # 1 second since the last time we were called.
1181
1182 # We'll setup a template for the message id, using the "from" address:
1183
1184 my ($message_id_stamp, $message_id_serial);
1185 sub make_message_id {
1186         my $uniq;
1187         if (!defined $message_id_stamp) {
1188                 require POSIX;
1189                 $message_id_stamp = POSIX::strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1190                 $message_id_serial = 0;
1191         }
1192         $message_id_serial++;
1193         $uniq = "$message_id_stamp-$message_id_serial";
1194
1195         my $du_part;
1196         for ($sender, $repocommitter->(), $repoauthor->()) {
1197                 $du_part = extract_valid_address(sanitize_address($_));
1198                 last if (defined $du_part and $du_part ne '');
1199         }
1200         if (not defined $du_part or $du_part eq '') {
1201                 require Sys::Hostname;
1202                 $du_part = 'user@' . Sys::Hostname::hostname();
1203         }
1204         my $message_id_template = "<%s-%s>";
1205         $message_id = sprintf($message_id_template, $uniq, $du_part);
1206         #print "new message id = $message_id\n"; # Was useful for debugging
1207 }
1208
1209 sub unquote_rfc2047 {
1210         local ($_) = @_;
1211         my $charset;
1212         my $sep = qr/[ \t]+/;
1213         s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1214                 my @words = split $sep, $&;
1215                 foreach (@words) {
1216                         m/$re_encoded_word/;
1217                         $charset = $1;
1218                         my $encoding = $2;
1219                         my $text = $3;
1220                         if ($encoding eq 'q' || $encoding eq 'Q') {
1221                                 $_ = $text;
1222                                 s/_/ /g;
1223                                 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1224                         } else {
1225                                 # other encodings not supported yet
1226                         }
1227                 }
1228                 join '', @words;
1229         }eg;
1230         return wantarray ? ($_, $charset) : $_;
1231 }
1232
1233 sub quote_rfc2047 {
1234         local $_ = shift;
1235         my $encoding = shift || 'UTF-8';
1236         s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1237         s/(.*)/=\?$encoding\?q\?$1\?=/;
1238         return $_;
1239 }
1240
1241 sub is_rfc2047_quoted {
1242         my $s = shift;
1243         length($s) <= 75 &&
1244         $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1245 }
1246
1247 sub subject_needs_rfc2047_quoting {
1248         my $s = shift;
1249
1250         return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1251 }
1252
1253 sub quote_subject {
1254         local $subject = shift;
1255         my $encoding = shift || 'UTF-8';
1256
1257         if (subject_needs_rfc2047_quoting($subject)) {
1258                 return quote_rfc2047($subject, $encoding);
1259         }
1260         return $subject;
1261 }
1262
1263 # use the simplest quoting being able to handle the recipient
1264 sub sanitize_address {
1265         my ($recipient) = @_;
1266
1267         # remove garbage after email address
1268         $recipient =~ s/(.*>).*$/$1/;
1269
1270         my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1271
1272         if (not $recipient_name) {
1273                 return $recipient;
1274         }
1275
1276         # if recipient_name is already quoted, do nothing
1277         if (is_rfc2047_quoted($recipient_name)) {
1278                 return $recipient;
1279         }
1280
1281         # remove non-escaped quotes
1282         $recipient_name =~ s/(^|[^\\])"/$1/g;
1283
1284         # rfc2047 is needed if a non-ascii char is included
1285         if ($recipient_name =~ /[^[:ascii:]]/) {
1286                 $recipient_name = quote_rfc2047($recipient_name);
1287         }
1288
1289         # double quotes are needed if specials or CTLs are included
1290         elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1291                 $recipient_name =~ s/([\\\r])/\\$1/g;
1292                 $recipient_name = qq["$recipient_name"];
1293         }
1294
1295         return "$recipient_name $recipient_addr";
1296
1297 }
1298
1299 sub strip_garbage_one_address {
1300         my ($addr) = @_;
1301         chomp $addr;
1302         if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1303                 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1304                 # Foo Bar <foobar@example.com> [possibly garbage here]
1305                 return $1;
1306         }
1307         if ($addr =~ /^(<[^>]*>).*/) {
1308                 # <foo@example.com> [possibly garbage here]
1309                 # if garbage contains other addresses, they are ignored.
1310                 return $1;
1311         }
1312         if ($addr =~ /^([^"#,\s]*)/) {
1313                 # address without quoting: remove anything after the address
1314                 return $1;
1315         }
1316         return $addr;
1317 }
1318
1319 sub sanitize_address_list {
1320         return (map { sanitize_address($_) } @_);
1321 }
1322
1323 sub process_address_list {
1324         my @addr_list = map { parse_address_line($_) } @_;
1325         @addr_list = expand_aliases(@addr_list);
1326         @addr_list = sanitize_address_list(@addr_list);
1327         @addr_list = validate_address_list(@addr_list);
1328         return @addr_list;
1329 }
1330
1331 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1332 #
1333 # Tightly configured MTAa require that a caller sends a real DNS
1334 # domain name that corresponds the IP address in the HELO/EHLO
1335 # handshake. This is used to verify the connection and prevent
1336 # spammers from trying to hide their identity. If the DNS and IP don't
1337 # match, the receiving MTA may deny the connection.
1338 #
1339 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1340 #
1341 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1342 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1343 #
1344 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1345 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1346
1347 sub valid_fqdn {
1348         my $domain = shift;
1349         return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1350 }
1351
1352 sub maildomain_net {
1353         my $maildomain;
1354
1355         require Net::Domain;
1356         my $domain = Net::Domain::domainname();
1357         $maildomain = $domain if valid_fqdn($domain);
1358
1359         return $maildomain;
1360 }
1361
1362 sub maildomain_mta {
1363         my $maildomain;
1364
1365         for my $host (qw(mailhost localhost)) {
1366                 require Net::SMTP;
1367                 my $smtp = Net::SMTP->new($host);
1368                 if (defined $smtp) {
1369                         my $domain = $smtp->domain;
1370                         $smtp->quit;
1371
1372                         $maildomain = $domain if valid_fqdn($domain);
1373
1374                         last if $maildomain;
1375                 }
1376         }
1377
1378         return $maildomain;
1379 }
1380
1381 sub maildomain {
1382         return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1383 }
1384
1385 sub smtp_host_string {
1386         if (defined $smtp_server_port) {
1387                 return "$smtp_server:$smtp_server_port";
1388         } else {
1389                 return $smtp_server;
1390         }
1391 }
1392
1393 # Returns 1 if authentication succeeded or was not necessary
1394 # (smtp_user was not specified), and 0 otherwise.
1395
1396 sub smtp_auth_maybe {
1397         if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1398                 return 1;
1399         }
1400
1401         # Workaround AUTH PLAIN/LOGIN interaction defect
1402         # with Authen::SASL::Cyrus
1403         eval {
1404                 require Authen::SASL;
1405                 Authen::SASL->import(qw(Perl));
1406         };
1407
1408         # Check mechanism naming as defined in:
1409         # https://tools.ietf.org/html/rfc4422#page-8
1410         if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1411                 die "invalid smtp auth: '${smtp_auth}'";
1412         }
1413
1414         # TODO: Authentication may fail not because credentials were
1415         # invalid but due to other reasons, in which we should not
1416         # reject credentials.
1417         $auth = Git::credential({
1418                 'protocol' => 'smtp',
1419                 'host' => smtp_host_string(),
1420                 'username' => $smtp_authuser,
1421                 # if there's no password, "git credential fill" will
1422                 # give us one, otherwise it'll just pass this one.
1423                 'password' => $smtp_authpass
1424         }, sub {
1425                 my $cred = shift;
1426
1427                 if ($smtp_auth) {
1428                         my $sasl = Authen::SASL->new(
1429                                 mechanism => $smtp_auth,
1430                                 callback => {
1431                                         user => $cred->{'username'},
1432                                         pass => $cred->{'password'},
1433                                         authname => $cred->{'username'},
1434                                 }
1435                         );
1436
1437                         return !!$smtp->auth($sasl);
1438                 }
1439
1440                 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1441         });
1442
1443         return $auth;
1444 }
1445
1446 sub ssl_verify_params {
1447         eval {
1448                 require IO::Socket::SSL;
1449                 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1450         };
1451         if ($@) {
1452                 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1453                 return;
1454         }
1455
1456         if (!defined $smtp_ssl_cert_path) {
1457                 # use the OpenSSL defaults
1458                 return (SSL_verify_mode => SSL_VERIFY_PEER());
1459         }
1460
1461         if ($smtp_ssl_cert_path eq "") {
1462                 return (SSL_verify_mode => SSL_VERIFY_NONE());
1463         } elsif (-d $smtp_ssl_cert_path) {
1464                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1465                         SSL_ca_path => $smtp_ssl_cert_path);
1466         } elsif (-f $smtp_ssl_cert_path) {
1467                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1468                         SSL_ca_file => $smtp_ssl_cert_path);
1469         } else {
1470                 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1471         }
1472 }
1473
1474 sub file_name_is_absolute {
1475         my ($path) = @_;
1476
1477         # msys does not grok DOS drive-prefixes
1478         if ($^O eq 'msys') {
1479                 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1480         }
1481
1482         require File::Spec::Functions;
1483         return File::Spec::Functions::file_name_is_absolute($path);
1484 }
1485
1486 sub gen_header {
1487         my @recipients = unique_email_list(@to);
1488         @cc = (grep { my $cc = extract_valid_address_or_die($_);
1489                       not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1490                     }
1491                @cc);
1492         my $to = join (",\n\t", @recipients);
1493         @recipients = unique_email_list(@recipients,@cc,@initial_bcc);
1494         @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1495         my $date = format_2822_time($time++);
1496         my $gitversion = '@@GIT_VERSION@@';
1497         if ($gitversion =~ m/..GIT_VERSION../) {
1498             $gitversion = Git::version();
1499         }
1500
1501         my $cc = join(",\n\t", unique_email_list(@cc));
1502         my $ccline = "";
1503         if ($cc ne '') {
1504                 $ccline = "\nCc: $cc";
1505         }
1506         make_message_id() unless defined($message_id);
1507
1508         my $header = "From: $sender
1509 To: $to${ccline}
1510 Subject: $subject
1511 Date: $date
1512 Message-ID: $message_id
1513 ";
1514         if ($use_xmailer) {
1515                 $header .= "X-Mailer: git-send-email $gitversion\n";
1516         }
1517         if ($in_reply_to) {
1518
1519                 $header .= "In-Reply-To: $in_reply_to\n";
1520                 $header .= "References: $references\n";
1521         }
1522         if ($reply_to) {
1523                 $header .= "Reply-To: $reply_to\n";
1524         }
1525         if (@xh) {
1526                 $header .= join("\n", @xh) . "\n";
1527         }
1528         my $recipients_ref = \@recipients;
1529         return ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header);
1530 }
1531
1532 # Prepares the email, then asks the user what to do.
1533 #
1534 # If the user chooses to send the email, it's sent and 1 is returned.
1535 # If the user chooses not to send the email, 0 is returned.
1536 # If the user decides they want to make further edits, -1 is returned and the
1537 # caller is expected to call send_message again after the edits are performed.
1538 #
1539 # If an error occurs sending the email, this just dies.
1540
1541 sub send_message {
1542         my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
1543         my @recipients = @$recipients_ref;
1544
1545         my @sendmail_parameters = ('-i', @recipients);
1546         my $raw_from = $sender;
1547         if (defined $envelope_sender && $envelope_sender ne "auto") {
1548                 $raw_from = $envelope_sender;
1549         }
1550         $raw_from = extract_valid_address($raw_from);
1551         unshift (@sendmail_parameters,
1552                         '-f', $raw_from) if(defined $envelope_sender);
1553
1554         if ($needs_confirm && !$dry_run) {
1555                 print "\n$header\n";
1556                 if ($needs_confirm eq "inform") {
1557                         $confirm_unconfigured = 0; # squelch this message for the rest of this run
1558                         $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1559                         print __ <<EOF ;
1560     The Cc list above has been expanded by additional
1561     addresses found in the patch commit message. By default
1562     send-email prompts before sending whenever this occurs.
1563     This behavior is controlled by the sendemail.confirm
1564     configuration setting.
1565
1566     For additional information, run 'git send-email --help'.
1567     To retain the current behavior, but squelch this message,
1568     run 'git config --global sendemail.confirm auto'.
1569
1570 EOF
1571                 }
1572                 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1573                 # translation. The program will only accept English input
1574                 # at this point.
1575                 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1576                          valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1577                          default => $ask_default);
1578                 die __("Send this email reply required") unless defined $_;
1579                 if (/^n/i) {
1580                         return 0;
1581                 } elsif (/^e/i) {
1582                         return -1;
1583                 } elsif (/^q/i) {
1584                         cleanup_compose_files();
1585                         exit(0);
1586                 } elsif (/^a/i) {
1587                         $confirm = 'never';
1588                 }
1589         }
1590
1591         unshift (@sendmail_parameters, @smtp_server_options);
1592
1593         if ($dry_run) {
1594                 # We don't want to send the email.
1595         } elsif (defined $sendmail_cmd || file_name_is_absolute($smtp_server)) {
1596                 my $pid = open my $sm, '|-';
1597                 defined $pid or die $!;
1598                 if (!$pid) {
1599                         if (defined $sendmail_cmd) {
1600                                 exec ("sh", "-c", "$sendmail_cmd \"\$@\"", "-", @sendmail_parameters)
1601                                         or die $!;
1602                         } else {
1603                                 exec ($smtp_server, @sendmail_parameters)
1604                                         or die $!;
1605                         }
1606                 }
1607                 print $sm "$header\n$message";
1608                 close $sm or die $!;
1609         } else {
1610
1611                 if (!defined $smtp_server) {
1612                         die __("The required SMTP server is not properly defined.")
1613                 }
1614
1615                 require Net::SMTP;
1616                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1617                 $smtp_domain ||= maildomain();
1618
1619                 if ($smtp_encryption eq 'ssl') {
1620                         $smtp_server_port ||= 465; # ssmtp
1621                         require IO::Socket::SSL;
1622
1623                         # Suppress "variable accessed once" warning.
1624                         {
1625                                 no warnings 'once';
1626                                 $IO::Socket::SSL::DEBUG = 1;
1627                         }
1628
1629                         # Net::SMTP::SSL->new() does not forward any SSL options
1630                         IO::Socket::SSL::set_client_defaults(
1631                                 ssl_verify_params());
1632
1633                         if ($use_net_smtp_ssl) {
1634                                 require Net::SMTP::SSL;
1635                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1636                                                               Hello => $smtp_domain,
1637                                                               Port => $smtp_server_port,
1638                                                               Debug => $debug_net_smtp);
1639                         }
1640                         else {
1641                                 $smtp ||= Net::SMTP->new($smtp_server,
1642                                                          Hello => $smtp_domain,
1643                                                          Port => $smtp_server_port,
1644                                                          Debug => $debug_net_smtp,
1645                                                          SSL => 1);
1646                         }
1647                 }
1648                 elsif (!$smtp) {
1649                         $smtp_server_port ||= 25;
1650                         $smtp ||= Net::SMTP->new($smtp_server,
1651                                                  Hello => $smtp_domain,
1652                                                  Debug => $debug_net_smtp,
1653                                                  Port => $smtp_server_port);
1654                         if ($smtp_encryption eq 'tls' && $smtp) {
1655                                 if ($use_net_smtp_ssl) {
1656                                         $smtp->command('STARTTLS');
1657                                         $smtp->response();
1658                                         if ($smtp->code != 220) {
1659                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1660                                         }
1661                                         require Net::SMTP::SSL;
1662                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1663                                                                           ssl_verify_params())
1664                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1665                                 }
1666                                 else {
1667                                         $smtp->starttls(ssl_verify_params())
1668                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1669                                 }
1670                                 # Send EHLO again to receive fresh
1671                                 # supported commands
1672                                 $smtp->hello($smtp_domain);
1673                         }
1674                 }
1675
1676                 if (!$smtp) {
1677                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1678                             " VALUES: server=$smtp_server ",
1679                             "encryption=$smtp_encryption ",
1680                             "hello=$smtp_domain",
1681                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1682                 }
1683
1684                 smtp_auth_maybe or die $smtp->message;
1685
1686                 $smtp->mail( $raw_from ) or die $smtp->message;
1687                 $smtp->to( @recipients ) or die $smtp->message;
1688                 $smtp->data or die $smtp->message;
1689                 $smtp->datasend("$header\n") or die $smtp->message;
1690                 my @lines = split /^/, $message;
1691                 foreach my $line (@lines) {
1692                         $smtp->datasend("$line") or die $smtp->message;
1693                 }
1694                 $smtp->dataend() or die $smtp->message;
1695                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1696         }
1697         if ($quiet) {
1698                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1699         } else {
1700                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1701                 if (!defined $sendmail_cmd && !file_name_is_absolute($smtp_server)) {
1702                         print "Server: $smtp_server\n";
1703                         print "MAIL FROM:<$raw_from>\n";
1704                         foreach my $entry (@recipients) {
1705                             print "RCPT TO:<$entry>\n";
1706                         }
1707                 } else {
1708                         my $sm;
1709                         if (defined $sendmail_cmd) {
1710                                 $sm = $sendmail_cmd;
1711                         } else {
1712                                 $sm = $smtp_server;
1713                         }
1714
1715                         print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1716                 }
1717                 print $header, "\n";
1718                 if ($smtp) {
1719                         print __("Result: "), $smtp->code, ' ',
1720                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1721                 } else {
1722                         print __("Result: OK\n");
1723                 }
1724         }
1725
1726         return 1;
1727 }
1728
1729 $in_reply_to = $initial_in_reply_to;
1730 $references = $initial_in_reply_to || '';
1731 $message_num = 0;
1732
1733 sub pre_process_file {
1734         my ($t, $quiet) = @_;
1735
1736         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1737
1738         my $author = undef;
1739         my $sauthor = undef;
1740         my $author_encoding;
1741         my $has_content_type;
1742         my $body_encoding;
1743         my $xfer_encoding;
1744         my $has_mime_version;
1745         @to = ();
1746         @cc = ();
1747         @xh = ();
1748         my $input_format = undef;
1749         my @header = ();
1750         $subject = $initial_subject;
1751         $message = "";
1752         $message_num++;
1753         undef $message_id;
1754         # Retrieve and unfold header fields.
1755         my @header_lines = ();
1756         while(<$fh>) {
1757                 last if /^\s*$/;
1758                 push(@header_lines, $_);
1759         }
1760         @header = unfold_headers(@header_lines);
1761         # Add computed headers, if applicable.
1762         unless ($no_header_cmd || ! $header_cmd) {
1763                 push @header, invoke_header_cmd($header_cmd, $t);
1764         }
1765         # Now parse the header
1766         foreach(@header) {
1767                 if (/^From /) {
1768                         $input_format = 'mbox';
1769                         next;
1770                 }
1771                 chomp;
1772                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1773                         $input_format = 'mbox';
1774                 }
1775
1776                 if (defined $input_format && $input_format eq 'mbox') {
1777                         if (/^Subject:\s+(.*)$/i) {
1778                                 $subject = $1;
1779                         }
1780                         elsif (/^From:\s+(.*)$/i) {
1781                                 ($author, $author_encoding) = unquote_rfc2047($1);
1782                                 $sauthor = sanitize_address($author);
1783                                 next if $suppress_cc{'author'};
1784                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1785                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1786                                         $1, $_) unless $quiet;
1787                                 push @cc, $1;
1788                         }
1789                         elsif (/^To:\s+(.*)$/i) {
1790                                 foreach my $addr (parse_address_line($1)) {
1791                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1792                                                 $addr, $_) unless $quiet;
1793                                         push @to, $addr;
1794                                 }
1795                         }
1796                         elsif (/^Cc:\s+(.*)$/i) {
1797                                 foreach my $addr (parse_address_line($1)) {
1798                                         my $qaddr = unquote_rfc2047($addr);
1799                                         my $saddr = sanitize_address($qaddr);
1800                                         if ($saddr eq $sender) {
1801                                                 next if ($suppress_cc{'self'});
1802                                         } else {
1803                                                 next if ($suppress_cc{'cc'});
1804                                         }
1805                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1806                                                 $addr, $_) unless $quiet;
1807                                         push @cc, $addr;
1808                                 }
1809                         }
1810                         elsif (/^Content-type:/i) {
1811                                 $has_content_type = 1;
1812                                 if (/charset="?([^ "]+)/) {
1813                                         $body_encoding = $1;
1814                                 }
1815                                 push @xh, $_;
1816                         }
1817                         elsif (/^MIME-Version/i) {
1818                                 $has_mime_version = 1;
1819                                 push @xh, $_;
1820                         }
1821                         elsif (/^Message-ID: (.*)/i) {
1822                                 $message_id = $1;
1823                         }
1824                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1825                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1826                         }
1827                         elsif (/^In-Reply-To: (.*)/i) {
1828                                 if (!$initial_in_reply_to || $thread) {
1829                                         $in_reply_to = $1;
1830                                 }
1831                         }
1832                         elsif (/^References: (.*)/i) {
1833                                 if (!$initial_in_reply_to || $thread) {
1834                                         $references = $1;
1835                                 }
1836                         }
1837                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1838                                 push @xh, $_;
1839                         }
1840                 } else {
1841                         # In the traditional
1842                         # "send lots of email" format,
1843                         # line 1 = cc
1844                         # line 2 = subject
1845                         # So let's support that, too.
1846                         $input_format = 'lots';
1847                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1848                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1849                                         $_, $_) unless $quiet;
1850                                 push @cc, $_;
1851                         } elsif (!defined $subject) {
1852                                 $subject = $_;
1853                         }
1854                 }
1855         }
1856         # Now parse the message body
1857         while(<$fh>) {
1858                 $message .=  $_;
1859                 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1860                         chomp;
1861                         my ($what, $c) = ($1, $2);
1862                         # strip garbage for the address we'll use:
1863                         $c = strip_garbage_one_address($c);
1864                         # sanitize a bit more to decide whether to suppress the address:
1865                         my $sc = sanitize_address($c);
1866                         if ($sc eq $sender) {
1867                                 next if ($suppress_cc{'self'});
1868                         } else {
1869                                 if ($what =~ /^Signed-off-by$/i) {
1870                                         next if $suppress_cc{'sob'};
1871                                 } elsif ($what =~ /-by$/i) {
1872                                         next if $suppress_cc{'misc-by'};
1873                                 } elsif ($what =~ /Cc/i) {
1874                                         next if $suppress_cc{'bodycc'};
1875                                 }
1876                         }
1877                         if ($c !~ /.+@.+|<.+>/) {
1878                                 printf("(body) Ignoring %s from line '%s'\n",
1879                                         $what, $_) unless $quiet;
1880                                 next;
1881                         }
1882                         push @cc, $c;
1883                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1884                                 $c, $_) unless $quiet;
1885                 }
1886         }
1887         close $fh;
1888
1889         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t, $quiet)
1890                 if defined $to_cmd;
1891         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1892                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1893
1894         if ($broken_encoding{$t} && !$has_content_type) {
1895                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1896                 $has_content_type = 1;
1897                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1898                 $body_encoding = $auto_8bit_encoding;
1899         }
1900
1901         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1902                 $subject = quote_subject($subject, $auto_8bit_encoding);
1903         }
1904
1905         if (defined $sauthor and $sauthor ne $sender) {
1906                 $message = "From: $author\n\n$message";
1907                 if (defined $author_encoding) {
1908                         if ($has_content_type) {
1909                                 if ($body_encoding eq $author_encoding) {
1910                                         # ok, we already have the right encoding
1911                                 }
1912                                 else {
1913                                         # uh oh, we should re-encode
1914                                 }
1915                         }
1916                         else {
1917                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1918                                 $has_content_type = 1;
1919                                 push @xh,
1920                                   "Content-Type: text/plain; charset=$author_encoding";
1921                         }
1922                 }
1923         }
1924         $xfer_encoding = '8bit' if not defined $xfer_encoding;
1925         ($message, $xfer_encoding) = apply_transfer_encoding(
1926                 $message, $xfer_encoding, $target_xfer_encoding);
1927         push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1928         unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1929
1930         $needs_confirm = (
1931                 $confirm eq "always" or
1932                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1933                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1934         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1935
1936         @to = process_address_list(@to);
1937         @cc = process_address_list(@cc);
1938
1939         @to = (@initial_to, @to);
1940         @cc = (@initial_cc, @cc);
1941
1942         if ($message_num == 1) {
1943                 if (defined $cover_cc and $cover_cc) {
1944                         @initial_cc = @cc;
1945                 }
1946                 if (defined $cover_to and $cover_to) {
1947                         @initial_to = @to;
1948                 }
1949         }
1950 }
1951
1952 # Prepares the email, prompts the user, and sends it out
1953 # Returns 0 if an edit was done and the function should be called again, or 1
1954 # on the email being successfully sent out.
1955 sub process_file {
1956         my ($t) = @_;
1957
1958         pre_process_file($t, $quiet);
1959
1960         my $message_was_sent = send_message();
1961         if ($message_was_sent == -1) {
1962                 do_edit($t);
1963                 return 0;
1964         }
1965
1966         # set up for the next message
1967         if ($thread) {
1968                 if ($message_was_sent &&
1969                   ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1970                   $message_num == 1)) {
1971                         $in_reply_to = $message_id;
1972                         if (length $references > 0) {
1973                                 $references .= "\n $message_id";
1974                         } else {
1975                                 $references = "$message_id";
1976                         }
1977                 }
1978         } elsif (!defined $initial_in_reply_to) {
1979                 # --thread and --in-reply-to manage the "In-Reply-To" header and by
1980                 # extension the "References" header. If these commands are not used, reset
1981                 # the header values to their defaults.
1982                 $in_reply_to = undef;
1983                 $references = '';
1984         }
1985         $message_id = undef;
1986         $num_sent++;
1987         if (defined $batch_size && $num_sent == $batch_size) {
1988                 $num_sent = 0;
1989                 $smtp->quit if defined $smtp;
1990                 undef $smtp;
1991                 undef $auth;
1992                 sleep($relogin_delay) if defined $relogin_delay;
1993         }
1994
1995         return 1;
1996 }
1997
1998 foreach my $t (@files) {
1999         while (!process_file($t)) {
2000                 # user edited the file
2001         }
2002 }
2003
2004 # Execute a command and return its output lines as an array.  Blank
2005 # lines which do not appear at the end of the output are reported as
2006 # errors.
2007 sub execute_cmd {
2008         my ($prefix, $cmd, $file) = @_;
2009         my @lines = ();
2010         my $seen_blank_line = 0;
2011         open my $fh, "-|", "$cmd \Q$file\E"
2012                 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
2013         while (my $line = <$fh>) {
2014                 die sprintf(__("(%s) Malformed output from '%s'"), $prefix, $cmd)
2015                     if $seen_blank_line;
2016                 if ($line =~ /^$/) {
2017                         $seen_blank_line = $line =~ /^$/;
2018                         next;
2019                 }
2020                 push @lines, $line;
2021         }
2022         close $fh
2023             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2024         return @lines;
2025 }
2026
2027 # Process headers lines, unfolding multiline headers as defined by RFC
2028 # 2822.
2029 sub unfold_headers {
2030         my @headers;
2031         foreach(@_) {
2032                 last if /^\s*$/;
2033                 if (/^\s+\S/ and @headers) {
2034                         chomp($headers[$#headers]);
2035                         s/^\s+/ /;
2036                         $headers[$#headers] .= $_;
2037                 } else {
2038                         push(@headers, $_);
2039                 }
2040         }
2041         return @headers;
2042 }
2043
2044 # Invoke the provided CMD with FILE as an argument, which should
2045 # output RFC 2822 email headers. Fold multiline headers and return the
2046 # headers as an array.
2047 sub invoke_header_cmd {
2048         my ($cmd, $file) = @_;
2049         my @lines = execute_cmd("header-cmd", $header_cmd, $file);
2050         return unfold_headers(@lines);
2051 }
2052
2053 # Execute a command (e.g. $to_cmd) to get a list of email addresses
2054 # and return a results array
2055 sub recipients_cmd {
2056         my ($prefix, $what, $cmd, $file, $quiet) = @_;
2057         my @lines = ();
2058         my @addresses = ();
2059
2060         @lines = execute_cmd($prefix, $cmd, $file);
2061         for my $address (@lines) {
2062                 $address =~ s/^\s*//g;
2063                 $address =~ s/\s*$//g;
2064                 $address = sanitize_address($address);
2065                 next if ($address eq $sender and $suppress_cc{'self'});
2066                 push @addresses, $address;
2067                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
2068                        $prefix, $what, $address, $cmd) unless $quiet;
2069                 }
2070         return @addresses;
2071 }
2072
2073 cleanup_compose_files();
2074
2075 sub cleanup_compose_files {
2076         unlink($compose_filename, $compose_filename . ".final") if $compose;
2077 }
2078
2079 $smtp->quit if $smtp;
2080
2081 sub apply_transfer_encoding {
2082         my $message = shift;
2083         my $from = shift;
2084         my $to = shift;
2085
2086         return ($message, $to) if ($from eq $to and $from ne '7bit');
2087
2088         require MIME::QuotedPrint;
2089         require MIME::Base64;
2090
2091         $message = MIME::QuotedPrint::decode($message)
2092                 if ($from eq 'quoted-printable');
2093         $message = MIME::Base64::decode($message)
2094                 if ($from eq 'base64');
2095
2096         $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2097                 if $to eq 'auto';
2098
2099         die __("cannot send message as 7bit")
2100                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2101         return ($message, $to)
2102                 if ($to eq '7bit' or $to eq '8bit');
2103         return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2104                 if ($to eq 'quoted-printable');
2105         return (MIME::Base64::encode($message, "\n"), $to)
2106                 if ($to eq 'base64');
2107         die __("invalid transfer encoding");
2108 }
2109
2110 sub unique_email_list {
2111         my %seen;
2112         my @emails;
2113
2114         foreach my $entry (@_) {
2115                 my $clean = extract_valid_address_or_die($entry);
2116                 $seen{$clean} ||= 0;
2117                 next if $seen{$clean}++;
2118                 push @emails, $entry;
2119         }
2120         return @emails;
2121 }
2122
2123 sub validate_patch {
2124         my ($fn, $xfer_encoding) = @_;
2125
2126         if ($repo) {
2127                 my $hook_name = 'sendemail-validate';
2128                 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2129                 require File::Spec;
2130                 my $validate_hook = File::Spec->catfile($hooks_path, $hook_name);
2131                 my $hook_error;
2132                 if (-x $validate_hook) {
2133                         require Cwd;
2134                         my $target = Cwd::abs_path($fn);
2135                         # The hook needs a correct cwd and GIT_DIR.
2136                         my $cwd_save = Cwd::getcwd();
2137                         chdir($repo->wc_path() or $repo->repo_path())
2138                                 or die("chdir: $!");
2139                         local $ENV{"GIT_DIR"} = $repo->repo_path();
2140
2141                         my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
2142
2143                         require File::Temp;
2144                         my ($header_filehandle, $header_filename) = File::Temp::tempfile(
2145                             TEMPLATE => ".gitsendemail.header.XXXXXX",
2146                             DIR => $repo->repo_path(),
2147                             UNLINK => 1,
2148                         );
2149                         print $header_filehandle $header;
2150
2151                         my @cmd = ("git", "hook", "run", "--ignore-missing",
2152                                     $hook_name, "--");
2153                         my @cmd_msg = (@cmd, "<patch>", "<header>");
2154                         my @cmd_run = (@cmd, $target, $header_filename);
2155                         $hook_error = system_or_msg(\@cmd_run, undef, "@cmd_msg");
2156                         chdir($cwd_save) or die("chdir: $!");
2157                 }
2158                 if ($hook_error) {
2159                         $hook_error = sprintf(
2160                             __("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2161                             $fn, $hook_name, $hook_error);
2162                         die $hook_error;
2163                 }
2164         }
2165
2166         # Any long lines will be automatically fixed if we use a suitable transfer
2167         # encoding.
2168         unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2169                 open(my $fh, '<', $fn)
2170                         or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2171                 while (my $line = <$fh>) {
2172                         if (length($line) > 998) {
2173                                 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2174                                                "warning: no patches were sent\n"), $fn, $.);
2175                         }
2176                 }
2177         }
2178         return;
2179 }
2180
2181 sub handle_backup {
2182         my ($last, $lastlen, $file, $known_suffix) = @_;
2183         my ($suffix, $skip);
2184
2185         $skip = 0;
2186         if (defined $last &&
2187             ($lastlen < length($file)) &&
2188             (substr($file, 0, $lastlen) eq $last) &&
2189             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2190                 if (defined $known_suffix && $suffix eq $known_suffix) {
2191                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2192                         $skip = 1;
2193                 } else {
2194                         # TRANSLATORS: please keep "[y|N]" as is.
2195                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2196                                          valid_re => qr/^(?:y|n)/i,
2197                                          default => 'n');
2198                         $skip = ($answer ne 'y');
2199                         if ($skip) {
2200                                 $known_suffix = $suffix;
2201                         }
2202                 }
2203         }
2204         return ($skip, $known_suffix);
2205 }
2206
2207 sub handle_backup_files {
2208         my @file = @_;
2209         my ($last, $lastlen, $known_suffix, $skip, @result);
2210         for my $file (@file) {
2211                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2212                                                        $file, $known_suffix);
2213                 push @result, $file unless $skip;
2214                 $last = $file;
2215                 $lastlen = length($file);
2216         }
2217         return @result;
2218 }
2219
2220 sub file_has_nonascii {
2221         my $fn = shift;
2222         open(my $fh, '<', $fn)
2223                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2224         while (my $line = <$fh>) {
2225                 return 1 if $line =~ /[^[:ascii:]]/;
2226         }
2227         return 0;
2228 }
2229
2230 sub body_or_subject_has_nonascii {
2231         my $fn = shift;
2232         open(my $fh, '<', $fn)
2233                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2234         while (my $line = <$fh>) {
2235                 last if $line =~ /^$/;
2236                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2237         }
2238         while (my $line = <$fh>) {
2239                 return 1 if $line =~ /[^[:ascii:]]/;
2240         }
2241         return 0;
2242 }