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