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