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 # Begin by accumulating all the variables (defined above), that we will end up
 311 # needing, first, from the command line:
 312
 313 my $help;
 314 my $rc = GetOptions("h" => \$help,
 315                     "dump-aliases" => \$dump_aliases);
 316 usage() unless $rc;
 317 die __("--dump-aliases incompatible with other options\n")
 318     if !$help and $dump_aliases and @ARGV;
 319 $rc = GetOptions(
 320                     "sender|from=s" => \$sender,
 321                     "in-reply-to=s" => \$initial_in_reply_to,
 322                     "reply-to=s" => \$reply_to,
 323                     "subject=s" => \$initial_subject,
 324                     "to=s" => \@initial_to,
 325                     "to-cmd=s" => \$to_cmd,
 326                     "no-to" => \$no_to,
 327                     "cc=s" => \@initial_cc,
 328                     "no-cc" => \$no_cc,
 329                     "bcc=s" => \@bcclist,
 330                     "no-bcc" => \$no_bcc,
 331                     "chain-reply-to!" => \$chain_reply_to,
 332                     "no-chain-reply-to" => sub {$chain_reply_to = 0},
 333                     "smtp-server=s" => \$smtp_server,
 334                     "smtp-server-option=s" => \@smtp_server_options,
 335                     "smtp-server-port=s" => \$smtp_server_port,
 336                     "smtp-user=s" => \$smtp_authuser,
 337                     "smtp-pass:s" => \$smtp_authpass,
 338                     "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
 339                     "smtp-encryption=s" => \$smtp_encryption,
 340                     "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
 341                     "smtp-debug:i" => \$debug_net_smtp,
 342                     "smtp-domain:s" => \$smtp_domain,
 343                     "smtp-auth=s" => \$smtp_auth,
 344                     "identity=s" => \$identity,
 345                     "annotate!" => \$annotate,
 346                     "no-annotate" => sub {$annotate = 0},
 347                     "compose" => \$compose,
 348                     "quiet" => \$quiet,
 349                     "cc-cmd=s" => \$cc_cmd,
 350                     "suppress-from!" => \$suppress_from,
 351                     "no-suppress-from" => sub {$suppress_from = 0},
 352                     "suppress-cc=s" => \@suppress_cc,
 353                     "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
 354                     "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
 355                     "cc-cover|cc-cover!" => \$cover_cc,
 356                     "no-cc-cover" => sub {$cover_cc = 0},
 357                     "to-cover|to-cover!" => \$cover_to,
 358                     "no-to-cover" => sub {$cover_to = 0},
 359                     "confirm=s" => \$confirm,
 360                     "dry-run" => \$dry_run,
 361                     "envelope-sender=s" => \$envelope_sender,
 362                     "thread!" => \$thread,
 363                     "no-thread" => sub {$thread = 0},
 364                     "validate!" => \$validate,
 365                     "no-validate" => sub {$validate = 0},
 366                     "transfer-encoding=s" => \$target_xfer_encoding,
 367                     "format-patch!" => \$format_patch,
 368                     "no-format-patch" => sub {$format_patch = 0},
 369                     "8bit-encoding=s" => \$auto_8bit_encoding,
 370                     "compose-encoding=s" => \$compose_encoding,
 371                     "force" => \$force,
 372                     "xmailer!" => \$use_xmailer,
 373                     "no-xmailer" => sub {$use_xmailer = 0},
 374                     "batch-size=i" => \$batch_size,
 375                     "relogin-delay=i" => \$relogin_delay,
 376          );
 377
 378 usage() if $help;
 379 unless ($rc) {
 380     usage();
 381 }
 382
 383 die __("Cannot run git format-patch from outside a repository\n")
 384         if $format_patch and not $repo;
 385
 386 die __("`batch-size` and `relogin` must be specified together " .
 387         "(via command-line or configuration option)\n")
 388         if defined $relogin_delay and not defined $batch_size;
 389
 390 # Now, let's fill any that aren't set in with defaults:
 391
 392 sub read_config {
 393         my ($prefix) = @_;
 394
 395         foreach my $setting (keys %config_bool_settings) {
 396                 my $target = $config_bool_settings{$setting}->[0];
 397                 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
 398         }
 399
 400         foreach my $setting (keys %config_path_settings) {
 401                 my $target = $config_path_settings{$setting};
 402                 if (ref($target) eq "ARRAY") {
 403                         unless (@$target) {
 404                                 my @values = Git::config_path(@repo, "$prefix.$setting");
 405                                 @$target = @values if (@values && defined $values[0]);
 406                         }
 407                 }
 408                 else {
 409                         $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
 410                 }
 411         }
 412
 413         foreach my $setting (keys %config_settings) {
 414                 my $target = $config_settings{$setting};
 415                 next if $setting eq "to" and defined $no_to;
 416                 next if $setting eq "cc" and defined $no_cc;
 417                 next if $setting eq "bcc" and defined $no_bcc;
 418                 if (ref($target) eq "ARRAY") {
 419                         unless (@$target) {
 420                                 my @values = Git::config(@repo, "$prefix.$setting");
 421                                 @$target = @values if (@values && defined $values[0]);
 422                         }
 423                 }
 424                 else {
 425                         $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
 426                 }
 427         }
 428
 429         if (!defined $smtp_encryption) {
 430                 my $enc = Git::config(@repo, "$prefix.smtpencryption");
 431                 if (defined $enc) {
 432                         $smtp_encryption = $enc;
 433                 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
 434                         $smtp_encryption = 'ssl';
 435                 }
 436         }
 437 }
 438
 439 # read configuration from [sendemail "$identity"], fall back on [sendemail]
 440 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
 441 read_config("sendemail.$identity") if (defined $identity);
 442 read_config("sendemail");
 443
 444 # fall back on builtin bool defaults
 445 foreach my $setting (values %config_bool_settings) {
 446         ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
 447 }
 448
 449 # 'default' encryption is none -- this only prevents a warning
 450 $smtp_encryption = '' unless (defined $smtp_encryption);
 451
 452 # Set CC suppressions
 453 my(%suppress_cc);
 454 if (@suppress_cc) {
 455         foreach my $entry (@suppress_cc) {
 456                 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
 457                         unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
 458                 $suppress_cc{$entry} = 1;
 459         }
 460 }
 461
 462 if ($suppress_cc{'all'}) {
 463         foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
 464                 $suppress_cc{$entry} = 1;
 465         }
 466         delete $suppress_cc{'all'};
 467 }
 468
 469 # If explicit old-style ones are specified, they trump --suppress-cc.
 470 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
 471 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
 472
 473 if ($suppress_cc{'body'}) {
 474         foreach my $entry (qw (sob bodycc)) {
 475                 $suppress_cc{$entry} = 1;
 476         }
 477         delete $suppress_cc{'body'};
 478 }
 479
 480 # Set confirm's default value
 481 my $confirm_unconfigured = !defined $confirm;
 482 if ($confirm_unconfigured) {
 483         $confirm = scalar %suppress_cc ? 'compose' : 'auto';
 484 };
 485 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
 486         unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
 487
 488 # Debugging, print out the suppressions.
 489 if (0) {
 490         print "suppressions:\n";
 491         foreach my $entry (keys %suppress_cc) {
 492                 printf "  %-5s -> $suppress_cc{$entry}\n", $entry;
 493         }
 494 }
 495
 496 my ($repoauthor, $repocommitter);
 497 ($repoauthor) = Git::ident_person(@repo, 'author');
 498 ($repocommitter) = Git::ident_person(@repo, 'committer');
 499
 500 sub parse_address_line {
 501         return map { $_->format } Mail::Address->parse($_[0]);
 502 }
 503
 504 sub split_addrs {
 505         return quotewords('\s*,\s*', 1, @_);
 506 }
 507
 508 my %aliases;
 509
 510 sub parse_sendmail_alias {
 511         local $_ = shift;
 512         if (/"/) {
 513                 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
 514         } elsif (/:include:/) {
 515                 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
 516         } elsif (/[\/|]/) {
 517                 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
 518         } elsif (/^(\S+?)\s*:\s*(.+)$/) {
 519                 my ($alias, $addr) = ($1, $2);
 520                 $aliases{$alias} = [ split_addrs($addr) ];
 521         } else {
 522                 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
 523         }
 524 }
 525
 526 sub parse_sendmail_aliases {
 527         my $fh = shift;
 528         my $s = '';
 529         while (<$fh>) {
 530                 chomp;
 531                 next if /^\s*$/ || /^\s*#/;
 532                 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
 533                 parse_sendmail_alias($s) if $s;
 534                 $s = $_;
 535         }
 536         $s =~ s/\\$//; # silently tolerate stray '\' on last line
 537         parse_sendmail_alias($s) if $s;
 538 }
 539
 540 my %parse_alias = (
 541         # multiline formats can be supported in the future
 542         mutt => sub { my $fh = shift; while (<$fh>) {
 543                 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
 544                         my ($alias, $addr) = ($1, $2);
 545                         $addr =~ s/#.*$//; # mutt allows # comments
 546                         # commas delimit multiple addresses
 547                         my @addr = split_addrs($addr);
 548
 549                         # quotes may be escaped in the file,
 550                         # unescape them so we do not double-escape them later.
 551                         s/\\"/"/g foreach @addr;
 552                         $aliases{$alias} = \@addr
 553                 }}},
 554         mailrc => sub { my $fh = shift; while (<$fh>) {
 555                 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
 556                         # spaces delimit multiple addresses
 557                         $aliases{$1} = [ quotewords('\s+', 0, $2) ];
 558                 }}},
 559         pine => sub { my $fh = shift; my $f='\t[^\t]*';
 560                 for (my $x = ''; defined($x); $x = $_) {
 561                         chomp $x;
 562                         $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
 563                         $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
 564                         $aliases{$1} = [ split_addrs($2) ];
 565                 }},
 566         elm => sub  { my $fh = shift;
 567                       while (<$fh>) {
 568                           if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
 569                               my ($alias, $addr) = ($1, $2);
 570                                $aliases{$alias} = [ split_addrs($addr) ];
 571                           }
 572                       } },
 573         sendmail => \&parse_sendmail_aliases,
 574         gnus => sub { my $fh = shift; while (<$fh>) {
 575                 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
 576                         $aliases{$1} = [ $2 ];
 577                 }}}
 578 );
 579
 580 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
 581         foreach my $file (@alias_files) {
 582                 open my $fh, '<', $file or die "opening $file: $!\n";
 583                 $parse_alias{$aliasfiletype}->($fh);
 584                 close $fh;
 585         }
 586 }
 587
 588 if ($dump_aliases) {
 589     print "$_\n" for (sort keys %aliases);
 590     exit(0);
 591 }
 592
 593 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
 594 # $f is a revision list specification to be passed to format-patch.
 595 sub is_format_patch_arg {
 596         return unless $repo;
 597         my $f = shift;
 598         try {
 599                 $repo->command('rev-parse', '--verify', '--quiet', $f);
 600                 if (defined($format_patch)) {
 601                         return $format_patch;
 602                 }
 603                 die sprintf(__ <<EOF, $f, $f);
 604 File '%s' exists but it could also be the range of commits
 605 to produce patches for.  Please disambiguate by...
 606
 607     * Saying "./%s" if you mean a file; or
 608     * Giving --format-patch option if you mean a range.
 609 EOF
 610         } catch Git::Error::Command with {
 611                 # Not a valid revision.  Treat it as a filename.
 612                 return 0;
 613         }
 614 }
 615
 616 # Now that all the defaults are set, process the rest of the command line
 617 # arguments and collect up the files that need to be processed.
 618 my @rev_list_opts;
 619 while (defined(my $f = shift @ARGV)) {
 620         if ($f eq "--") {
 621                 push @rev_list_opts, "--", @ARGV;
 622                 @ARGV = ();
 623         } elsif (-d $f and !is_format_patch_arg($f)) {
 624                 opendir my $dh, $f
 625                         or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
 626
 627                 push @files, grep { -f $_ } map { catfile($f, $_) }
 628                                 sort readdir $dh;
 629                 closedir $dh;
 630         } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
 631                 push @files, $f;
 632         } else {
 633                 push @rev_list_opts, $f;
 634         }
 635 }
 636
 637 if (@rev_list_opts) {
 638         die __("Cannot run git format-patch from outside a repository\n")
 639                 unless $repo;
 640         push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
 641 }
 642
 643 @files = handle_backup_files(@files);
 644
 645 if ($validate) {
 646         foreach my $f (@files) {
 647                 unless (-p $f) {
 648                         my $error = validate_patch($f, $target_xfer_encoding);
 649                         $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
 650                                                   $f, $error);
 651                 }
 652         }
 653 }
 654
 655 if (@files) {
 656         unless ($quiet) {
 657                 print $_,"\n" for (@files);
 658         }
 659 } else {
 660         print STDERR __("\nNo patch files specified!\n\n");
 661         usage();
 662 }
 663
 664 sub get_patch_subject {
 665         my $fn = shift;
 666         open (my $fh, '<', $fn);
 667         while (my $line = <$fh>) {
 668                 next unless ($line =~ /^Subject: (.*)$/);
 669                 close $fh;
 670                 return "GIT: $1\n";
 671         }
 672         close $fh;
 673         die sprintf(__("No subject line in %s?"), $fn);
 674 }
 675
 676 if ($compose) {
 677         # Note that this does not need to be secure, but we will make a small
 678         # effort to have it be unique
 679         $compose_filename = ($repo ?
 680                 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
 681                 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
 682         open my $c, ">", $compose_filename
 683                 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 684
 685
 686         my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
 687         my $tpl_subject = $initial_subject || '';
 688         my $tpl_in_reply_to = $initial_in_reply_to || '';
 689         my $tpl_reply_to = $reply_to || '';
 690
 691         print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
 692 From $tpl_sender # This line is ignored.
 693 EOT1
 694 Lines beginning in "GIT:" will be removed.
 695 Consider including an overall diffstat or table of contents
 696 for the patch you are writing.
 697
 698 Clear the body content if you don't wish to send a summary.
 699 EOT2
 700 From: $tpl_sender
 701 Reply-To: $tpl_reply_to
 702 Subject: $tpl_subject
 703 In-Reply-To: $tpl_in_reply_to
 704
 705 EOT3
 706         for my $f (@files) {
 707                 print $c get_patch_subject($f);
 708         }
 709         close $c;
 710
 711         if ($annotate) {
 712                 do_edit($compose_filename, @files);
 713         } else {
 714                 do_edit($compose_filename);
 715         }
 716
 717         open $c, "<", $compose_filename
 718                 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 719
 720         if (!defined $compose_encoding) {
 721                 $compose_encoding = "UTF-8";
 722         }
 723
 724         my %parsed_email;
 725         while (my $line = <$c>) {
 726                 next if $line =~ m/^GIT:/;
 727                 parse_header_line($line, \%parsed_email);
 728                 if ($line =~ /^$/) {
 729                         $parsed_email{'body'} = filter_body($c);
 730                 }
 731         }
 732         close $c;
 733
 734         open my $c2, ">", $compose_filename . ".final"
 735         or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 736
 737
 738         if ($parsed_email{'From'}) {
 739                 $sender = delete($parsed_email{'From'});
 740         }
 741         if ($parsed_email{'In-Reply-To'}) {
 742                 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
 743         }
 744         if ($parsed_email{'Reply-To'}) {
 745                 $reply_to = delete($parsed_email{'Reply-To'});
 746         }
 747         if ($parsed_email{'Subject'}) {
 748                 $initial_subject = delete($parsed_email{'Subject'});
 749                 print $c2 "Subject: " .
 750                         quote_subject($initial_subject, $compose_encoding) .
 751                         "\n";
 752         }
 753
 754         if ($parsed_email{'MIME-Version'}) {
 755                 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
 756                                 "Content-Type: $parsed_email{'Content-Type'};\n",
 757                                 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
 758                 delete($parsed_email{'MIME-Version'});
 759                 delete($parsed_email{'Content-Type'});
 760                 delete($parsed_email{'Content-Transfer-Encoding'});
 761         } elsif (file_has_nonascii($compose_filename)) {
 762                 my $content_type = (delete($parsed_email{'Content-Type'}) or
 763                         "text/plain; charset=$compose_encoding");
 764                 print $c2 "MIME-Version: 1.0\n",
 765                         "Content-Type: $content_type\n",
 766                         "Content-Transfer-Encoding: 8bit\n";
 767         }
 768         # Preserve unknown headers
 769         foreach my $key (keys %parsed_email) {
 770                 next if $key eq 'body';
 771                 print $c2 "$key: $parsed_email{$key}";
 772         }
 773
 774         if ($parsed_email{'body'}) {
 775                 print $c2 "\n$parsed_email{'body'}\n";
 776                 delete($parsed_email{'body'});
 777         } else {
 778                 print __("Summary email is empty, skipping it\n");
 779                 $compose = -1;
 780         }
 781
 782         close $c2;
 783
 784 } elsif ($annotate) {
 785         do_edit(@files);
 786 }
 787
 788 sub ask {
 789         my ($prompt, %arg) = @_;
 790         my $valid_re = $arg{valid_re};
 791         my $default = $arg{default};
 792         my $confirm_only = $arg{confirm_only};
 793         my $resp;
 794         my $i = 0;
 795         return defined $default ? $default : undef
 796                 unless defined $term->IN and defined fileno($term->IN) and
 797                        defined $term->OUT and defined fileno($term->OUT);
 798         while ($i++ < 10) {
 799                 $resp = $term->readline($prompt);
 800                 if (!defined $resp) { # EOF
 801                         print "\n";
 802                         return defined $default ? $default : undef;
 803                 }
 804                 if ($resp eq '' and defined $default) {
 805                         return $default;
 806                 }
 807                 if (!defined $valid_re or $resp =~ /$valid_re/) {
 808                         return $resp;
 809                 }
 810                 if ($confirm_only) {
 811                         my $yesno = $term->readline(
 812                                 # TRANSLATORS: please keep [y/N] as is.
 813                                 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
 814                         if (defined $yesno && $yesno =~ /y/i) {
 815                                 return $resp;
 816                         }
 817                 }
 818         }
 819         return;
 820 }
 821
 822 sub parse_header_line {
 823         my $lines = shift;
 824         my $parsed_line = shift;
 825         my $addr_pat = join "|", qw(To Cc Bcc);
 826
 827         foreach (split(/\n/, $lines)) {
 828                 if (/^($addr_pat):\s*(.+)$/i) {
 829                         $parsed_line->{$1} = [ parse_address_line($2) ];
 830                 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
 831                         $parsed_line->{$1} = $2;
 832                 }
 833         }
 834 }
 835
 836 sub filter_body {
 837         my $c = shift;
 838         my $body = "";
 839         while (my $body_line = <$c>) {
 840                 if ($body_line !~ m/^GIT:/) {
 841                         $body .= $body_line;
 842                 }
 843         }
 844         return $body;
 845 }
 846
 847
 848 my %broken_encoding;
 849
 850 sub file_declares_8bit_cte {
 851         my $fn = shift;
 852         open (my $fh, '<', $fn);
 853         while (my $line = <$fh>) {
 854                 last if ($line =~ /^$/);
 855                 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
 856         }
 857         close $fh;
 858         return 0;
 859 }
 860
 861 foreach my $f (@files) {
 862         next unless (body_or_subject_has_nonascii($f)
 863                      && !file_declares_8bit_cte($f));
 864         $broken_encoding{$f} = 1;
 865 }
 866
 867 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
 868         print __("The following files are 8bit, but do not declare " .
 869                  "a Content-Transfer-Encoding.\n");
 870         foreach my $f (sort keys %broken_encoding) {
 871                 print "    $f\n";
 872         }
 873         $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
 874                                   valid_re => qr/.{4}/, confirm_only => 1,
 875                                   default => "UTF-8");
 876 }
 877
 878 if (!$force) {
 879         for my $f (@files) {
 880                 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
 881                         die sprintf(__("Refusing to send because the patch\n\t%s\n"
 882                                 . "has the template subject '*** SUBJECT HERE ***'. "
 883                                 . "Pass --force if you really want to send.\n"), $f);
 884                 }
 885         }
 886 }
 887
 888 if (defined $sender) {
 889         $sender =~ s/^\s+|\s+$//g;
 890         ($sender) = expand_aliases($sender);
 891 } else {
 892         $sender = $repoauthor || $repocommitter || '';
 893 }
 894
 895 # $sender could be an already sanitized address
 896 # (e.g. sendemail.from could be manually sanitized by user).
 897 # But it's a no-op to run sanitize_address on an already sanitized address.
 898 $sender = sanitize_address($sender);
 899
 900 my $to_whom = __("To whom should the emails be sent (if anyone)?");
 901 my $prompting = 0;
 902 if (!@initial_to && !defined $to_cmd) {
 903         my $to = ask("$to_whom ",
 904                      default => "",
 905                      valid_re => qr/\@.*\./, confirm_only => 1);
 906         push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
 907         $prompting++;
 908 }
 909
 910 sub expand_aliases {
 911         return map { expand_one_alias($_) } @_;
 912 }
 913
 914 my %EXPANDED_ALIASES;
 915 sub expand_one_alias {
 916         my $alias = shift;
 917         if ($EXPANDED_ALIASES{$alias}) {
 918                 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
 919         }
 920         local $EXPANDED_ALIASES{$alias} = 1;
 921         return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
 922 }
 923
 924 @initial_to = process_address_list(@initial_to);
 925 @initial_cc = process_address_list(@initial_cc);
 926 @bcclist = process_address_list(@bcclist);
 927
 928 if ($thread && !defined $initial_in_reply_to && $prompting) {
 929         $initial_in_reply_to = ask(
 930                 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
 931                 default => "",
 932                 valid_re => qr/\@.*\./, confirm_only => 1);
 933 }
 934 if (defined $initial_in_reply_to) {
 935         $initial_in_reply_to =~ s/^\s*<?//;
 936         $initial_in_reply_to =~ s/>?\s*$//;
 937         $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
 938 }
 939
 940 if (defined $reply_to) {
 941         $reply_to =~ s/^\s+|\s+$//g;
 942         ($reply_to) = expand_aliases($reply_to);
 943         $reply_to = sanitize_address($reply_to);
 944 }
 945
 946 if (!defined $smtp_server) {
 947         my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
 948         push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
 949         foreach (@sendmail_paths) {
 950                 if (-x $_) {
 951                         $smtp_server = $_;
 952                         last;
 953                 }
 954         }
 955         $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
 956 }
 957
 958 if ($compose && $compose > 0) {
 959         @files = ($compose_filename . ".final", @files);
 960 }
 961
 962 # Variables we set as part of the loop over files
 963 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
 964         $needs_confirm, $message_num, $ask_default);
 965
 966 sub extract_valid_address {
 967         my $address = shift;
 968         my $local_part_regexp = qr/[^<>"\s@]+/;
 969         my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
 970
 971         # check for a local address:
 972         return $address if ($address =~ /^($local_part_regexp)$/);
 973
 974         $address =~ s/^\s*<(.*)>\s*$/$1/;
 975         if ($have_email_valid) {
 976                 return scalar Email::Valid->address($address);
 977         }
 978
 979         # less robust/correct than the monster regexp in Email::Valid,
 980         # but still does a 99% job, and one less dependency
 981         return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
 982         return;
 983 }
 984
 985 sub extract_valid_address_or_die {
 986         my $address = shift;
 987         $address = extract_valid_address($address);
 988         die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
 989                 if !$address;
 990         return $address;
 991 }
 992
 993 sub validate_address {
 994         my $address = shift;
 995         while (!extract_valid_address($address)) {
 996                 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
 997                 # TRANSLATORS: Make sure to include [q] [d] [e] in your
 998                 # translation. The program will only accept English input
 999                 # at this point.
1000                 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1001                         valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1002                         default => 'q');
1003                 if (/^d/i) {
1004                         return undef;
1005                 } elsif (/^q/i) {
1006                         cleanup_compose_files();
1007                         exit(0);
1008                 }
1009                 $address = ask("$to_whom ",
1010                         default => "",
1011                         valid_re => qr/\@.*\./, confirm_only => 1);
1012         }
1013         return $address;
1014 }
1015
1016 sub validate_address_list {
1017         return (grep { defined $_ }
1018                 map { validate_address($_) } @_);
1019 }
1020
1021 # Usually don't need to change anything below here.
1022
1023 # we make a "fake" message id by taking the current number
1024 # of seconds since the beginning of Unix time and tacking on
1025 # a random number to the end, in case we are called quicker than
1026 # 1 second since the last time we were called.
1027
1028 # We'll setup a template for the message id, using the "from" address:
1029
1030 my ($message_id_stamp, $message_id_serial);
1031 sub make_message_id {
1032         my $uniq;
1033         if (!defined $message_id_stamp) {
1034                 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1035                 $message_id_serial = 0;
1036         }
1037         $message_id_serial++;
1038         $uniq = "$message_id_stamp-$message_id_serial";
1039
1040         my $du_part;
1041         for ($sender, $repocommitter, $repoauthor) {
1042                 $du_part = extract_valid_address(sanitize_address($_));
1043                 last if (defined $du_part and $du_part ne '');
1044         }
1045         if (not defined $du_part or $du_part eq '') {
1046                 require Sys::Hostname;
1047                 $du_part = 'user@' . Sys::Hostname::hostname();
1048         }
1049         my $message_id_template = "<%s-%s>";
1050         $message_id = sprintf($message_id_template, $uniq, $du_part);
1051         #print "new message id = $message_id\n"; # Was useful for debugging
1052 }
1053
1054
1055
1056 $time = time - scalar $#files;
1057
1058 sub unquote_rfc2047 {
1059         local ($_) = @_;
1060         my $charset;
1061         my $sep = qr/[ \t]+/;
1062         s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1063                 my @words = split $sep, $&;
1064                 foreach (@words) {
1065                         m/$re_encoded_word/;
1066                         $charset = $1;
1067                         my $encoding = $2;
1068                         my $text = $3;
1069                         if ($encoding eq 'q' || $encoding eq 'Q') {
1070                                 $_ = $text;
1071                                 s/_/ /g;
1072                                 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1073                         } else {
1074                                 # other encodings not supported yet
1075                         }
1076                 }
1077                 join '', @words;
1078         }eg;
1079         return wantarray ? ($_, $charset) : $_;
1080 }
1081
1082 sub quote_rfc2047 {
1083         local $_ = shift;
1084         my $encoding = shift || 'UTF-8';
1085         s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1086         s/(.*)/=\?$encoding\?q\?$1\?=/;
1087         return $_;
1088 }
1089
1090 sub is_rfc2047_quoted {
1091         my $s = shift;
1092         length($s) <= 75 &&
1093         $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1094 }
1095
1096 sub subject_needs_rfc2047_quoting {
1097         my $s = shift;
1098
1099         return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1100 }
1101
1102 sub quote_subject {
1103         local $subject = shift;
1104         my $encoding = shift || 'UTF-8';
1105
1106         if (subject_needs_rfc2047_quoting($subject)) {
1107                 return quote_rfc2047($subject, $encoding);
1108         }
1109         return $subject;
1110 }
1111
1112 # use the simplest quoting being able to handle the recipient
1113 sub sanitize_address {
1114         my ($recipient) = @_;
1115
1116         # remove garbage after email address
1117         $recipient =~ s/(.*>).*$/$1/;
1118
1119         my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1120
1121         if (not $recipient_name) {
1122                 return $recipient;
1123         }
1124
1125         # if recipient_name is already quoted, do nothing
1126         if (is_rfc2047_quoted($recipient_name)) {
1127                 return $recipient;
1128         }
1129
1130         # remove non-escaped quotes
1131         $recipient_name =~ s/(^|[^\\])"/$1/g;
1132
1133         # rfc2047 is needed if a non-ascii char is included
1134         if ($recipient_name =~ /[^[:ascii:]]/) {
1135                 $recipient_name = quote_rfc2047($recipient_name);
1136         }
1137
1138         # double quotes are needed if specials or CTLs are included
1139         elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1140                 $recipient_name =~ s/([\\\r])/\\$1/g;
1141                 $recipient_name = qq["$recipient_name"];
1142         }
1143
1144         return "$recipient_name $recipient_addr";
1145
1146 }
1147
1148 sub strip_garbage_one_address {
1149         my ($addr) = @_;
1150         chomp $addr;
1151         if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1152                 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1153                 # Foo Bar <foobar@example.com> [possibly garbage here]
1154                 return $1;
1155         }
1156         if ($addr =~ /^(<[^>]*>).*/) {
1157                 # <foo@example.com> [possibly garbage here]
1158                 # if garbage contains other addresses, they are ignored.
1159                 return $1;
1160         }
1161         if ($addr =~ /^([^"#,\s]*)/) {
1162                 # address without quoting: remove anything after the address
1163                 return $1;
1164         }
1165         return $addr;
1166 }
1167
1168 sub sanitize_address_list {
1169         return (map { sanitize_address($_) } @_);
1170 }
1171
1172 sub process_address_list {
1173         my @addr_list = map { parse_address_line($_) } @_;
1174         @addr_list = expand_aliases(@addr_list);
1175         @addr_list = sanitize_address_list(@addr_list);
1176         @addr_list = validate_address_list(@addr_list);
1177         return @addr_list;
1178 }
1179
1180 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1181 #
1182 # Tightly configured MTAa require that a caller sends a real DNS
1183 # domain name that corresponds the IP address in the HELO/EHLO
1184 # handshake. This is used to verify the connection and prevent
1185 # spammers from trying to hide their identity. If the DNS and IP don't
1186 # match, the receiveing MTA may deny the connection.
1187 #
1188 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1189 #
1190 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1191 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1192 #
1193 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1194 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1195
1196 sub valid_fqdn {
1197         my $domain = shift;
1198         return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1199 }
1200
1201 sub maildomain_net {
1202         my $maildomain;
1203
1204         my $domain = Net::Domain::domainname();
1205         $maildomain = $domain if valid_fqdn($domain);
1206
1207         return $maildomain;
1208 }
1209
1210 sub maildomain_mta {
1211         my $maildomain;
1212
1213         for my $host (qw(mailhost localhost)) {
1214                 my $smtp = Net::SMTP->new($host);
1215                 if (defined $smtp) {
1216                         my $domain = $smtp->domain;
1217                         $smtp->quit;
1218
1219                         $maildomain = $domain if valid_fqdn($domain);
1220
1221                         last if $maildomain;
1222                 }
1223         }
1224
1225         return $maildomain;
1226 }
1227
1228 sub maildomain {
1229         return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1230 }
1231
1232 sub smtp_host_string {
1233         if (defined $smtp_server_port) {
1234                 return "$smtp_server:$smtp_server_port";
1235         } else {
1236                 return $smtp_server;
1237         }
1238 }
1239
1240 # Returns 1 if authentication succeeded or was not necessary
1241 # (smtp_user was not specified), and 0 otherwise.
1242
1243 sub smtp_auth_maybe {
1244         if (!defined $smtp_authuser || $auth) {
1245                 return 1;
1246         }
1247
1248         # Workaround AUTH PLAIN/LOGIN interaction defect
1249         # with Authen::SASL::Cyrus
1250         eval {
1251                 require Authen::SASL;
1252                 Authen::SASL->import(qw(Perl));
1253         };
1254
1255         # Check mechanism naming as defined in:
1256         # https://tools.ietf.org/html/rfc4422#page-8
1257         if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1258                 die "invalid smtp auth: '${smtp_auth}'";
1259         }
1260
1261         # TODO: Authentication may fail not because credentials were
1262         # invalid but due to other reasons, in which we should not
1263         # reject credentials.
1264         $auth = Git::credential({
1265                 'protocol' => 'smtp',
1266                 'host' => smtp_host_string(),
1267                 'username' => $smtp_authuser,
1268                 # if there's no password, "git credential fill" will
1269                 # give us one, otherwise it'll just pass this one.
1270                 'password' => $smtp_authpass
1271         }, sub {
1272                 my $cred = shift;
1273
1274                 if ($smtp_auth) {
1275                         my $sasl = Authen::SASL->new(
1276                                 mechanism => $smtp_auth,
1277                                 callback => {
1278                                         user => $cred->{'username'},
1279                                         pass => $cred->{'password'},
1280                                         authname => $cred->{'username'},
1281                                 }
1282                         );
1283
1284                         return !!$smtp->auth($sasl);
1285                 }
1286
1287                 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1288         });
1289
1290         return $auth;
1291 }
1292
1293 sub ssl_verify_params {
1294         eval {
1295                 require IO::Socket::SSL;
1296                 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1297         };
1298         if ($@) {
1299                 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1300                 return;
1301         }
1302
1303         if (!defined $smtp_ssl_cert_path) {
1304                 # use the OpenSSL defaults
1305                 return (SSL_verify_mode => SSL_VERIFY_PEER());
1306         }
1307
1308         if ($smtp_ssl_cert_path eq "") {
1309                 return (SSL_verify_mode => SSL_VERIFY_NONE());
1310         } elsif (-d $smtp_ssl_cert_path) {
1311                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1312                         SSL_ca_path => $smtp_ssl_cert_path);
1313         } elsif (-f $smtp_ssl_cert_path) {
1314                 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1315                         SSL_ca_file => $smtp_ssl_cert_path);
1316         } else {
1317                 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1318         }
1319 }
1320
1321 sub file_name_is_absolute {
1322         my ($path) = @_;
1323
1324         # msys does not grok DOS drive-prefixes
1325         if ($^O eq 'msys') {
1326                 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1327         }
1328
1329         require File::Spec::Functions;
1330         return File::Spec::Functions::file_name_is_absolute($path);
1331 }
1332
1333 # Prepares the email, then asks the user what to do.
1334 #
1335 # If the user chooses to send the email, it's sent and 1 is returned.
1336 # If the user chooses not to send the email, 0 is returned.
1337 # If the user decides they want to make further edits, -1 is returned and the
1338 # caller is expected to call send_message again after the edits are performed.
1339 #
1340 # If an error occurs sending the email, this just dies.
1341
1342 sub send_message {
1343         my @recipients = unique_email_list(@to);
1344         @cc = (grep { my $cc = extract_valid_address_or_die($_);
1345                       not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1346                     }
1347                @cc);
1348         my $to = join (",\n\t", @recipients);
1349         @recipients = unique_email_list(@recipients,@cc,@bcclist);
1350         @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1351         my $date = format_2822_time($time++);
1352         my $gitversion = '@@GIT_VERSION@@';
1353         if ($gitversion =~ m/..GIT_VERSION../) {
1354             $gitversion = Git::version();
1355         }
1356
1357         my $cc = join(",\n\t", unique_email_list(@cc));
1358         my $ccline = "";
1359         if ($cc ne '') {
1360                 $ccline = "\nCc: $cc";
1361         }
1362         make_message_id() unless defined($message_id);
1363
1364         my $header = "From: $sender
1365 To: $to${ccline}
1366 Subject: $subject
1367 Date: $date
1368 Message-Id: $message_id
1369 ";
1370         if ($use_xmailer) {
1371                 $header .= "X-Mailer: git-send-email $gitversion\n";
1372         }
1373         if ($in_reply_to) {
1374
1375                 $header .= "In-Reply-To: $in_reply_to\n";
1376                 $header .= "References: $references\n";
1377         }
1378         if ($reply_to) {
1379                 $header .= "Reply-To: $reply_to\n";
1380         }
1381         if (@xh) {
1382                 $header .= join("\n", @xh) . "\n";
1383         }
1384
1385         my @sendmail_parameters = ('-i', @recipients);
1386         my $raw_from = $sender;
1387         if (defined $envelope_sender && $envelope_sender ne "auto") {
1388                 $raw_from = $envelope_sender;
1389         }
1390         $raw_from = extract_valid_address($raw_from);
1391         unshift (@sendmail_parameters,
1392                         '-f', $raw_from) if(defined $envelope_sender);
1393
1394         if ($needs_confirm && !$dry_run) {
1395                 print "\n$header\n";
1396                 if ($needs_confirm eq "inform") {
1397                         $confirm_unconfigured = 0; # squelch this message for the rest of this run
1398                         $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1399                         print __ <<EOF ;
1400     The Cc list above has been expanded by additional
1401     addresses found in the patch commit message. By default
1402     send-email prompts before sending whenever this occurs.
1403     This behavior is controlled by the sendemail.confirm
1404     configuration setting.
1405
1406     For additional information, run 'git send-email --help'.
1407     To retain the current behavior, but squelch this message,
1408     run 'git config --global sendemail.confirm auto'.
1409
1410 EOF
1411                 }
1412                 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1413                 # translation. The program will only accept English input
1414                 # at this point.
1415                 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1416                          valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1417                          default => $ask_default);
1418                 die __("Send this email reply required") unless defined $_;
1419                 if (/^n/i) {
1420                         return 0;
1421                 } elsif (/^e/i) {
1422                         return -1;
1423                 } elsif (/^q/i) {
1424                         cleanup_compose_files();
1425                         exit(0);
1426                 } elsif (/^a/i) {
1427                         $confirm = 'never';
1428                 }
1429         }
1430
1431         unshift (@sendmail_parameters, @smtp_server_options);
1432
1433         if ($dry_run) {
1434                 # We don't want to send the email.
1435         } elsif (file_name_is_absolute($smtp_server)) {
1436                 my $pid = open my $sm, '|-';
1437                 defined $pid or die $!;
1438                 if (!$pid) {
1439                         exec($smtp_server, @sendmail_parameters) or die $!;
1440                 }
1441                 print $sm "$header\n$message";
1442                 close $sm or die $!;
1443         } else {
1444
1445                 if (!defined $smtp_server) {
1446                         die __("The required SMTP server is not properly defined.")
1447                 }
1448
1449                 require Net::SMTP;
1450                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1451                 $smtp_domain ||= maildomain();
1452
1453                 if ($smtp_encryption eq 'ssl') {
1454                         $smtp_server_port ||= 465; # ssmtp
1455                         require IO::Socket::SSL;
1456
1457                         # Suppress "variable accessed once" warning.
1458                         {
1459                                 no warnings 'once';
1460                                 $IO::Socket::SSL::DEBUG = 1;
1461                         }
1462
1463                         # Net::SMTP::SSL->new() does not forward any SSL options
1464                         IO::Socket::SSL::set_client_defaults(
1465                                 ssl_verify_params());
1466
1467                         if ($use_net_smtp_ssl) {
1468                                 require Net::SMTP::SSL;
1469                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1470                                                               Hello => $smtp_domain,
1471                                                               Port => $smtp_server_port,
1472                                                               Debug => $debug_net_smtp);
1473                         }
1474                         else {
1475                                 $smtp ||= Net::SMTP->new($smtp_server,
1476                                                          Hello => $smtp_domain,
1477                                                          Port => $smtp_server_port,
1478                                                          Debug => $debug_net_smtp,
1479                                                          SSL => 1);
1480                         }
1481                 }
1482                 elsif (!$smtp) {
1483                         $smtp_server_port ||= 25;
1484                         $smtp ||= Net::SMTP->new($smtp_server,
1485                                                  Hello => $smtp_domain,
1486                                                  Debug => $debug_net_smtp,
1487                                                  Port => $smtp_server_port);
1488                         if ($smtp_encryption eq 'tls' && $smtp) {
1489                                 if ($use_net_smtp_ssl) {
1490                                         $smtp->command('STARTTLS');
1491                                         $smtp->response();
1492                                         if ($smtp->code != 220) {
1493                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1494                                         }
1495                                         require Net::SMTP::SSL;
1496                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1497                                                                           ssl_verify_params())
1498                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1499                                 }
1500                                 else {
1501                                         $smtp->starttls(ssl_verify_params())
1502                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1503                                 }
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 }