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