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                 require Net::SMTP;
1357                 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1358                 $smtp_domain ||= maildomain();
1359
1360                 if ($smtp_encryption eq 'ssl') {
1361                         $smtp_server_port ||= 465; # ssmtp
1362                         require IO::Socket::SSL;
1363
1364                         # Suppress "variable accessed once" warning.
1365                         {
1366                                 no warnings 'once';
1367                                 $IO::Socket::SSL::DEBUG = 1;
1368                         }
1369
1370                         # Net::SMTP::SSL->new() does not forward any SSL options
1371                         IO::Socket::SSL::set_client_defaults(
1372                                 ssl_verify_params());
1373
1374                         if ($use_net_smtp_ssl) {
1375                                 require Net::SMTP::SSL;
1376                                 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1377                                                               Hello => $smtp_domain,
1378                                                               Port => $smtp_server_port,
1379                                                               Debug => $debug_net_smtp);
1380                         }
1381                         else {
1382                                 $smtp ||= Net::SMTP->new($smtp_server,
1383                                                          Hello => $smtp_domain,
1384                                                          Port => $smtp_server_port,
1385                                                          Debug => $debug_net_smtp,
1386                                                          SSL => 1);
1387                         }
1388                 }
1389                 else {
1390                         $smtp_server_port ||= 25;
1391                         $smtp ||= Net::SMTP->new($smtp_server,
1392                                                  Hello => $smtp_domain,
1393                                                  Debug => $debug_net_smtp,
1394                                                  Port => $smtp_server_port);
1395                         if ($smtp_encryption eq 'tls' && $smtp) {
1396                                 if ($use_net_smtp_ssl) {
1397                                         $smtp->command('STARTTLS');
1398                                         $smtp->response();
1399                                         if ($smtp->code != 220) {
1400                                                 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1401                                         }
1402                                         require Net::SMTP::SSL;
1403                                         $smtp = Net::SMTP::SSL->start_SSL($smtp,
1404                                                                           ssl_verify_params())
1405                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1406                                 }
1407                                 else {
1408                                         $smtp->starttls(ssl_verify_params())
1409                                                 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1410                                 }
1411                                 $smtp_encryption = '';
1412                                 # Send EHLO again to receive fresh
1413                                 # supported commands
1414                                 $smtp->hello($smtp_domain);
1415                         }
1416                 }
1417
1418                 if (!$smtp) {
1419                         die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1420                             " VALUES: server=$smtp_server ",
1421                             "encryption=$smtp_encryption ",
1422                             "hello=$smtp_domain",
1423                             defined $smtp_server_port ? " port=$smtp_server_port" : "";
1424                 }
1425
1426                 smtp_auth_maybe or die $smtp->message;
1427
1428                 $smtp->mail( $raw_from ) or die $smtp->message;
1429                 $smtp->to( @recipients ) or die $smtp->message;
1430                 $smtp->data or die $smtp->message;
1431                 $smtp->datasend("$header\n") or die $smtp->message;
1432                 my @lines = split /^/, $message;
1433                 foreach my $line (@lines) {
1434                         $smtp->datasend("$line") or die $smtp->message;
1435                 }
1436                 $smtp->dataend() or die $smtp->message;
1437                 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1438         }
1439         if ($quiet) {
1440                 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1441         } else {
1442                 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1443                 if (!file_name_is_absolute($smtp_server)) {
1444                         print "Server: $smtp_server\n";
1445                         print "MAIL FROM:<$raw_from>\n";
1446                         foreach my $entry (@recipients) {
1447                             print "RCPT TO:<$entry>\n";
1448                         }
1449                 } else {
1450                         print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1451                 }
1452                 print $header, "\n";
1453                 if ($smtp) {
1454                         print __("Result: "), $smtp->code, ' ',
1455                                 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1456                 } else {
1457                         print __("Result: OK\n");
1458                 }
1459         }
1460
1461         return 1;
1462 }
1463
1464 $reply_to = $initial_reply_to;
1465 $references = $initial_reply_to || '';
1466 $subject = $initial_subject;
1467 $message_num = 0;
1468
1469 foreach my $t (@files) {
1470         open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1471
1472         my $author = undef;
1473         my $sauthor = undef;
1474         my $author_encoding;
1475         my $has_content_type;
1476         my $body_encoding;
1477         my $xfer_encoding;
1478         my $has_mime_version;
1479         @to = ();
1480         @cc = ();
1481         @xh = ();
1482         my $input_format = undef;
1483         my @header = ();
1484         $message = "";
1485         $message_num++;
1486         # First unfold multiline header fields
1487         while(<$fh>) {
1488                 last if /^\s*$/;
1489                 if (/^\s+\S/ and @header) {
1490                         chomp($header[$#header]);
1491                         s/^\s+/ /;
1492                         $header[$#header] .= $_;
1493             } else {
1494                         push(@header, $_);
1495                 }
1496         }
1497         # Now parse the header
1498         foreach(@header) {
1499                 if (/^From /) {
1500                         $input_format = 'mbox';
1501                         next;
1502                 }
1503                 chomp;
1504                 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1505                         $input_format = 'mbox';
1506                 }
1507
1508                 if (defined $input_format && $input_format eq 'mbox') {
1509                         if (/^Subject:\s+(.*)$/i) {
1510                                 $subject = $1;
1511                         }
1512                         elsif (/^From:\s+(.*)$/i) {
1513                                 ($author, $author_encoding) = unquote_rfc2047($1);
1514                                 $sauthor = sanitize_address($author);
1515                                 next if $suppress_cc{'author'};
1516                                 next if $suppress_cc{'self'} and $sauthor eq $sender;
1517                                 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1518                                         $1, $_) unless $quiet;
1519                                 push @cc, $1;
1520                         }
1521                         elsif (/^To:\s+(.*)$/i) {
1522                                 foreach my $addr (parse_address_line($1)) {
1523                                         printf(__("(mbox) Adding to: %s from line '%s'\n"),
1524                                                 $addr, $_) unless $quiet;
1525                                         push @to, $addr;
1526                                 }
1527                         }
1528                         elsif (/^Cc:\s+(.*)$/i) {
1529                                 foreach my $addr (parse_address_line($1)) {
1530                                         my $qaddr = unquote_rfc2047($addr);
1531                                         my $saddr = sanitize_address($qaddr);
1532                                         if ($saddr eq $sender) {
1533                                                 next if ($suppress_cc{'self'});
1534                                         } else {
1535                                                 next if ($suppress_cc{'cc'});
1536                                         }
1537                                         printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1538                                                 $addr, $_) unless $quiet;
1539                                         push @cc, $addr;
1540                                 }
1541                         }
1542                         elsif (/^Content-type:/i) {
1543                                 $has_content_type = 1;
1544                                 if (/charset="?([^ "]+)/) {
1545                                         $body_encoding = $1;
1546                                 }
1547                                 push @xh, $_;
1548                         }
1549                         elsif (/^MIME-Version/i) {
1550                                 $has_mime_version = 1;
1551                                 push @xh, $_;
1552                         }
1553                         elsif (/^Message-Id: (.*)/i) {
1554                                 $message_id = $1;
1555                         }
1556                         elsif (/^Content-Transfer-Encoding: (.*)/i) {
1557                                 $xfer_encoding = $1 if not defined $xfer_encoding;
1558                         }
1559                         elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1560                                 push @xh, $_;
1561                         }
1562
1563                 } else {
1564                         # In the traditional
1565                         # "send lots of email" format,
1566                         # line 1 = cc
1567                         # line 2 = subject
1568                         # So let's support that, too.
1569                         $input_format = 'lots';
1570                         if (@cc == 0 && !$suppress_cc{'cc'}) {
1571                                 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1572                                         $_, $_) unless $quiet;
1573                                 push @cc, $_;
1574                         } elsif (!defined $subject) {
1575                                 $subject = $_;
1576                         }
1577                 }
1578         }
1579         # Now parse the message body
1580         while(<$fh>) {
1581                 $message .=  $_;
1582                 if (/^(Signed-off-by|Cc): ([^>]*>?)/i) {
1583                         chomp;
1584                         my ($what, $c) = ($1, $2);
1585                         chomp $c;
1586                         my $sc = sanitize_address($c);
1587                         if ($sc eq $sender) {
1588                                 next if ($suppress_cc{'self'});
1589                         } else {
1590                                 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1591                                 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1592                         }
1593                         push @cc, $c;
1594                         printf(__("(body) Adding cc: %s from line '%s'\n"),
1595                                 $c, $_) unless $quiet;
1596                 }
1597         }
1598         close $fh;
1599
1600         push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1601                 if defined $to_cmd;
1602         push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1603                 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1604
1605         if ($broken_encoding{$t} && !$has_content_type) {
1606                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1607                 $has_content_type = 1;
1608                 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1609                 $body_encoding = $auto_8bit_encoding;
1610         }
1611
1612         if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1613                 $subject = quote_subject($subject, $auto_8bit_encoding);
1614         }
1615
1616         if (defined $sauthor and $sauthor ne $sender) {
1617                 $message = "From: $author\n\n$message";
1618                 if (defined $author_encoding) {
1619                         if ($has_content_type) {
1620                                 if ($body_encoding eq $author_encoding) {
1621                                         # ok, we already have the right encoding
1622                                 }
1623                                 else {
1624                                         # uh oh, we should re-encode
1625                                 }
1626                         }
1627                         else {
1628                                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1629                                 $has_content_type = 1;
1630                                 push @xh,
1631                                   "Content-Type: text/plain; charset=$author_encoding";
1632                         }
1633                 }
1634         }
1635         if (defined $target_xfer_encoding) {
1636                 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1637                 $message = apply_transfer_encoding(
1638                         $message, $xfer_encoding, $target_xfer_encoding);
1639                 $xfer_encoding = $target_xfer_encoding;
1640         }
1641         if (defined $xfer_encoding) {
1642                 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1643         }
1644         if (defined $xfer_encoding or $has_content_type) {
1645                 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1646         }
1647
1648         $needs_confirm = (
1649                 $confirm eq "always" or
1650                 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1651                 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1652         $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1653
1654         @to = process_address_list(@to);
1655         @cc = process_address_list(@cc);
1656
1657         @to = (@initial_to, @to);
1658         @cc = (@initial_cc, @cc);
1659
1660         if ($message_num == 1) {
1661                 if (defined $cover_cc and $cover_cc) {
1662                         @initial_cc = @cc;
1663                 }
1664                 if (defined $cover_to and $cover_to) {
1665                         @initial_to = @to;
1666                 }
1667         }
1668
1669         my $message_was_sent = send_message();
1670
1671         # set up for the next message
1672         if ($thread && $message_was_sent &&
1673                 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1674                 $message_num == 1)) {
1675                 $reply_to = $message_id;
1676                 if (length $references > 0) {
1677                         $references .= "\n $message_id";
1678                 } else {
1679                         $references = "$message_id";
1680                 }
1681         }
1682         $message_id = undef;
1683 }
1684
1685 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1686 # and return a results array
1687 sub recipients_cmd {
1688         my ($prefix, $what, $cmd, $file) = @_;
1689
1690         my @addresses = ();
1691         open my $fh, "-|", "$cmd \Q$file\E"
1692             or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1693         while (my $address = <$fh>) {
1694                 $address =~ s/^\s*//g;
1695                 $address =~ s/\s*$//g;
1696                 $address = sanitize_address($address);
1697                 next if ($address eq $sender and $suppress_cc{'self'});
1698                 push @addresses, $address;
1699                 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1700                        $prefix, $what, $address, $cmd) unless $quiet;
1701                 }
1702         close $fh
1703             or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1704         return @addresses;
1705 }
1706
1707 cleanup_compose_files();
1708
1709 sub cleanup_compose_files {
1710         unlink($compose_filename, $compose_filename . ".final") if $compose;
1711 }
1712
1713 $smtp->quit if $smtp;
1714
1715 sub apply_transfer_encoding {
1716         my $message = shift;
1717         my $from = shift;
1718         my $to = shift;
1719
1720         return $message if ($from eq $to and $from ne '7bit');
1721
1722         require MIME::QuotedPrint;
1723         require MIME::Base64;
1724
1725         $message = MIME::QuotedPrint::decode($message)
1726                 if ($from eq 'quoted-printable');
1727         $message = MIME::Base64::decode($message)
1728                 if ($from eq 'base64');
1729
1730         die __("cannot send message as 7bit")
1731                 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1732         return $message
1733                 if ($to eq '7bit' or $to eq '8bit');
1734         return MIME::QuotedPrint::encode($message, "\n", 0)
1735                 if ($to eq 'quoted-printable');
1736         return MIME::Base64::encode($message, "\n")
1737                 if ($to eq 'base64');
1738         die __("invalid transfer encoding");
1739 }
1740
1741 sub unique_email_list {
1742         my %seen;
1743         my @emails;
1744
1745         foreach my $entry (@_) {
1746                 my $clean = extract_valid_address_or_die($entry);
1747                 $seen{$clean} ||= 0;
1748                 next if $seen{$clean}++;
1749                 push @emails, $entry;
1750         }
1751         return @emails;
1752 }
1753
1754 sub validate_patch {
1755         my $fn = shift;
1756         open(my $fh, '<', $fn)
1757                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1758         while (my $line = <$fh>) {
1759                 if (length($line) > 998) {
1760                         return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1761                 }
1762         }
1763         return;
1764 }
1765
1766 sub handle_backup {
1767         my ($last, $lastlen, $file, $known_suffix) = @_;
1768         my ($suffix, $skip);
1769
1770         $skip = 0;
1771         if (defined $last &&
1772             ($lastlen < length($file)) &&
1773             (substr($file, 0, $lastlen) eq $last) &&
1774             ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1775                 if (defined $known_suffix && $suffix eq $known_suffix) {
1776                         printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1777                         $skip = 1;
1778                 } else {
1779                         # TRANSLATORS: please keep "[y|N]" as is.
1780                         my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1781                                          valid_re => qr/^(?:y|n)/i,
1782                                          default => 'n');
1783                         $skip = ($answer ne 'y');
1784                         if ($skip) {
1785                                 $known_suffix = $suffix;
1786                         }
1787                 }
1788         }
1789         return ($skip, $known_suffix);
1790 }
1791
1792 sub handle_backup_files {
1793         my @file = @_;
1794         my ($last, $lastlen, $known_suffix, $skip, @result);
1795         for my $file (@file) {
1796                 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1797                                                        $file, $known_suffix);
1798                 push @result, $file unless $skip;
1799                 $last = $file;
1800                 $lastlen = length($file);
1801         }
1802         return @result;
1803 }
1804
1805 sub file_has_nonascii {
1806         my $fn = shift;
1807         open(my $fh, '<', $fn)
1808                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1809         while (my $line = <$fh>) {
1810                 return 1 if $line =~ /[^[:ascii:]]/;
1811         }
1812         return 0;
1813 }
1814
1815 sub body_or_subject_has_nonascii {
1816         my $fn = shift;
1817         open(my $fh, '<', $fn)
1818                 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1819         while (my $line = <$fh>) {
1820                 last if $line =~ /^$/;
1821                 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1822         }
1823         while (my $line = <$fh>) {
1824                 return 1 if $line =~ /[^[:ascii:]]/;
1825         }
1826         return 0;
1827 }