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