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

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