git.oblomov.eu Git - git/blob - git-send-email.perl

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