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