git.oblomov.eu Git - git/blob - git-send-email.perl

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