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