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