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