git-send-email.perl

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