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