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