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