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