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