git-send-email.perl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
   4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
   5 #
   6 # GPL v2 (See COPYING)
   7 #
   8 # Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
   9 #
  10 # Sends a collection of emails to the given email addresses, disturbingly fast.
  11 #
  12 # Supports two formats:
  13 # 1. mbox format files (ignoring most headers and MIME formatting - this is designed for sending patches)
  14 # 2. The original format support by Greg's script:
  15 #    first line of the message is who to CC,
  16 #    and second line is the subject of the message.
  17 #
  18
  19 use 5.008;
  20 use strict;
  21 use warnings;
  22 use POSIX qw/strftime/;
  23 use Term::ReadLine;
  24 use Getopt::Long;
  25 use Text::ParseWords;
  26 use Term::ANSIColor;
  27 use File::Temp qw/ tempdir tempfile /;
  28 use File::Spec::Functions qw(catdir catfile);
  29 use Git::LoadCPAN::Error qw(:try);
  30 use Cwd qw(abs_path cwd);
  31 use Git;
  32 use Git::I18N;
  33 use Net::Domain ();
  34 use Net::SMTP ();
  35 use Git::LoadCPAN::Mail::Address;
  36
  37 Getopt::Long::Configure qw/ pass_through /;
  38
  39 package FakeTerm;
  40 sub new {
  41         my ($class, $reason) = @_;
  42         return bless \$reason, shift;
  43 }
  44 sub readline {
  45         my $self = shift;
  46         die "Cannot use readline on FakeTerm: $$self";
  47 }
  48 package main;
  49
  50
  51 sub usage {
  52         print <<EOT;
  53 git send-email [options] <file | directory | rev-list options >
  54 git send-email --dump-aliases
  55
  56   Composing:
  57     --from                  <str>  * Email From:
  58     --[no-]to               <str>  * Email To:
  59     --[no-]cc               <str>  * Email Cc:
  60     --[no-]bcc              <str>  * Email Bcc:
  61     --subject               <str>  * Email "Subject:"
  62     --reply-to              <str>  * Email "Reply-To:"
  63     --in-reply-to           <str>  * Email "In-Reply-To:"
  64     --[no-]xmailer                 * Add "X-Mailer:" header (default).
  65     --[no-]annotate                * Review each patch that will be sent in an editor.
  66     --compose                      * Open an editor for introduction.
  67     --compose-encoding      <str>  * Encoding to assume for introduction.
  68     --8bit-encoding         <str>  * Encoding to assume 8bit mails if undeclared
  69     --transfer-encoding     <str>  * Transfer encoding to use (quoted-printable, 8bit, base64)
  70
  71   Sending:
  72     --envelope-sender       <str>  * Email envelope sender.
  73     --smtp-server       <str:int>  * Outgoing SMTP server to use. The port
  74                                      is optional. Default 'localhost'.
  75     --smtp-server-option    <str>  * Outgoing SMTP server option to use.
  76     --smtp-server-port      <int>  * Outgoing SMTP server port.
  77     --smtp-user             <str>  * Username for SMTP-AUTH.
  78     --smtp-pass             <str>  * Password for SMTP-AUTH; not necessary.
  79     --smtp-encryption       <str>  * tls or ssl; anything else disables.
  80     --smtp-ssl                     * Deprecated. Use '--smtp-encryption ssl'.
  81     --smtp-ssl-cert-path    <str>  * Path to ca-certificates (either directory or file).
  82                                      Pass an empty string to disable certificate
  83                                      verification.
  84     --smtp-domain           <str>  * The domain name sent to HELO/EHLO handshake
  85     --smtp-auth             <str>  * Space-separated list of allowed AUTH mechanisms, or
  86                                      "none" to disable authentication.
  87                                      This setting forces to use one of the listed mechanisms.
  88     --no-smtp-auth                   Disable SMTP authentication. Shorthand for
  89                                      `--smtp-auth=none`
  90     --smtp-debug            <0|1>  * Disable, enable Net::SMTP debug.
  91
  92     --batch-size            <int>  * send max <int> message per connection.
  93     --relogin-delay         <int>  * delay <int> seconds between two successive login.
  94                                      This option can only be used with --batch-size
  95
  96   Automating:
  97     --identity              <str>  * Use the sendemail.<id> options.
  98     --to-cmd                <str>  * Email To: via `<str> \$patch_path`
  99     --cc-cmd                <str>  * Email Cc: via `<str> \$patch_path`
 100     --suppress-cc           <str>  * author, self, sob, cc, cccmd, body, bodycc, misc-by, all.
 101     --[no-]cc-cover                * Email Cc: addresses in the cover letter.
 102     --[no-]to-cover                * Email To: addresses in the cover letter.
 103     --[no-]signed-off-by-cc        * Send to Signed-off-by: addresses. Default on.
 104     --[no-]suppress-from           * Send to self. Default off.
 105     --[no-]chain-reply-to          * Chain In-Reply-To: fields. Default off.
 106     --[no-]thread                  * Use In-Reply-To: field. Default on.
 107
 108   Administering:
 109     --confirm               <str>  * Confirm recipients before sending;
 110                                      auto, cc, compose, always, or never.
 111     --quiet                        * Output one line of info per email.
 112     --dry-run                      * Don't actually send the emails.
 113     --[no-]validate                * Perform patch sanity checks. Default on.
 114     --[no-]format-patch            * understand any non optional arguments as
 115                                      `git format-patch` ones.
 116     --force                        * Send even if safety checks would prevent it.
 117
 118   Information:
 119     --dump-aliases                 * Dump configured aliases and exit.
 120
 121 EOT
 122         exit(1);
 123 }
 124
 125 sub completion_helper {
 126     print Git::command('format-patch', '--git-completion-helper');
 127     exit(0);
 128 }
 129
 130 # most mail servers generate the Date: header, but not all...
 131 sub format_2822_time {
 132         my ($time) = @_;
 133         my @localtm = localtime($time);
 134         my @gmttm = gmtime($time);
 135         my $localmin = $localtm[1] + $localtm[2] * 60;
 136         my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
 137         if ($localtm[0] != $gmttm[0]) {
 138                 die __("local zone differs from GMT by a non-minute interval\n");
 139         }
 140         if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
 141                 $localmin += 1440;
 142         } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
 143                 $localmin -= 1440;
 144         } elsif ($gmttm[6] != $localtm[6]) {
 145                 die __("local time offset greater than or equal to 24 hours\n");
 146         }
 147         my $offset = $localmin - $gmtmin;
 148         my $offhour = $offset / 60;
 149         my $offmin = abs($offset % 60);
 150         if (abs($offhour) >= 24) {
 151                 die __("local time offset greater than or equal to 24 hours\n");
 152         }
 153
 154         return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
 155                        qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
 156                        $localtm[3],
 157                        qw(Jan Feb Mar Apr May Jun
 158                           Jul Aug Sep Oct Nov Dec)[$localtm[4]],
 159                        $localtm[5]+1900,
 160                        $localtm[2],
 161                        $localtm[1],
 162                        $localtm[0],
 163                        ($offset >= 0) ? '+' : '-',
 164                        abs($offhour),
 165                        $offmin,
 166                        );
 167 }
 168
 169 my $have_email_valid = eval { require Email::Valid; 1 };
 170 my $smtp;
 171 my $auth;
 172 my $num_sent = 0;
 173
 174 # Regexes for RFC 2047 productions.
 175 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
 176 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
 177 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
 178
 179 # Variables we fill in automatically, or via prompting:
 180 my (@to,@cc,@xh,$envelope_sender,
 181         $initial_in_reply_to,$reply_to,$initial_subject,@files,
 182         $author,$sender,$smtp_authpass,$annotate,$compose,$time);
 183 # Things we either get from config, *or* are overridden on the
 184 # command-line.
 185 my ($no_cc, $no_to, $no_bcc, $no_identity);
 186 my (@config_to, @getopt_to);
 187 my (@config_cc, @getopt_cc);
 188 my (@config_bcc, @getopt_bcc);
 189
 190 # Example reply to:
 191 #$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
 192
 193 my $repo = eval { Git->repository() };
 194 my @repo = $repo ? ($repo) : ();
 195 my $term = eval {
 196         $ENV{"GIT_SEND_EMAIL_NOTTY"}
 197                 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
 198                 : new Term::ReadLine 'git-send-email';
 199 };
 200 if ($@) {
 201         $term = new FakeTerm "$@: going non-interactive";
 202 }
 203
 204 # Behavior modification variables
 205 my ($quiet, $dry_run) = (0, 0);
 206 my $format_patch;
 207 my $compose_filename;
 208 my $force = 0;
 209 my $dump_aliases = 0;
 210
 211 # Handle interactive edition of files.
 212 my $multiedit;
 213 my $editor;
 214
 215 sub system_or_msg {
 216         my ($args, $msg) = @_;
 217         system(@$args);
 218         my $signalled = $? & 127;
 219         my $exit_code = $? >> 8;
 220         return unless $signalled or $exit_code;
 221
 222         return sprintf(__("fatal: command '%s' died with exit code %d"),
 223                        $args->[0], $exit_code);
 224 }
 225
 226 sub system_or_die {
 227         my $msg = system_or_msg(@_);
 228         die $msg if $msg;
 229 }
 230
 231 sub do_edit {
 232         if (!defined($editor)) {
 233                 $editor = Git::command_oneline('var', 'GIT_EDITOR');
 234         }
 235         my $die_msg = __("the editor exited uncleanly, aborting everything");
 236         if (defined($multiedit) && !$multiedit) {
 237                 system_or_die(['sh', '-c', $editor.' "$@"', $editor, $_], $die_msg) for @_;
 238         } else {
 239                 system_or_die(['sh', '-c', $editor.' "$@"', $editor, @_], $die_msg);
 240         }
 241 }
 242
 243 # Variables with corresponding config settings
 244 my ($suppress_from, $signed_off_by_cc);
 245 my ($cover_cc, $cover_to);
 246 my ($to_cmd, $cc_cmd);
 247 my ($smtp_server, $smtp_server_port, @smtp_server_options);
 248 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
 249 my ($batch_size, $relogin_delay);
 250 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
 251 my ($confirm);
 252 my (@suppress_cc);
 253 my ($auto_8bit_encoding);
 254 my ($compose_encoding);
 255 # Variables with corresponding config settings & hardcoded defaults
 256 my ($debug_net_smtp) = 0;               # Net::SMTP, see send_message()
 257 my $thread = 1;
 258 my $chain_reply_to = 0;
 259 my $use_xmailer = 1;
 260 my $validate = 1;
 261 my $target_xfer_encoding = 'auto';
 262 my $forbid_sendmail_variables = 1;
 263
 264 my %config_bool_settings = (
 265     "thread" => \$thread,
 266     "chainreplyto" => \$chain_reply_to,
 267     "suppressfrom" => \$suppress_from,
 268     "signedoffbycc" => \$signed_off_by_cc,
 269     "cccover" => \$cover_cc,
 270     "tocover" => \$cover_to,
 271     "signedoffcc" => \$signed_off_by_cc,
 272     "validate" => \$validate,
 273     "multiedit" => \$multiedit,
 274     "annotate" => \$annotate,
 275     "xmailer" => \$use_xmailer,
 276     "forbidsendmailvariables" => \$forbid_sendmail_variables,
 277 );
 278
 279 my %config_settings = (
 280     "smtpserver" => \$smtp_server,
 281     "smtpserverport" => \$smtp_server_port,
 282     "smtpserveroption" => \@smtp_server_options,
 283     "smtpuser" => \$smtp_authuser,
 284     "smtppass" => \$smtp_authpass,
 285     "smtpdomain" => \$smtp_domain,
 286     "smtpauth" => \$smtp_auth,
 287     "smtpbatchsize" => \$batch_size,
 288     "smtprelogindelay" => \$relogin_delay,
 289     "to" => \@config_to,
 290     "tocmd" => \$to_cmd,
 291     "cc" => \@config_cc,
 292     "cccmd" => \$cc_cmd,
 293     "aliasfiletype" => \$aliasfiletype,
 294     "bcc" => \@config_bcc,
 295     "suppresscc" => \@suppress_cc,
 296     "envelopesender" => \$envelope_sender,
 297     "confirm"   => \$confirm,
 298     "from" => \$sender,
 299     "assume8bitencoding" => \$auto_8bit_encoding,
 300     "composeencoding" => \$compose_encoding,
 301     "transferencoding" => \$target_xfer_encoding,
 302 );
 303
 304 my %config_path_settings = (
 305     "aliasesfile" => \@alias_files,
 306     "smtpsslcertpath" => \$smtp_ssl_cert_path,
 307 );
 308
 309 # Handle Uncouth Termination
 310 sub signal_handler {
 311
 312         # Make text normal
 313         print color("reset"), "\n";
 314
 315         # SMTP password masked
 316         system "stty echo";
 317
 318         # tmp files from --compose
 319         if (defined $compose_filename) {
 320                 if (-e $compose_filename) {
 321                         printf __("'%s' contains an intermediate version ".
 322                                   "of the email you were composing.\n"),
 323                                   $compose_filename;
 324                 }
 325                 if (-e ($compose_filename . ".final")) {
 326                         printf __("'%s.final' contains the composed email.\n"),
 327                                   $compose_filename;
 328                 }
 329         }
 330
 331         exit;
 332 };
 333
 334 $SIG{TERM} = \&signal_handler;
 335 $SIG{INT}  = \&signal_handler;
 336
 337 # Read our sendemail.* config
 338 sub read_config {
 339         my ($configured, $prefix) = @_;
 340
 341         foreach my $setting (keys %config_bool_settings) {
 342                 my $target = $config_bool_settings{$setting};
 343                 my $v = Git::config_bool(@repo, "$prefix.$setting");
 344                 next unless defined $v;
 345                 next if $configured->{$setting}++;
 346                 $$target = $v;
 347         }
 348
 349         foreach my $setting (keys %config_path_settings) {
 350                 my $target = $config_path_settings{$setting};
 351                 if (ref($target) eq "ARRAY") {
 352                         my @values = Git::config_path(@repo, "$prefix.$setting");
 353                         next unless @values;
 354                         next if $configured->{$setting}++;
 355                         @$target = @values;
 356                 }
 357                 else {
 358                         my $v = Git::config_path(@repo, "$prefix.$setting");
 359                         next unless defined $v;
 360                         next if $configured->{$setting}++;
 361                         $$target = $v;
 362                 }
 363         }
 364
 365         foreach my $setting (keys %config_settings) {
 366                 my $target = $config_settings{$setting};
 367                 if (ref($target) eq "ARRAY") {
 368                         my @values = Git::config(@repo, "$prefix.$setting");
 369                         next unless @values;
 370                         next if $configured->{$setting}++;
 371                         @$target = @values;
 372                 }
 373                 else {
 374                         my $v = Git::config(@repo, "$prefix.$setting");
 375                         next unless defined $v;
 376                         next if $configured->{$setting}++;
 377                         $$target = $v;
 378                 }
 379         }
 380
 381         if (!defined $smtp_encryption) {
 382                 my $setting = "$prefix.smtpencryption";
 383                 my $enc = Git::config(@repo, $setting);
 384                 return unless defined $enc;
 385                 return if $configured->{$setting}++;
 386                 if (defined $enc) {
 387                         $smtp_encryption = $enc;
 388                 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
 389                         $smtp_encryption = 'ssl';
 390                 }
 391         }
 392 }
 393
 394 # sendemail.identity yields to --identity. We must parse this
 395 # special-case first before the rest of the config is read.
 396 $identity = Git::config(@repo, "sendemail.identity");
 397 my $rc = GetOptions(
 398         "identity=s" => \$identity,
 399         "no-identity" => \$no_identity,
 400 );
 401 usage() unless $rc;
 402 undef $identity if $no_identity;
 403
 404 # Now we know enough to read the config
 405 {
 406     my %configured;
 407     read_config(\%configured, "sendemail.$identity") if defined $identity;
 408     read_config(\%configured, "sendemail");
 409 }
 410
 411 # Begin by accumulating all the variables (defined above), that we will end up
 412 # needing, first, from the command line:
 413
 414 my $help;
 415 my $git_completion_helper;
 416 $rc = GetOptions("h" => \$help,
 417                  "dump-aliases" => \$dump_aliases);
 418 usage() unless $rc;
 419 die __("--dump-aliases incompatible with other options\n")
 420     if !$help and $dump_aliases and @ARGV;
 421 $rc = GetOptions(
 422                     "sender|from=s" => \$sender,
 423                     "in-reply-to=s" => \$initial_in_reply_to,
 424                     "reply-to=s" => \$reply_to,
 425                     "subject=s" => \$initial_subject,
 426                     "to=s" => \@getopt_to,
 427                     "to-cmd=s" => \$to_cmd,
 428                     "no-to" => \$no_to,
 429                     "cc=s" => \@getopt_cc,
 430                     "no-cc" => \$no_cc,
 431                     "bcc=s" => \@getopt_bcc,
 432                     "no-bcc" => \$no_bcc,
 433                     "chain-reply-to!" => \$chain_reply_to,
 434                     "no-chain-reply-to" => sub {$chain_reply_to = 0},
 435                     "smtp-server=s" => \$smtp_server,
 436                     "smtp-server-option=s" => \@smtp_server_options,
 437                     "smtp-server-port=s" => \$smtp_server_port,
 438                     "smtp-user=s" => \$smtp_authuser,
 439                     "smtp-pass:s" => \$smtp_authpass,
 440                     "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
 441                     "smtp-encryption=s" => \$smtp_encryption,
 442                     "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
 443                     "smtp-debug:i" => \$debug_net_smtp,
 444                     "smtp-domain:s" => \$smtp_domain,
 445                     "smtp-auth=s" => \$smtp_auth,
 446                     "no-smtp-auth" => sub {$smtp_auth = 'none'},
 447                     "annotate!" => \$annotate,
 448                     "no-annotate" => sub {$annotate = 0},
 449                     "compose" => \$compose,
 450                     "quiet" => \$quiet,
 451                     "cc-cmd=s" => \$cc_cmd,
 452                     "suppress-from!" => \$suppress_from,
 453                     "no-suppress-from" => sub {$suppress_from = 0},
 454                     "suppress-cc=s" => \@suppress_cc,
 455                     "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
 456                     "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
 457                     "cc-cover|cc-cover!" => \$cover_cc,
 458                     "no-cc-cover" => sub {$cover_cc = 0},
 459                     "to-cover|to-cover!" => \$cover_to,
 460                     "no-to-cover" => sub {$cover_to = 0},
 461                     "confirm=s" => \$confirm,
 462                     "dry-run" => \$dry_run,
 463                     "envelope-sender=s" => \$envelope_sender,
 464                     "thread!" => \$thread,
 465                     "no-thread" => sub {$thread = 0},
 466                     "validate!" => \$validate,
 467                     "no-validate" => sub {$validate = 0},
 468                     "transfer-encoding=s" => \$target_xfer_encoding,
 469                     "format-patch!" => \$format_patch,
 470                     "no-format-patch" => sub {$format_patch = 0},
 471                     "8bit-encoding=s" => \$auto_8bit_encoding,
 472                     "compose-encoding=s" => \$compose_encoding,
 473                     "force" => \$force,
 474                     "xmailer!" => \$use_xmailer,
 475                     "no-xmailer" => sub {$use_xmailer = 0},
 476                     "batch-size=i" => \$batch_size,
 477                     "relogin-delay=i" => \$relogin_delay,
 478                     "git-completion-helper" => \$git_completion_helper,
 479          );
 480
 481 # Munge any "either config or getopt, not both" variables
 482 my @initial_to = @getopt_to ? @getopt_to : ($no_to ? () : @config_to);
 483 my @initial_cc = @getopt_cc ? @getopt_cc : ($no_cc ? () : @config_cc);
 484 my @initial_bcc = @getopt_bcc ? @getopt_bcc : ($no_bcc ? () : @config_bcc);
 485
 486 usage() if $help;
 487 completion_helper() if $git_completion_helper;
 488 unless ($rc) {
 489     usage();
 490 }
 491
 492 if ($forbid_sendmail_variables && (scalar Git::config_regexp("^sendmail[.]")) != 0) {
 493         die __("fatal: found configuration options for 'sendmail'\n" .
 494                 "git-send-email is configured with the sendemail.* options - note the 'e'.\n" .
 495                 "Set sendemail.forbidSendmailVariables to false to disable this check.\n");
 496 }
 497
 498 die __("Cannot run git format-patch from outside a repository\n")
 499         if $format_patch and not $repo;
 500
 501 die __("`batch-size` and `relogin` must be specified together " .
 502         "(via command-line or configuration option)\n")
 503         if defined $relogin_delay and not defined $batch_size;
 504
 505 # 'default' encryption is none -- this only prevents a warning
 506 $smtp_encryption = '' unless (defined $smtp_encryption);
 507
 508 # Set CC suppressions
 509 my(%suppress_cc);
 510 if (@suppress_cc) {
 511         foreach my $entry (@suppress_cc) {
 512                 # Please update $__git_send_email_suppresscc_options
 513                 # in git-completion.bash when you add new options.
 514                 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
 515                         unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc|misc-by)$/;
 516                 $suppress_cc{$entry} = 1;
 517         }
 518 }
 519
 520 if ($suppress_cc{'all'}) {
 521         foreach my $entry (qw (cccmd cc author self sob body bodycc misc-by)) {
 522                 $suppress_cc{$entry} = 1;
 523         }
 524         delete $suppress_cc{'all'};
 525 }
 526
 527 # If explicit old-style ones are specified, they trump --suppress-cc.
 528 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
 529 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
 530
 531 if ($suppress_cc{'body'}) {
 532         foreach my $entry (qw (sob bodycc misc-by)) {
 533                 $suppress_cc{$entry} = 1;
 534         }
 535         delete $suppress_cc{'body'};
 536 }
 537
 538 # Set confirm's default value
 539 my $confirm_unconfigured = !defined $confirm;
 540 if ($confirm_unconfigured) {
 541         $confirm = scalar %suppress_cc ? 'compose' : 'auto';
 542 };
 543 # Please update $__git_send_email_confirm_options in
 544 # git-completion.bash when you add new options.
 545 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
 546         unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
 547
 548 # Debugging, print out the suppressions.
 549 if (0) {
 550         print "suppressions:\n";
 551         foreach my $entry (keys %suppress_cc) {
 552                 printf "  %-5s -> $suppress_cc{$entry}\n", $entry;
 553         }
 554 }
 555
 556 my ($repoauthor, $repocommitter);
 557 ($repoauthor) = Git::ident_person(@repo, 'author');
 558 ($repocommitter) = Git::ident_person(@repo, 'committer');
 559
 560 sub parse_address_line {
 561         return map { $_->format } Mail::Address->parse($_[0]);
 562 }
 563
 564 sub split_addrs {
 565         return quotewords('\s*,\s*', 1, @_);
 566 }
 567
 568 my %aliases;
 569
 570 sub parse_sendmail_alias {
 571         local $_ = shift;
 572         if (/"/) {
 573                 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
 574         } elsif (/:include:/) {
 575                 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
 576         } elsif (/[\/|]/) {
 577                 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
 578         } elsif (/^(\S+?)\s*:\s*(.+)$/) {
 579                 my ($alias, $addr) = ($1, $2);
 580                 $aliases{$alias} = [ split_addrs($addr) ];
 581         } else {
 582                 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
 583         }
 584 }
 585
 586 sub parse_sendmail_aliases {
 587         my $fh = shift;
 588         my $s = '';
 589         while (<$fh>) {
 590                 chomp;
 591                 next if /^\s*$/ || /^\s*#/;
 592                 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
 593                 parse_sendmail_alias($s) if $s;
 594                 $s = $_;
 595         }
 596         $s =~ s/\\$//; # silently tolerate stray '\' on last line
 597         parse_sendmail_alias($s) if $s;
 598 }
 599
 600 my %parse_alias = (
 601         # multiline formats can be supported in the future
 602         mutt => sub { my $fh = shift; while (<$fh>) {
 603                 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
 604                         my ($alias, $addr) = ($1, $2);
 605                         $addr =~ s/#.*$//; # mutt allows # comments
 606                         # commas delimit multiple addresses
 607                         my @addr = split_addrs($addr);
 608
 609                         # quotes may be escaped in the file,
 610                         # unescape them so we do not double-escape them later.
 611                         s/\\"/"/g foreach @addr;
 612                         $aliases{$alias} = \@addr
 613                 }}},
 614         mailrc => sub { my $fh = shift; while (<$fh>) {
 615                 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
 616                         # spaces delimit multiple addresses
 617                         $aliases{$1} = [ quotewords('\s+', 0, $2) ];
 618                 }}},
 619         pine => sub { my $fh = shift; my $f='\t[^\t]*';
 620                 for (my $x = ''; defined($x); $x = $_) {
 621                         chomp $x;
 622                         $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
 623                         $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
 624                         $aliases{$1} = [ split_addrs($2) ];
 625                 }},
 626         elm => sub  { my $fh = shift;
 627                       while (<$fh>) {
 628                           if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
 629                               my ($alias, $addr) = ($1, $2);
 630                                $aliases{$alias} = [ split_addrs($addr) ];
 631                           }
 632                       } },
 633         sendmail => \&parse_sendmail_aliases,
 634         gnus => sub { my $fh = shift; while (<$fh>) {
 635                 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
 636                         $aliases{$1} = [ $2 ];
 637                 }}}
 638         # Please update _git_config() in git-completion.bash when you
 639         # add new MUAs.
 640 );
 641
 642 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
 643         foreach my $file (@alias_files) {
 644                 open my $fh, '<', $file or die "opening $file: $!\n";
 645                 $parse_alias{$aliasfiletype}->($fh);
 646                 close $fh;
 647         }
 648 }
 649
 650 if ($dump_aliases) {
 651     print "$_\n" for (sort keys %aliases);
 652     exit(0);
 653 }
 654
 655 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
 656 # $f is a revision list specification to be passed to format-patch.
 657 sub is_format_patch_arg {
 658         return unless $repo;
 659         my $f = shift;
 660         try {
 661                 $repo->command('rev-parse', '--verify', '--quiet', $f);
 662                 if (defined($format_patch)) {
 663                         return $format_patch;
 664                 }
 665                 die sprintf(__ <<EOF, $f, $f);
 666 File '%s' exists but it could also be the range of commits
 667 to produce patches for.  Please disambiguate by...
 668
 669     * Saying "./%s" if you mean a file; or
 670     * Giving --format-patch option if you mean a range.
 671 EOF
 672         } catch Git::Error::Command with {
 673                 # Not a valid revision.  Treat it as a filename.
 674                 return 0;
 675         }
 676 }
 677
 678 # Now that all the defaults are set, process the rest of the command line
 679 # arguments and collect up the files that need to be processed.
 680 my @rev_list_opts;
 681 while (defined(my $f = shift @ARGV)) {
 682         if ($f eq "--") {
 683                 push @rev_list_opts, "--", @ARGV;
 684                 @ARGV = ();
 685         } elsif (-d $f and !is_format_patch_arg($f)) {
 686                 opendir my $dh, $f
 687                         or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
 688
 689                 push @files, grep { -f $_ } map { catfile($f, $_) }
 690                                 sort readdir $dh;
 691                 closedir $dh;
 692         } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
 693                 push @files, $f;
 694         } else {
 695                 push @rev_list_opts, $f;
 696         }
 697 }
 698
 699 if (@rev_list_opts) {
 700         die __("Cannot run git format-patch from outside a repository\n")
 701                 unless $repo;
 702         push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
 703 }
 704
 705 @files = handle_backup_files(@files);
 706
 707 if ($validate) {
 708         foreach my $f (@files) {
 709                 unless (-p $f) {
 710                         validate_patch($f, $target_xfer_encoding);
 711                 }
 712         }
 713 }
 714
 715 if (@files) {
 716         unless ($quiet) {
 717                 print $_,"\n" for (@files);
 718         }
 719 } else {
 720         print STDERR __("\nNo patch files specified!\n\n");
 721         usage();
 722 }
 723
 724 sub get_patch_subject {
 725         my $fn = shift;
 726         open (my $fh, '<', $fn);
 727         while (my $line = <$fh>) {
 728                 next unless ($line =~ /^Subject: (.*)$/);
 729                 close $fh;
 730                 return "GIT: $1\n";
 731         }
 732         close $fh;
 733         die sprintf(__("No subject line in %s?"), $fn);
 734 }
 735
 736 if ($compose) {
 737         # Note that this does not need to be secure, but we will make a small
 738         # effort to have it be unique
 739         $compose_filename = ($repo ?
 740                 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
 741                 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
 742         open my $c, ">", $compose_filename
 743                 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 744
 745
 746         my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
 747         my $tpl_subject = $initial_subject || '';
 748         my $tpl_in_reply_to = $initial_in_reply_to || '';
 749         my $tpl_reply_to = $reply_to || '';
 750
 751         print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
 752 From $tpl_sender # This line is ignored.
 753 EOT1
 754 Lines beginning in "GIT:" will be removed.
 755 Consider including an overall diffstat or table of contents
 756 for the patch you are writing.
 757
 758 Clear the body content if you don't wish to send a summary.
 759 EOT2
 760 From: $tpl_sender
 761 Reply-To: $tpl_reply_to
 762 Subject: $tpl_subject
 763 In-Reply-To: $tpl_in_reply_to
 764
 765 EOT3
 766         for my $f (@files) {
 767                 print $c get_patch_subject($f);
 768         }
 769         close $c;
 770
 771         if ($annotate) {
 772                 do_edit($compose_filename, @files);
 773         } else {
 774                 do_edit($compose_filename);
 775         }
 776
 777         open $c, "<", $compose_filename
 778                 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 779
 780         if (!defined $compose_encoding) {
 781                 $compose_encoding = "UTF-8";
 782         }
 783
 784         my %parsed_email;
 785         while (my $line = <$c>) {
 786                 next if $line =~ m/^GIT:/;
 787                 parse_header_line($line, \%parsed_email);
 788                 if ($line =~ /^$/) {
 789                         $parsed_email{'body'} = filter_body($c);
 790                 }
 791         }
 792         close $c;
 793
 794         open my $c2, ">", $compose_filename . ".final"
 795         or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 796
 797
 798         if ($parsed_email{'From'}) {
 799                 $sender = delete($parsed_email{'From'});
 800         }
 801         if ($parsed_email{'In-Reply-To'}) {
 802                 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
 803         }
 804         if ($parsed_email{'Reply-To'}) {
 805                 $reply_to = delete($parsed_email{'Reply-To'});
 806         }
 807         if ($parsed_email{'Subject'}) {
 808                 $initial_subject = delete($parsed_email{'Subject'});
 809                 print $c2 "Subject: " .
 810                         quote_subject($initial_subject, $compose_encoding) .
 811                         "\n";
 812         }
 813
 814         if ($parsed_email{'MIME-Version'}) {
 815                 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
 816                                 "Content-Type: $parsed_email{'Content-Type'};\n",
 817                                 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
 818                 delete($parsed_email{'MIME-Version'});
 819                 delete($parsed_email{'Content-Type'});
 820                 delete($parsed_email{'Content-Transfer-Encoding'});
 821         } elsif (file_has_nonascii($compose_filename)) {
 822                 my $content_type = (delete($parsed_email{'Content-Type'}) or
 823                         "text/plain; charset=$compose_encoding");
 824                 print $c2 "MIME-Version: 1.0\n",
 825                         "Content-Type: $content_type\n",
 826                         "Content-Transfer-Encoding: 8bit\n";
 827         }
 828         # Preserve unknown headers
 829         foreach my $key (keys %parsed_email) {
 830                 next if $key eq 'body';
 831                 print $c2 "$key: $parsed_email{$key}";
 832         }
 833
 834         if ($parsed_email{'body'}) {
 835                 print $c2 "\n$parsed_email{'body'}\n";
 836                 delete($parsed_email{'body'});
 837         } else {
 838                 print __("Summary email is empty, skipping it\n");
 839                 $compose = -1;
 840         }
 841
 842         close $c2;
 843
 844 } elsif ($annotate) {
 845         do_edit(@files);
 846 }
 847
 848 sub ask {
 849         my ($prompt, %arg) = @_;
 850         my $valid_re = $arg{valid_re};
 851         my $default = $arg{default};
 852         my $confirm_only = $arg{confirm_only};
 853         my $resp;
 854         my $i = 0;
 855         return defined $default ? $default : undef
 856                 unless defined $term->IN and defined fileno($term->IN) and
 857                        defined $term->OUT and defined fileno($term->OUT);
 858         while ($i++ < 10) {
 859                 $resp = $term->readline($prompt);
 860                 if (!defined $resp) { # EOF
 861                         print "\n";
 862                         return defined $default ? $default : undef;
 863                 }
 864                 if ($resp eq '' and defined $default) {
 865                         return $default;
 866                 }
 867                 if (!defined $valid_re or $resp =~ /$valid_re/) {
 868                         return $resp;
 869                 }
 870                 if ($confirm_only) {
 871                         my $yesno = $term->readline(
 872                                 # TRANSLATORS: please keep [y/N] as is.
 873                                 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
 874                         if (defined $yesno && $yesno =~ /y/i) {
 875                                 return $resp;
 876                         }
 877                 }
 878         }
 879         return;
 880 }
 881
 882 sub parse_header_line {
 883         my $lines = shift;
 884         my $parsed_line = shift;
 885         my $addr_pat = join "|", qw(To Cc Bcc);
 886
 887         foreach (split(/\n/, $lines)) {
 888                 if (/^($addr_pat):\s*(.+)$/i) {
 889                         $parsed_line->{$1} = [ parse_address_line($2) ];
 890                 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
 891                         $parsed_line->{$1} = $2;
 892                 }
 893         }
 894 }
 895
 896 sub filter_body {
 897         my $c = shift;
 898         my $body = "";
 899         while (my $body_line = <$c>) {
 900                 if ($body_line !~ m/^GIT:/) {
 901                         $body .= $body_line;
 902                 }
 903         }
 904         return $body;
 905 }
 906
 907
 908 my %broken_encoding;
 909
 910 sub file_declares_8bit_cte {
 911         my $fn = shift;
 912         open (my $fh, '<', $fn);
 913         while (my $line = <$fh>) {
 914                 last if ($line =~ /^$/);
 915                 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
 916         }
 917         close $fh;
 918         return 0;
 919 }
 920
 921 foreach my $f (@files) {
 922         next unless (body_or_subject_has_nonascii($f)
 923                      && !file_declares_8bit_cte($f));
 924         $broken_encoding{$f} = 1;
 925 }
 926
 927 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
 928         print __("The following files are 8bit, but do not declare " .
 929                  "a Content-Transfer-Encoding.\n");
 930         foreach my $f (sort keys %broken_encoding) {
 931                 print "    $f\n";
 932         }
 933         $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
 934                                   valid_re => qr/.{4}/, confirm_only => 1,
 935                                   default => "UTF-8");
 936 }
 937
 938 if (!$force) {
 939         for my $f (@files) {
 940                 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
 941                         die sprintf(__("Refusing to send because the patch\n\t%s\n"
 942                                 . "has the template subject '*** SUBJECT HERE ***'. "
 943                                 . "Pass --force if you really want to send.\n"), $f);
 944                 }
 945         }
 946 }
 947
 948 if (defined $sender) {
 949         $sender =~ s/^\s+|\s+$//g;
 950         ($sender) = expand_aliases($sender);
 951 } else {
 952         $sender = $repoauthor || $repocommitter || '';
 953 }
 954
 955 # $sender could be an already sanitized address
 956 # (e.g. sendemail.from could be manually sanitized by user).
 957 # But it's a no-op to run sanitize_address on an already sanitized address.
 958 $sender = sanitize_address($sender);
 959
 960 my $to_whom = __("To whom should the emails be sent (if anyone)?");
 961 my $prompting = 0;
 962 if (!@initial_to && !defined $to_cmd) {
 963         my $to = ask("$to_whom ",
 964                      default => "",
 965                      valid_re => qr/\@.*\./, confirm_only => 1);
 966         push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
 967         $prompting++;
 968 }
 969
 970 sub expand_aliases {
 971         return map { expand_one_alias($_) } @_;
 972 }
 973
 974 my %EXPANDED_ALIASES;
 975 sub expand_one_alias {
 976         my $alias = shift;
 977         if ($EXPANDED_ALIASES{$alias}) {
 978                 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
 979         }
 980         local $EXPANDED_ALIASES{$alias} = 1;
 981         return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
 982 }
 983
 984 @initial_to = process_address_list(@initial_to);
 985 @initial_cc = process_address_list(@initial_cc);
 986 @initial_bcc = process_address_list(@initial_bcc);
 987
 988 if ($thread && !defined $initial_in_reply_to && $prompting) {
 989         $initial_in_reply_to = ask(
 990                 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
 991                 default => "",
 992                 valid_re => qr/\@.*\./, confirm_only => 1);
 993 }
 994 if (defined $initial_in_reply_to) {
 995         $initial_in_reply_to =~ s/^\s*<?//;
 996         $initial_in_reply_to =~ s/>?\s*$//;
 997         $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
 998 }
 999
1000 if (defined $reply_to) {
1001         $reply_to =~ s/^\s+|\s+$//g;
1002         ($reply_to) = expand_aliases($reply_to);
1003         $reply_to = sanitize_address($reply_to);
1004 }
1005
1006 if (!defined $smtp_server) {
1007         my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1008         push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
1009         foreach (@sendmail_paths) {
1010                 if (-x $_) {
1011                         $smtp_server = $_;
1012                         last;
1013                 }
1014         }
1015         $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
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 (file_name_is_absolute($smtp_server)) {
1496                 my $pid = open my $sm, '|-';
1497                 defined $pid or die $!;
1498                 if (!$pid) {
1499                         exec($smtp_server, @sendmail_parameters) or die $!;
1500                 }
1501                 print $sm "$header\n$message";
1502                 close $sm or die $!;
1503         } else {
1504
1505                 if (!defined $smtp_server) {
1506                         die __("The required SMTP server is not properly defined.")
1507                 }
1508
1509                 require Net::SMTP;
1510                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1511                 $smtp_domain ||= maildomain();
1512
1513                 if ($smtp_encryption eq 'ssl') {
1514                         $smtp_server_port ||= 465; # ssmtp
1515                         require IO::Socket::SSL;
1516
1517                         # Suppress "variable accessed once" warning.
1518                         {
1519                                 no warnings 'once';
1520                                 $IO::Socket::SSL::DEBUG = 1;
1521                         }
1522
1523                         # Net::SMTP::SSL->new() does not forward any SSL options
1524                         IO::Socket::SSL::set_client_defaults(
1525                                 ssl_verify_params());
1526
1527                         if ($use_net_smtp_ssl) {
1528                                 require Net::SMTP::SSL;
1529                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1530                                                               Hello => $smtp_domain,
1531                                                               Port => $smtp_server_port,
1532                                                               Debug => $debug_net_smtp);
1533                         }
1534                         else {
1535                                 $smtp ||= Net::SMTP->new($smtp_server,
1536                                                          Hello => $smtp_domain,
1537                                                          Port => $smtp_server_port,
1538                                                          Debug => $debug_net_smtp,
1539                                                          SSL => 1);
1540                         }
1541                 }
1542                 elsif (!$smtp) {
1543                         $smtp_server_port ||= 25;
1544                         $smtp ||= Net::SMTP->new($smtp_server,
1545                                                  Hello => $smtp_domain,
1546                                                  Debug => $debug_net_smtp,
1547                                                  Port => $smtp_server_port);
1548                         if ($smtp_encryption eq 'tls' && $smtp) {
1549                                 if ($use_net_smtp_ssl) {
1550                                         $smtp->command('STARTTLS');
1551                                         $smtp->response();
1552                                         if ($smtp->code != 220) {
1553                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1554                                         }
1555                                         require Net::SMTP::SSL;
1556                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1557                                                                           ssl_verify_params())
1558                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1559                                 }
1560                                 else {
1561                                         $smtp->starttls(ssl_verify_params())
1562                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1563                                 }
1564                                 # Send EHLO again to receive fresh
1565                                 # supported commands
1566                                 $smtp->hello($smtp_domain);
1567                         }
1568                 }
1569
1570                 if (!$smtp) {
1571                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1572                             " VALUES: server=$smtp_server ",
1573                             "encryption=$smtp_encryption ",
1574                             "hello=$smtp_domain",
1575                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1576                 }
1577
1578                 smtp_auth_maybe or die $smtp->message;
1579
1580                 $smtp->mail( $raw_from ) or die $smtp->message;
1581                 $smtp->to( @recipients ) or die $smtp->message;
1582                 $smtp->data or die $smtp->message;
1583                 $smtp->datasend("$header\n") or die $smtp->message;
1584                 my @lines = split /^/, $message;
1585                 foreach my $line (@lines) {
1586                         $smtp->datasend("$line") or die $smtp->message;
1587                 }
1588                 $smtp->dataend() or die $smtp->message;
1589                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1590         }
1591         if ($quiet) {
1592                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1593         } else {
1594                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1595                 if (!file_name_is_absolute($smtp_server)) {
1596                         print "Server: $smtp_server\n";
1597                         print "MAIL FROM:<$raw_from>\n";
1598                         foreach my $entry (@recipients) {
1599                             print "RCPT TO:<$entry>\n";
1600                         }
1601                 } else {
1602                         print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1603                 }
1604                 print $header, "\n";
1605                 if ($smtp) {
1606                         print __("Result: "), $smtp->code, ' ',
1607                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1608                 } else {
1609                         print __("Result: OK\n");
1610                 }
1611         }
1612
1613         return 1;
1614 }
1615
1616 $in_reply_to = $initial_in_reply_to;
1617 $references = $initial_in_reply_to || '';
1618 $subject = $initial_subject;
1619 $message_num = 0;
1620
1621 # Prepares the email, prompts the user, sends it out
1622 # Returns 0 if an edit was done and the function should be called again, or 1
1623 # otherwise.
1624 sub process_file {
1625         my ($t) = @_;
1626
1627         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1628
1629         my $author = undef;
1630         my $sauthor = undef;
1631         my $author_encoding;
1632         my $has_content_type;
1633         my $body_encoding;
1634         my $xfer_encoding;
1635         my $has_mime_version;
1636         @to = ();
1637         @cc = ();
1638         @xh = ();
1639         my $input_format = undef;
1640         my @header = ();
1641         $message = "";
1642         $message_num++;
1643         # First unfold multiline header fields
1644         while(<$fh>) {
1645                 last if /^\s*$/;
1646                 if (/^\s+\S/ and @header) {
1647                         chomp($header[$#header]);
1648                         s/^\s+/ /;
1649                         $header[$#header] .= $_;
1650             } else {
1651                         push(@header, $_);
1652                 }
1653         }
1654         # Now parse the header
1655         foreach(@header) {
1656                 if (/^From /) {
1657                         $input_format = 'mbox';
1658                         next;
1659                 }
1660                 chomp;
1661                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1662                         $input_format = 'mbox';
1663                 }
1664
1665                 if (defined $input_format && $input_format eq 'mbox') {
1666                         if (/^Subject:\s+(.*)$/i) {
1667                                 $subject = $1;
1668                         }
1669                         elsif (/^From:\s+(.*)$/i) {
1670                                 ($author, $author_encoding) = unquote_rfc2047($1);
1671                                 $sauthor = sanitize_address($author);
1672                                 next if $suppress_cc{'author'};
1673                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1674                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1675                                         $1, $_) unless $quiet;
1676                                 push @cc, $1;
1677                         }
1678                         elsif (/^To:\s+(.*)$/i) {
1679                                 foreach my $addr (parse_address_line($1)) {
1680                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1681                                                 $addr, $_) unless $quiet;
1682                                         push @to, $addr;
1683                                 }
1684                         }
1685                         elsif (/^Cc:\s+(.*)$/i) {
1686                                 foreach my $addr (parse_address_line($1)) {
1687                                         my $qaddr = unquote_rfc2047($addr);
1688                                         my $saddr = sanitize_address($qaddr);
1689                                         if ($saddr eq $sender) {
1690                                                 next if ($suppress_cc{'self'});
1691                                         } else {
1692                                                 next if ($suppress_cc{'cc'});
1693                                         }
1694                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1695                                                 $addr, $_) unless $quiet;
1696                                         push @cc, $addr;
1697                                 }
1698                         }
1699                         elsif (/^Content-type:/i) {
1700                                 $has_content_type = 1;
1701                                 if (/charset="?([^ "]+)/) {
1702                                         $body_encoding = $1;
1703                                 }
1704                                 push @xh, $_;
1705                         }
1706                         elsif (/^MIME-Version/i) {
1707                                 $has_mime_version = 1;
1708                                 push @xh, $_;
1709                         }
1710                         elsif (/^Message-Id: (.*)/i) {
1711                                 $message_id = $1;
1712                         }
1713                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1714                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1715                         }
1716                         elsif (/^In-Reply-To: (.*)/i) {
1717                                 if (!$initial_in_reply_to || $thread) {
1718                                         $in_reply_to = $1;
1719                                 }
1720                         }
1721                         elsif (/^References: (.*)/i) {
1722                                 if (!$initial_in_reply_to || $thread) {
1723                                         $references = $1;
1724                                 }
1725                         }
1726                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1727                                 push @xh, $_;
1728                         }
1729                 } else {
1730                         # In the traditional
1731                         # "send lots of email" format,
1732                         # line 1 = cc
1733                         # line 2 = subject
1734                         # So let's support that, too.
1735                         $input_format = 'lots';
1736                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1737                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1738                                         $_, $_) unless $quiet;
1739                                 push @cc, $_;
1740                         } elsif (!defined $subject) {
1741                                 $subject = $_;
1742                         }
1743                 }
1744         }
1745         # Now parse the message body
1746         while(<$fh>) {
1747                 $message .=  $_;
1748                 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1749                         chomp;
1750                         my ($what, $c) = ($1, $2);
1751                         # strip garbage for the address we'll use:
1752                         $c = strip_garbage_one_address($c);
1753                         # sanitize a bit more to decide whether to suppress the address:
1754                         my $sc = sanitize_address($c);
1755                         if ($sc eq $sender) {
1756                                 next if ($suppress_cc{'self'});
1757                         } else {
1758                                 if ($what =~ /^Signed-off-by$/i) {
1759                                         next if $suppress_cc{'sob'};
1760                                 } elsif ($what =~ /-by$/i) {
1761                                         next if $suppress_cc{'misc-by'};
1762                                 } elsif ($what =~ /Cc/i) {
1763                                         next if $suppress_cc{'bodycc'};
1764                                 }
1765                         }
1766                         if ($c !~ /.+@.+|<.+>/) {
1767                                 printf("(body) Ignoring %s from line '%s'\n",
1768                                         $what, $_) unless $quiet;
1769                                 next;
1770                         }
1771                         push @cc, $c;
1772                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1773                                 $c, $_) unless $quiet;
1774                 }
1775         }
1776         close $fh;
1777
1778         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1779                 if defined $to_cmd;
1780         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1781                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1782
1783         if ($broken_encoding{$t} && !$has_content_type) {
1784                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1785                 $has_content_type = 1;
1786                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1787                 $body_encoding = $auto_8bit_encoding;
1788         }
1789
1790         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1791                 $subject = quote_subject($subject, $auto_8bit_encoding);
1792         }
1793
1794         if (defined $sauthor and $sauthor ne $sender) {
1795                 $message = "From: $author\n\n$message";
1796                 if (defined $author_encoding) {
1797                         if ($has_content_type) {
1798                                 if ($body_encoding eq $author_encoding) {
1799                                         # ok, we already have the right encoding
1800                                 }
1801                                 else {
1802                                         # uh oh, we should re-encode
1803                                 }
1804                         }
1805                         else {
1806                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1807                                 $has_content_type = 1;
1808                                 push @xh,
1809                                   "Content-Type: text/plain; charset=$author_encoding";
1810                         }
1811                 }
1812         }
1813         $xfer_encoding = '8bit' if not defined $xfer_encoding;
1814         ($message, $xfer_encoding) = apply_transfer_encoding(
1815                 $message, $xfer_encoding, $target_xfer_encoding);
1816         push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1817         unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1818
1819         $needs_confirm = (
1820                 $confirm eq "always" or
1821                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1822                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1823         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1824
1825         @to = process_address_list(@to);
1826         @cc = process_address_list(@cc);
1827
1828         @to = (@initial_to, @to);
1829         @cc = (@initial_cc, @cc);
1830
1831         if ($message_num == 1) {
1832                 if (defined $cover_cc and $cover_cc) {
1833                         @initial_cc = @cc;
1834                 }
1835                 if (defined $cover_to and $cover_to) {
1836                         @initial_to = @to;
1837                 }
1838         }
1839
1840         my $message_was_sent = send_message();
1841         if ($message_was_sent == -1) {
1842                 do_edit($t);
1843                 return 0;
1844         }
1845
1846         # set up for the next message
1847         if ($thread && $message_was_sent &&
1848                 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1849                 $message_num == 1)) {
1850                 $in_reply_to = $message_id;
1851                 if (length $references > 0) {
1852                         $references .= "\n $message_id";
1853                 } else {
1854                         $references = "$message_id";
1855                 }
1856         }
1857         $message_id = undef;
1858         $num_sent++;
1859         if (defined $batch_size && $num_sent == $batch_size) {
1860                 $num_sent = 0;
1861                 $smtp->quit if defined $smtp;
1862                 undef $smtp;
1863                 undef $auth;
1864                 sleep($relogin_delay) if defined $relogin_delay;
1865         }
1866
1867         return 1;
1868 }
1869
1870 foreach my $t (@files) {
1871         while (!process_file($t)) {
1872                 # user edited the file
1873         }
1874 }
1875
1876 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1877 # and return a results array
1878 sub recipients_cmd {
1879         my ($prefix, $what, $cmd, $file) = @_;
1880
1881         my @addresses = ();
1882         open my $fh, "-|", "$cmd \Q$file\E"
1883             or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1884         while (my $address = <$fh>) {
1885                 $address =~ s/^\s*//g;
1886                 $address =~ s/\s*$//g;
1887                 $address = sanitize_address($address);
1888                 next if ($address eq $sender and $suppress_cc{'self'});
1889                 push @addresses, $address;
1890                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1891                        $prefix, $what, $address, $cmd) unless $quiet;
1892                 }
1893         close $fh
1894             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1895         return @addresses;
1896 }
1897
1898 cleanup_compose_files();
1899
1900 sub cleanup_compose_files {
1901         unlink($compose_filename, $compose_filename . ".final") if $compose;
1902 }
1903
1904 $smtp->quit if $smtp;
1905
1906 sub apply_transfer_encoding {
1907         my $message = shift;
1908         my $from = shift;
1909         my $to = shift;
1910
1911         return ($message, $to) if ($from eq $to and $from ne '7bit');
1912
1913         require MIME::QuotedPrint;
1914         require MIME::Base64;
1915
1916         $message = MIME::QuotedPrint::decode($message)
1917                 if ($from eq 'quoted-printable');
1918         $message = MIME::Base64::decode($message)
1919                 if ($from eq 'base64');
1920
1921         $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
1922                 if $to eq 'auto';
1923
1924         die __("cannot send message as 7bit")
1925                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1926         return ($message, $to)
1927                 if ($to eq '7bit' or $to eq '8bit');
1928         return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
1929                 if ($to eq 'quoted-printable');
1930         return (MIME::Base64::encode($message, "\n"), $to)
1931                 if ($to eq 'base64');
1932         die __("invalid transfer encoding");
1933 }
1934
1935 sub unique_email_list {
1936         my %seen;
1937         my @emails;
1938
1939         foreach my $entry (@_) {
1940                 my $clean = extract_valid_address_or_die($entry);
1941                 $seen{$clean} ||= 0;
1942                 next if $seen{$clean}++;
1943                 push @emails, $entry;
1944         }
1945         return @emails;
1946 }
1947
1948 sub validate_patch {
1949         my ($fn, $xfer_encoding) = @_;
1950
1951         if ($repo) {
1952                 my $validate_hook = catfile($repo->hooks_path(),
1953                                             'sendemail-validate');
1954                 my $hook_error;
1955                 if (-x $validate_hook) {
1956                         my $target = abs_path($fn);
1957                         # The hook needs a correct cwd and GIT_DIR.
1958                         my $cwd_save = cwd();
1959                         chdir($repo->wc_path() or $repo->repo_path())
1960                                 or die("chdir: $!");
1961                         local $ENV{"GIT_DIR"} = $repo->repo_path();
1962                         $hook_error = system_or_msg([$validate_hook, $target]);
1963                         chdir($cwd_save) or die("chdir: $!");
1964                 }
1965                 if ($hook_error) {
1966                         die sprintf(__("fatal: %s: rejected by sendemail-validate hook\n" .
1967                                        "%s\n" .
1968                                        "warning: no patches were sent\n"), $fn, $hook_error);
1969                 }
1970         }
1971
1972         # Any long lines will be automatically fixed if we use a suitable transfer
1973         # encoding.
1974         unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
1975                 open(my $fh, '<', $fn)
1976                         or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1977                 while (my $line = <$fh>) {
1978                         if (length($line) > 998) {
1979                                 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
1980                                                "warning: no patches were sent\n"), $fn, $.);
1981                         }
1982                 }
1983         }
1984         return;
1985 }
1986
1987 sub handle_backup {
1988         my ($last, $lastlen, $file, $known_suffix) = @_;
1989         my ($suffix, $skip);
1990
1991         $skip = 0;
1992         if (defined $last &&
1993             ($lastlen < length($file)) &&
1994             (substr($file, 0, $lastlen) eq $last) &&
1995             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1996                 if (defined $known_suffix && $suffix eq $known_suffix) {
1997                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1998                         $skip = 1;
1999                 } else {
2000                         # TRANSLATORS: please keep "[y|N]" as is.
2001                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2002                                          valid_re => qr/^(?:y|n)/i,
2003                                          default => 'n');
2004                         $skip = ($answer ne 'y');
2005                         if ($skip) {
2006                                 $known_suffix = $suffix;
2007                         }
2008                 }
2009         }
2010         return ($skip, $known_suffix);
2011 }
2012
2013 sub handle_backup_files {
2014         my @file = @_;
2015         my ($last, $lastlen, $known_suffix, $skip, @result);
2016         for my $file (@file) {
2017                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2018                                                        $file, $known_suffix);
2019                 push @result, $file unless $skip;
2020                 $last = $file;
2021                 $lastlen = length($file);
2022         }
2023         return @result;
2024 }
2025
2026 sub file_has_nonascii {
2027         my $fn = shift;
2028         open(my $fh, '<', $fn)
2029                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2030         while (my $line = <$fh>) {
2031                 return 1 if $line =~ /[^[:ascii:]]/;
2032         }
2033         return 0;
2034 }
2035
2036 sub body_or_subject_has_nonascii {
2037         my $fn = shift;
2038         open(my $fh, '<', $fn)
2039                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2040         while (my $line = <$fh>) {
2041                 last if $line =~ /^$/;
2042                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2043         }
2044         while (my $line = <$fh>) {
2045                 return 1 if $line =~ /[^[:ascii:]]/;
2046         }
2047         return 0;
2048 }