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