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