3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
8 # Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
10 # Sends a collection of emails to the given email addresses, disturbingly fast.
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.
22 use POSIX qw/strftime/;
27 use File::Temp qw/ tempdir tempfile /;
28 use File::Spec::Functions qw(catdir catfile);
29 use Git::LoadCPAN::Error qw(:try);
30 use Cwd qw(abs_path cwd);
35 use Git::LoadCPAN::Mail::Address;
37 Getopt::Long::Configure qw/ pass_through /;
41 my ($class, $reason) = @_;
42 return bless \$reason, shift;
46 die "Cannot use readline on FakeTerm: $$self";
53 git send-email [options] <file | directory | rev-list options >
54 git send-email --dump-aliases
57 --from <str> * Email From:
58 --[no-]to <str> * Email To:
59 --[no-]cc <str> * Email Cc:
60 --[no-]bcc <str> * Email Bcc:
61 --subject <str> * Email "Subject:"
62 --reply-to <str> * Email "Reply-To:"
63 --in-reply-to <str> * Email "In-Reply-To:"
64 --[no-]xmailer * Add "X-Mailer:" header (default).
65 --[no-]annotate * Review each patch that will be sent in an editor.
66 --compose * Open an editor for introduction.
67 --compose-encoding <str> * Encoding to assume for introduction.
68 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
69 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
72 --envelope-sender <str> * Email envelope sender.
73 --smtp-server <str:int> * Outgoing SMTP server to use. The port
74 is optional. Default 'localhost'.
75 --smtp-server-option <str> * Outgoing SMTP server option to use.
76 --smtp-server-port <int> * Outgoing SMTP server port.
77 --smtp-user <str> * Username for SMTP-AUTH.
78 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
79 --smtp-encryption <str> * tls or ssl; anything else disables.
80 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
81 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
82 Pass an empty string to disable certificate
84 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
85 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms.
86 This setting forces to use one of the listed mechanisms.
87 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
89 --batch-size <int> * send max <int> message per connection.
90 --relogin-delay <int> * delay <int> seconds between two successive login.
91 This option can only be used with --batch-size
94 --identity <str> * Use the sendemail.<id> options.
95 --to-cmd <str> * Email To: via `<str> \$patch_path`
96 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
97 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, all.
98 --[no-]cc-cover * Email Cc: addresses in the cover letter.
99 --[no-]to-cover * Email To: addresses in the cover letter.
100 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
101 --[no-]suppress-from * Send to self. Default off.
102 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
103 --[no-]thread * Use In-Reply-To: field. Default on.
106 --confirm <str> * Confirm recipients before sending;
107 auto, cc, compose, always, or never.
108 --quiet * Output one line of info per email.
109 --dry-run * Don't actually send the emails.
110 --[no-]validate * Perform patch sanity checks. Default on.
111 --[no-]format-patch * understand any non optional arguments as
112 `git format-patch` ones.
113 --force * Send even if safety checks would prevent it.
116 --dump-aliases * Dump configured aliases and exit.
122 # most mail servers generate the Date: header, but not all...
123 sub format_2822_time {
125 my @localtm = localtime($time);
126 my @gmttm = gmtime($time);
127 my $localmin = $localtm[1] + $localtm[2] * 60;
128 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
129 if ($localtm[0] != $gmttm[0]) {
130 die __("local zone differs from GMT by a non-minute interval\n");
132 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
134 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
136 } elsif ($gmttm[6] != $localtm[6]) {
137 die __("local time offset greater than or equal to 24 hours\n");
139 my $offset = $localmin - $gmtmin;
140 my $offhour = $offset / 60;
141 my $offmin = abs($offset % 60);
142 if (abs($offhour) >= 24) {
143 die __("local time offset greater than or equal to 24 hours\n");
146 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
147 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
149 qw(Jan Feb Mar Apr May Jun
150 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
155 ($offset >= 0) ? '+' : '-',
161 my $have_email_valid = eval { require Email::Valid; 1 };
166 # Regexes for RFC 2047 productions.
167 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
168 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
169 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
171 # Variables we fill in automatically, or via prompting:
172 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@initial_bcc,$no_bcc,@xh,
173 $initial_in_reply_to,$reply_to,$initial_subject,@files,
174 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
179 #$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
181 my $repo = eval { Git->repository() };
182 my @repo = $repo ? ($repo) : ();
184 $ENV{"GIT_SEND_EMAIL_NOTTY"}
185 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
186 : new Term::ReadLine 'git-send-email';
189 $term = new FakeTerm "$@: going non-interactive";
192 # Behavior modification variables
193 my ($quiet, $dry_run) = (0, 0);
195 my $compose_filename;
197 my $dump_aliases = 0;
199 # Handle interactive edition of files.
204 if (!defined($editor)) {
205 $editor = Git::command_oneline('var', 'GIT_EDITOR');
207 if (defined($multiedit) && !$multiedit) {
209 system('sh', '-c', $editor.' "$@"', $editor, $_);
210 if (($? & 127) || ($? >> 8)) {
211 die(__("the editor exited uncleanly, aborting everything"));
215 system('sh', '-c', $editor.' "$@"', $editor, @_);
216 if (($? & 127) || ($? >> 8)) {
217 die(__("the editor exited uncleanly, aborting everything"));
222 # Variables with corresponding config settings
223 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
224 my ($cover_cc, $cover_to);
225 my ($to_cmd, $cc_cmd);
226 my ($smtp_server, $smtp_server_port, @smtp_server_options);
227 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
228 my ($batch_size, $relogin_delay);
229 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
230 my ($validate, $confirm);
232 my ($auto_8bit_encoding);
233 my ($compose_encoding);
234 my $target_xfer_encoding = 'auto';
236 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
238 my %config_bool_settings = (
239 "thread" => [\$thread, 1],
240 "chainreplyto" => [\$chain_reply_to, 0],
241 "suppressfrom" => [\$suppress_from, undef],
242 "signedoffbycc" => [\$signed_off_by_cc, undef],
243 "cccover" => [\$cover_cc, undef],
244 "tocover" => [\$cover_to, undef],
245 "signedoffcc" => [\$signed_off_by_cc, undef], # Deprecated
246 "validate" => [\$validate, 1],
247 "multiedit" => [\$multiedit, undef],
248 "annotate" => [\$annotate, undef],
249 "xmailer" => [\$use_xmailer, 1]
252 my %config_settings = (
253 "smtpserver" => \$smtp_server,
254 "smtpserverport" => \$smtp_server_port,
255 "smtpserveroption" => \@smtp_server_options,
256 "smtpuser" => \$smtp_authuser,
257 "smtppass" => \$smtp_authpass,
258 "smtpdomain" => \$smtp_domain,
259 "smtpauth" => \$smtp_auth,
260 "smtpbatchsize" => \$batch_size,
261 "smtprelogindelay" => \$relogin_delay,
262 "to" => \@initial_to,
264 "cc" => \@initial_cc,
266 "aliasfiletype" => \$aliasfiletype,
267 "bcc" => \@initial_bcc,
268 "suppresscc" => \@suppress_cc,
269 "envelopesender" => \$envelope_sender,
270 "confirm" => \$confirm,
272 "assume8bitencoding" => \$auto_8bit_encoding,
273 "composeencoding" => \$compose_encoding,
274 "transferencoding" => \$target_xfer_encoding,
277 my %config_path_settings = (
278 "aliasesfile" => \@alias_files,
279 "smtpsslcertpath" => \$smtp_ssl_cert_path,
282 # Handle Uncouth Termination
286 print color("reset"), "\n";
288 # SMTP password masked
291 # tmp files from --compose
292 if (defined $compose_filename) {
293 if (-e $compose_filename) {
294 printf __("'%s' contains an intermediate version ".
295 "of the email you were composing.\n"),
298 if (-e ($compose_filename . ".final")) {
299 printf __("'%s.final' contains the composed email.\n"),
307 $SIG{TERM} = \&signal_handler;
308 $SIG{INT} = \&signal_handler;
310 # Read our sendemail.* config
314 foreach my $setting (keys %config_bool_settings) {
315 my $target = $config_bool_settings{$setting}->[0];
316 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
319 foreach my $setting (keys %config_path_settings) {
320 my $target = $config_path_settings{$setting};
321 if (ref($target) eq "ARRAY") {
323 my @values = Git::config_path(@repo, "$prefix.$setting");
324 @$target = @values if (@values && defined $values[0]);
328 $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
332 foreach my $setting (keys %config_settings) {
333 my $target = $config_settings{$setting};
334 next if $setting eq "to" and defined $no_to;
335 next if $setting eq "cc" and defined $no_cc;
336 next if $setting eq "bcc" and defined $no_bcc;
337 if (ref($target) eq "ARRAY") {
339 my @values = Git::config(@repo, "$prefix.$setting");
340 @$target = @values if (@values && defined $values[0]);
344 $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
348 if (!defined $smtp_encryption) {
349 my $enc = Git::config(@repo, "$prefix.smtpencryption");
351 $smtp_encryption = $enc;
352 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
353 $smtp_encryption = 'ssl';
358 # Begin by accumulating all the variables (defined above), that we will end up
359 # needing, first, from the command line:
362 my $rc = GetOptions("h" => \$help,
363 "dump-aliases" => \$dump_aliases);
365 die __("--dump-aliases incompatible with other options\n")
366 if !$help and $dump_aliases and @ARGV;
368 "sender|from=s" => \$sender,
369 "in-reply-to=s" => \$initial_in_reply_to,
370 "reply-to=s" => \$reply_to,
371 "subject=s" => \$initial_subject,
372 "to=s" => \@initial_to,
373 "to-cmd=s" => \$to_cmd,
375 "cc=s" => \@initial_cc,
377 "bcc=s" => \@initial_bcc,
378 "no-bcc" => \$no_bcc,
379 "chain-reply-to!" => \$chain_reply_to,
380 "no-chain-reply-to" => sub {$chain_reply_to = 0},
381 "smtp-server=s" => \$smtp_server,
382 "smtp-server-option=s" => \@smtp_server_options,
383 "smtp-server-port=s" => \$smtp_server_port,
384 "smtp-user=s" => \$smtp_authuser,
385 "smtp-pass:s" => \$smtp_authpass,
386 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
387 "smtp-encryption=s" => \$smtp_encryption,
388 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
389 "smtp-debug:i" => \$debug_net_smtp,
390 "smtp-domain:s" => \$smtp_domain,
391 "smtp-auth=s" => \$smtp_auth,
392 "identity=s" => \$identity,
393 "annotate!" => \$annotate,
394 "no-annotate" => sub {$annotate = 0},
395 "compose" => \$compose,
397 "cc-cmd=s" => \$cc_cmd,
398 "suppress-from!" => \$suppress_from,
399 "no-suppress-from" => sub {$suppress_from = 0},
400 "suppress-cc=s" => \@suppress_cc,
401 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
402 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
403 "cc-cover|cc-cover!" => \$cover_cc,
404 "no-cc-cover" => sub {$cover_cc = 0},
405 "to-cover|to-cover!" => \$cover_to,
406 "no-to-cover" => sub {$cover_to = 0},
407 "confirm=s" => \$confirm,
408 "dry-run" => \$dry_run,
409 "envelope-sender=s" => \$envelope_sender,
410 "thread!" => \$thread,
411 "no-thread" => sub {$thread = 0},
412 "validate!" => \$validate,
413 "no-validate" => sub {$validate = 0},
414 "transfer-encoding=s" => \$target_xfer_encoding,
415 "format-patch!" => \$format_patch,
416 "no-format-patch" => sub {$format_patch = 0},
417 "8bit-encoding=s" => \$auto_8bit_encoding,
418 "compose-encoding=s" => \$compose_encoding,
420 "xmailer!" => \$use_xmailer,
421 "no-xmailer" => sub {$use_xmailer = 0},
422 "batch-size=i" => \$batch_size,
423 "relogin-delay=i" => \$relogin_delay,
431 die __("Cannot run git format-patch from outside a repository\n")
432 if $format_patch and not $repo;
434 die __("`batch-size` and `relogin` must be specified together " .
435 "(via command-line or configuration option)\n")
436 if defined $relogin_delay and not defined $batch_size;
438 # read configuration from [sendemail "$identity"], fall back on [sendemail]
439 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
440 read_config("sendemail.$identity") if (defined $identity);
441 read_config("sendemail");
443 # fall back on builtin bool defaults
444 foreach my $setting (values %config_bool_settings) {
445 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
448 # 'default' encryption is none -- this only prevents a warning
449 $smtp_encryption = '' unless (defined $smtp_encryption);
451 # Set CC suppressions
454 foreach my $entry (@suppress_cc) {
455 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
456 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
457 $suppress_cc{$entry} = 1;
461 if ($suppress_cc{'all'}) {
462 foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
463 $suppress_cc{$entry} = 1;
465 delete $suppress_cc{'all'};
468 # If explicit old-style ones are specified, they trump --suppress-cc.
469 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
470 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
472 if ($suppress_cc{'body'}) {
473 foreach my $entry (qw (sob bodycc)) {
474 $suppress_cc{$entry} = 1;
476 delete $suppress_cc{'body'};
479 # Set confirm's default value
480 my $confirm_unconfigured = !defined $confirm;
481 if ($confirm_unconfigured) {
482 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
484 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
485 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
487 # Debugging, print out the suppressions.
489 print "suppressions:\n";
490 foreach my $entry (keys %suppress_cc) {
491 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
495 my ($repoauthor, $repocommitter);
496 ($repoauthor) = Git::ident_person(@repo, 'author');
497 ($repocommitter) = Git::ident_person(@repo, 'committer');
499 sub parse_address_line {
500 return map { $_->format } Mail::Address->parse($_[0]);
504 return quotewords('\s*,\s*', 1, @_);
509 sub parse_sendmail_alias {
512 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
513 } elsif (/:include:/) {
514 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
516 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
517 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
518 my ($alias, $addr) = ($1, $2);
519 $aliases{$alias} = [ split_addrs($addr) ];
521 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
525 sub parse_sendmail_aliases {
530 next if /^\s*$/ || /^\s*#/;
531 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
532 parse_sendmail_alias($s) if $s;
535 $s =~ s/\\$//; # silently tolerate stray '\' on last line
536 parse_sendmail_alias($s) if $s;
540 # multiline formats can be supported in the future
541 mutt => sub { my $fh = shift; while (<$fh>) {
542 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
543 my ($alias, $addr) = ($1, $2);
544 $addr =~ s/#.*$//; # mutt allows # comments
545 # commas delimit multiple addresses
546 my @addr = split_addrs($addr);
548 # quotes may be escaped in the file,
549 # unescape them so we do not double-escape them later.
550 s/\\"/"/g foreach @addr;
551 $aliases{$alias} = \@addr
553 mailrc => sub { my $fh = shift; while (<$fh>) {
554 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
555 # spaces delimit multiple addresses
556 $aliases{$1} = [ quotewords('\s+', 0, $2) ];
558 pine => sub { my $fh = shift; my $f='\t[^\t]*';
559 for (my $x = ''; defined($x); $x = $_) {
561 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
562 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
563 $aliases{$1} = [ split_addrs($2) ];
565 elm => sub { my $fh = shift;
567 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
568 my ($alias, $addr) = ($1, $2);
569 $aliases{$alias} = [ split_addrs($addr) ];
572 sendmail => \&parse_sendmail_aliases,
573 gnus => sub { my $fh = shift; while (<$fh>) {
574 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
575 $aliases{$1} = [ $2 ];
579 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
580 foreach my $file (@alias_files) {
581 open my $fh, '<', $file or die "opening $file: $!\n";
582 $parse_alias{$aliasfiletype}->($fh);
588 print "$_\n" for (sort keys %aliases);
592 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
593 # $f is a revision list specification to be passed to format-patch.
594 sub is_format_patch_arg {
598 $repo->command('rev-parse', '--verify', '--quiet', $f);
599 if (defined($format_patch)) {
600 return $format_patch;
602 die sprintf(__ <<EOF, $f, $f);
603 File '%s' exists but it could also be the range of commits
604 to produce patches for. Please disambiguate by...
606 * Saying "./%s" if you mean a file; or
607 * Giving --format-patch option if you mean a range.
609 } catch Git::Error::Command with {
610 # Not a valid revision. Treat it as a filename.
615 # Now that all the defaults are set, process the rest of the command line
616 # arguments and collect up the files that need to be processed.
618 while (defined(my $f = shift @ARGV)) {
620 push @rev_list_opts, "--", @ARGV;
622 } elsif (-d $f and !is_format_patch_arg($f)) {
624 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
626 push @files, grep { -f $_ } map { catfile($f, $_) }
629 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
632 push @rev_list_opts, $f;
636 if (@rev_list_opts) {
637 die __("Cannot run git format-patch from outside a repository\n")
639 push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
642 @files = handle_backup_files(@files);
645 foreach my $f (@files) {
647 my $error = validate_patch($f, $target_xfer_encoding);
648 $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
656 print $_,"\n" for (@files);
659 print STDERR __("\nNo patch files specified!\n\n");
663 sub get_patch_subject {
665 open (my $fh, '<', $fn);
666 while (my $line = <$fh>) {
667 next unless ($line =~ /^Subject: (.*)$/);
672 die sprintf(__("No subject line in %s?"), $fn);
676 # Note that this does not need to be secure, but we will make a small
677 # effort to have it be unique
678 $compose_filename = ($repo ?
679 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
680 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
681 open my $c, ">", $compose_filename
682 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
685 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
686 my $tpl_subject = $initial_subject || '';
687 my $tpl_in_reply_to = $initial_in_reply_to || '';
688 my $tpl_reply_to = $reply_to || '';
690 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
691 From $tpl_sender # This line is ignored.
693 Lines beginning in "GIT:" will be removed.
694 Consider including an overall diffstat or table of contents
695 for the patch you are writing.
697 Clear the body content if you don't wish to send a summary.
700 Reply-To: $tpl_reply_to
701 Subject: $tpl_subject
702 In-Reply-To: $tpl_in_reply_to
706 print $c get_patch_subject($f);
711 do_edit($compose_filename, @files);
713 do_edit($compose_filename);
716 open $c, "<", $compose_filename
717 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
719 if (!defined $compose_encoding) {
720 $compose_encoding = "UTF-8";
724 while (my $line = <$c>) {
725 next if $line =~ m/^GIT:/;
726 parse_header_line($line, \%parsed_email);
728 $parsed_email{'body'} = filter_body($c);
733 open my $c2, ">", $compose_filename . ".final"
734 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
737 if ($parsed_email{'From'}) {
738 $sender = delete($parsed_email{'From'});
740 if ($parsed_email{'In-Reply-To'}) {
741 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
743 if ($parsed_email{'Reply-To'}) {
744 $reply_to = delete($parsed_email{'Reply-To'});
746 if ($parsed_email{'Subject'}) {
747 $initial_subject = delete($parsed_email{'Subject'});
748 print $c2 "Subject: " .
749 quote_subject($initial_subject, $compose_encoding) .
753 if ($parsed_email{'MIME-Version'}) {
754 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
755 "Content-Type: $parsed_email{'Content-Type'};\n",
756 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
757 delete($parsed_email{'MIME-Version'});
758 delete($parsed_email{'Content-Type'});
759 delete($parsed_email{'Content-Transfer-Encoding'});
760 } elsif (file_has_nonascii($compose_filename)) {
761 my $content_type = (delete($parsed_email{'Content-Type'}) or
762 "text/plain; charset=$compose_encoding");
763 print $c2 "MIME-Version: 1.0\n",
764 "Content-Type: $content_type\n",
765 "Content-Transfer-Encoding: 8bit\n";
767 # Preserve unknown headers
768 foreach my $key (keys %parsed_email) {
769 next if $key eq 'body';
770 print $c2 "$key: $parsed_email{$key}";
773 if ($parsed_email{'body'}) {
774 print $c2 "\n$parsed_email{'body'}\n";
775 delete($parsed_email{'body'});
777 print __("Summary email is empty, skipping it\n");
783 } elsif ($annotate) {
788 my ($prompt, %arg) = @_;
789 my $valid_re = $arg{valid_re};
790 my $default = $arg{default};
791 my $confirm_only = $arg{confirm_only};
794 return defined $default ? $default : undef
795 unless defined $term->IN and defined fileno($term->IN) and
796 defined $term->OUT and defined fileno($term->OUT);
798 $resp = $term->readline($prompt);
799 if (!defined $resp) { # EOF
801 return defined $default ? $default : undef;
803 if ($resp eq '' and defined $default) {
806 if (!defined $valid_re or $resp =~ /$valid_re/) {
810 my $yesno = $term->readline(
811 # TRANSLATORS: please keep [y/N] as is.
812 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
813 if (defined $yesno && $yesno =~ /y/i) {
821 sub parse_header_line {
823 my $parsed_line = shift;
824 my $addr_pat = join "|", qw(To Cc Bcc);
826 foreach (split(/\n/, $lines)) {
827 if (/^($addr_pat):\s*(.+)$/i) {
828 $parsed_line->{$1} = [ parse_address_line($2) ];
829 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
830 $parsed_line->{$1} = $2;
838 while (my $body_line = <$c>) {
839 if ($body_line !~ m/^GIT:/) {
849 sub file_declares_8bit_cte {
851 open (my $fh, '<', $fn);
852 while (my $line = <$fh>) {
853 last if ($line =~ /^$/);
854 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
860 foreach my $f (@files) {
861 next unless (body_or_subject_has_nonascii($f)
862 && !file_declares_8bit_cte($f));
863 $broken_encoding{$f} = 1;
866 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
867 print __("The following files are 8bit, but do not declare " .
868 "a Content-Transfer-Encoding.\n");
869 foreach my $f (sort keys %broken_encoding) {
872 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
873 valid_re => qr/.{4}/, confirm_only => 1,
879 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
880 die sprintf(__("Refusing to send because the patch\n\t%s\n"
881 . "has the template subject '*** SUBJECT HERE ***'. "
882 . "Pass --force if you really want to send.\n"), $f);
887 if (defined $sender) {
888 $sender =~ s/^\s+|\s+$//g;
889 ($sender) = expand_aliases($sender);
891 $sender = $repoauthor || $repocommitter || '';
894 # $sender could be an already sanitized address
895 # (e.g. sendemail.from could be manually sanitized by user).
896 # But it's a no-op to run sanitize_address on an already sanitized address.
897 $sender = sanitize_address($sender);
899 my $to_whom = __("To whom should the emails be sent (if anyone)?");
901 if (!@initial_to && !defined $to_cmd) {
902 my $to = ask("$to_whom ",
904 valid_re => qr/\@.*\./, confirm_only => 1);
905 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
910 return map { expand_one_alias($_) } @_;
913 my %EXPANDED_ALIASES;
914 sub expand_one_alias {
916 if ($EXPANDED_ALIASES{$alias}) {
917 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
919 local $EXPANDED_ALIASES{$alias} = 1;
920 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
923 @initial_to = process_address_list(@initial_to);
924 @initial_cc = process_address_list(@initial_cc);
925 @initial_bcc = process_address_list(@initial_bcc);
927 if ($thread && !defined $initial_in_reply_to && $prompting) {
928 $initial_in_reply_to = ask(
929 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
931 valid_re => qr/\@.*\./, confirm_only => 1);
933 if (defined $initial_in_reply_to) {
934 $initial_in_reply_to =~ s/^\s*<?//;
935 $initial_in_reply_to =~ s/>?\s*$//;
936 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
939 if (defined $reply_to) {
940 $reply_to =~ s/^\s+|\s+$//g;
941 ($reply_to) = expand_aliases($reply_to);
942 $reply_to = sanitize_address($reply_to);
945 if (!defined $smtp_server) {
946 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
947 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
948 foreach (@sendmail_paths) {
954 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
957 if ($compose && $compose > 0) {
958 @files = ($compose_filename . ".final", @files);
961 # Variables we set as part of the loop over files
962 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
963 $needs_confirm, $message_num, $ask_default);
965 sub extract_valid_address {
967 my $local_part_regexp = qr/[^<>"\s@]+/;
968 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
970 # check for a local address:
971 return $address if ($address =~ /^($local_part_regexp)$/);
973 $address =~ s/^\s*<(.*)>\s*$/$1/;
974 if ($have_email_valid) {
975 return scalar Email::Valid->address($address);
978 # less robust/correct than the monster regexp in Email::Valid,
979 # but still does a 99% job, and one less dependency
980 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
984 sub extract_valid_address_or_die {
986 $address = extract_valid_address($address);
987 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
992 sub validate_address {
994 while (!extract_valid_address($address)) {
995 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
996 # TRANSLATORS: Make sure to include [q] [d] [e] in your
997 # translation. The program will only accept English input
999 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1000 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1005 cleanup_compose_files();
1008 $address = ask("$to_whom ",
1010 valid_re => qr/\@.*\./, confirm_only => 1);
1015 sub validate_address_list {
1016 return (grep { defined $_ }
1017 map { validate_address($_) } @_);
1020 # Usually don't need to change anything below here.
1022 # we make a "fake" message id by taking the current number
1023 # of seconds since the beginning of Unix time and tacking on
1024 # a random number to the end, in case we are called quicker than
1025 # 1 second since the last time we were called.
1027 # We'll setup a template for the message id, using the "from" address:
1029 my ($message_id_stamp, $message_id_serial);
1030 sub make_message_id {
1032 if (!defined $message_id_stamp) {
1033 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1034 $message_id_serial = 0;
1036 $message_id_serial++;
1037 $uniq = "$message_id_stamp-$message_id_serial";
1040 for ($sender, $repocommitter, $repoauthor) {
1041 $du_part = extract_valid_address(sanitize_address($_));
1042 last if (defined $du_part and $du_part ne '');
1044 if (not defined $du_part or $du_part eq '') {
1045 require Sys::Hostname;
1046 $du_part = 'user@' . Sys::Hostname::hostname();
1048 my $message_id_template = "<%s-%s>";
1049 $message_id = sprintf($message_id_template, $uniq, $du_part);
1050 #print "new message id = $message_id\n"; # Was useful for debugging
1055 $time = time - scalar $#files;
1057 sub unquote_rfc2047 {
1060 my $sep = qr/[ \t]+/;
1061 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1062 my @words = split $sep, $&;
1064 m/$re_encoded_word/;
1068 if ($encoding eq 'q' || $encoding eq 'Q') {
1071 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1073 # other encodings not supported yet
1078 return wantarray ? ($_, $charset) : $_;
1083 my $encoding = shift || 'UTF-8';
1084 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1085 s/(.*)/=\?$encoding\?q\?$1\?=/;
1089 sub is_rfc2047_quoted {
1092 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1095 sub subject_needs_rfc2047_quoting {
1098 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1102 local $subject = shift;
1103 my $encoding = shift || 'UTF-8';
1105 if (subject_needs_rfc2047_quoting($subject)) {
1106 return quote_rfc2047($subject, $encoding);
1111 # use the simplest quoting being able to handle the recipient
1112 sub sanitize_address {
1113 my ($recipient) = @_;
1115 # remove garbage after email address
1116 $recipient =~ s/(.*>).*$/$1/;
1118 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1120 if (not $recipient_name) {
1124 # if recipient_name is already quoted, do nothing
1125 if (is_rfc2047_quoted($recipient_name)) {
1129 # remove non-escaped quotes
1130 $recipient_name =~ s/(^|[^\\])"/$1/g;
1132 # rfc2047 is needed if a non-ascii char is included
1133 if ($recipient_name =~ /[^[:ascii:]]/) {
1134 $recipient_name = quote_rfc2047($recipient_name);
1137 # double quotes are needed if specials or CTLs are included
1138 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1139 $recipient_name =~ s/([\\\r])/\\$1/g;
1140 $recipient_name = qq["$recipient_name"];
1143 return "$recipient_name $recipient_addr";
1147 sub strip_garbage_one_address {
1150 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1151 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1152 # Foo Bar <foobar@example.com> [possibly garbage here]
1155 if ($addr =~ /^(<[^>]*>).*/) {
1156 # <foo@example.com> [possibly garbage here]
1157 # if garbage contains other addresses, they are ignored.
1160 if ($addr =~ /^([^"#,\s]*)/) {
1161 # address without quoting: remove anything after the address
1167 sub sanitize_address_list {
1168 return (map { sanitize_address($_) } @_);
1171 sub process_address_list {
1172 my @addr_list = map { parse_address_line($_) } @_;
1173 @addr_list = expand_aliases(@addr_list);
1174 @addr_list = sanitize_address_list(@addr_list);
1175 @addr_list = validate_address_list(@addr_list);
1179 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1181 # Tightly configured MTAa require that a caller sends a real DNS
1182 # domain name that corresponds the IP address in the HELO/EHLO
1183 # handshake. This is used to verify the connection and prevent
1184 # spammers from trying to hide their identity. If the DNS and IP don't
1185 # match, the receiveing MTA may deny the connection.
1187 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1189 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1190 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1192 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1193 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1197 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1200 sub maildomain_net {
1203 my $domain = Net::Domain::domainname();
1204 $maildomain = $domain if valid_fqdn($domain);
1209 sub maildomain_mta {
1212 for my $host (qw(mailhost localhost)) {
1213 my $smtp = Net::SMTP->new($host);
1214 if (defined $smtp) {
1215 my $domain = $smtp->domain;
1218 $maildomain = $domain if valid_fqdn($domain);
1220 last if $maildomain;
1228 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1231 sub smtp_host_string {
1232 if (defined $smtp_server_port) {
1233 return "$smtp_server:$smtp_server_port";
1235 return $smtp_server;
1239 # Returns 1 if authentication succeeded or was not necessary
1240 # (smtp_user was not specified), and 0 otherwise.
1242 sub smtp_auth_maybe {
1243 if (!defined $smtp_authuser || $auth) {
1247 # Workaround AUTH PLAIN/LOGIN interaction defect
1248 # with Authen::SASL::Cyrus
1250 require Authen::SASL;
1251 Authen::SASL->import(qw(Perl));
1254 # Check mechanism naming as defined in:
1255 # https://tools.ietf.org/html/rfc4422#page-8
1256 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1257 die "invalid smtp auth: '${smtp_auth}'";
1260 # TODO: Authentication may fail not because credentials were
1261 # invalid but due to other reasons, in which we should not
1262 # reject credentials.
1263 $auth = Git::credential({
1264 'protocol' => 'smtp',
1265 'host' => smtp_host_string(),
1266 'username' => $smtp_authuser,
1267 # if there's no password, "git credential fill" will
1268 # give us one, otherwise it'll just pass this one.
1269 'password' => $smtp_authpass
1274 my $sasl = Authen::SASL->new(
1275 mechanism => $smtp_auth,
1277 user => $cred->{'username'},
1278 pass => $cred->{'password'},
1279 authname => $cred->{'username'},
1283 return !!$smtp->auth($sasl);
1286 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1292 sub ssl_verify_params {
1294 require IO::Socket::SSL;
1295 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1298 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1302 if (!defined $smtp_ssl_cert_path) {
1303 # use the OpenSSL defaults
1304 return (SSL_verify_mode => SSL_VERIFY_PEER());
1307 if ($smtp_ssl_cert_path eq "") {
1308 return (SSL_verify_mode => SSL_VERIFY_NONE());
1309 } elsif (-d $smtp_ssl_cert_path) {
1310 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1311 SSL_ca_path => $smtp_ssl_cert_path);
1312 } elsif (-f $smtp_ssl_cert_path) {
1313 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1314 SSL_ca_file => $smtp_ssl_cert_path);
1316 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1320 sub file_name_is_absolute {
1323 # msys does not grok DOS drive-prefixes
1324 if ($^O eq 'msys') {
1325 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1328 require File::Spec::Functions;
1329 return File::Spec::Functions::file_name_is_absolute($path);
1332 # Prepares the email, then asks the user what to do.
1334 # If the user chooses to send the email, it's sent and 1 is returned.
1335 # If the user chooses not to send the email, 0 is returned.
1336 # If the user decides they want to make further edits, -1 is returned and the
1337 # caller is expected to call send_message again after the edits are performed.
1339 # If an error occurs sending the email, this just dies.
1342 my @recipients = unique_email_list(@to);
1343 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1344 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1347 my $to = join (",\n\t", @recipients);
1348 @recipients = unique_email_list(@recipients,@cc,@initial_bcc);
1349 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1350 my $date = format_2822_time($time++);
1351 my $gitversion = '@@GIT_VERSION@@';
1352 if ($gitversion =~ m/..GIT_VERSION../) {
1353 $gitversion = Git::version();
1356 my $cc = join(",\n\t", unique_email_list(@cc));
1359 $ccline = "\nCc: $cc";
1361 make_message_id() unless defined($message_id);
1363 my $header = "From: $sender
1367 Message-Id: $message_id
1370 $header .= "X-Mailer: git-send-email $gitversion\n";
1374 $header .= "In-Reply-To: $in_reply_to\n";
1375 $header .= "References: $references\n";
1378 $header .= "Reply-To: $reply_to\n";
1381 $header .= join("\n", @xh) . "\n";
1384 my @sendmail_parameters = ('-i', @recipients);
1385 my $raw_from = $sender;
1386 if (defined $envelope_sender && $envelope_sender ne "auto") {
1387 $raw_from = $envelope_sender;
1389 $raw_from = extract_valid_address($raw_from);
1390 unshift (@sendmail_parameters,
1391 '-f', $raw_from) if(defined $envelope_sender);
1393 if ($needs_confirm && !$dry_run) {
1394 print "\n$header\n";
1395 if ($needs_confirm eq "inform") {
1396 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1397 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1399 The Cc list above has been expanded by additional
1400 addresses found in the patch commit message. By default
1401 send-email prompts before sending whenever this occurs.
1402 This behavior is controlled by the sendemail.confirm
1403 configuration setting.
1405 For additional information, run 'git send-email --help'.
1406 To retain the current behavior, but squelch this message,
1407 run 'git config --global sendemail.confirm auto'.
1411 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1412 # translation. The program will only accept English input
1414 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1415 valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1416 default => $ask_default);
1417 die __("Send this email reply required") unless defined $_;
1423 cleanup_compose_files();
1430 unshift (@sendmail_parameters, @smtp_server_options);
1433 # We don't want to send the email.
1434 } elsif (file_name_is_absolute($smtp_server)) {
1435 my $pid = open my $sm, '|-';
1436 defined $pid or die $!;
1438 exec($smtp_server, @sendmail_parameters) or die $!;
1440 print $sm "$header\n$message";
1441 close $sm or die $!;
1444 if (!defined $smtp_server) {
1445 die __("The required SMTP server is not properly defined.")
1449 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1450 $smtp_domain ||= maildomain();
1452 if ($smtp_encryption eq 'ssl') {
1453 $smtp_server_port ||= 465; # ssmtp
1454 require IO::Socket::SSL;
1456 # Suppress "variable accessed once" warning.
1459 $IO::Socket::SSL::DEBUG = 1;
1462 # Net::SMTP::SSL->new() does not forward any SSL options
1463 IO::Socket::SSL::set_client_defaults(
1464 ssl_verify_params());
1466 if ($use_net_smtp_ssl) {
1467 require Net::SMTP::SSL;
1468 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1469 Hello => $smtp_domain,
1470 Port => $smtp_server_port,
1471 Debug => $debug_net_smtp);
1474 $smtp ||= Net::SMTP->new($smtp_server,
1475 Hello => $smtp_domain,
1476 Port => $smtp_server_port,
1477 Debug => $debug_net_smtp,
1482 $smtp_server_port ||= 25;
1483 $smtp ||= Net::SMTP->new($smtp_server,
1484 Hello => $smtp_domain,
1485 Debug => $debug_net_smtp,
1486 Port => $smtp_server_port);
1487 if ($smtp_encryption eq 'tls' && $smtp) {
1488 if ($use_net_smtp_ssl) {
1489 $smtp->command('STARTTLS');
1491 if ($smtp->code != 220) {
1492 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1494 require Net::SMTP::SSL;
1495 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1496 ssl_verify_params())
1497 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1500 $smtp->starttls(ssl_verify_params())
1501 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1503 $smtp_encryption = '';
1504 # Send EHLO again to receive fresh
1505 # supported commands
1506 $smtp->hello($smtp_domain);
1511 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1512 " VALUES: server=$smtp_server ",
1513 "encryption=$smtp_encryption ",
1514 "hello=$smtp_domain",
1515 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1518 smtp_auth_maybe or die $smtp->message;
1520 $smtp->mail( $raw_from ) or die $smtp->message;
1521 $smtp->to( @recipients ) or die $smtp->message;
1522 $smtp->data or die $smtp->message;
1523 $smtp->datasend("$header\n") or die $smtp->message;
1524 my @lines = split /^/, $message;
1525 foreach my $line (@lines) {
1526 $smtp->datasend("$line") or die $smtp->message;
1528 $smtp->dataend() or die $smtp->message;
1529 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1532 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1534 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1535 if (!file_name_is_absolute($smtp_server)) {
1536 print "Server: $smtp_server\n";
1537 print "MAIL FROM:<$raw_from>\n";
1538 foreach my $entry (@recipients) {
1539 print "RCPT TO:<$entry>\n";
1542 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1544 print $header, "\n";
1546 print __("Result: "), $smtp->code, ' ',
1547 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1549 print __("Result: OK\n");
1556 $in_reply_to = $initial_in_reply_to;
1557 $references = $initial_in_reply_to || '';
1558 $subject = $initial_subject;
1561 # Prepares the email, prompts the user, sends it out
1562 # Returns 0 if an edit was done and the function should be called again, or 1
1567 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1570 my $sauthor = undef;
1571 my $author_encoding;
1572 my $has_content_type;
1575 my $has_mime_version;
1579 my $input_format = undef;
1583 # First unfold multiline header fields
1586 if (/^\s+\S/ and @header) {
1587 chomp($header[$#header]);
1589 $header[$#header] .= $_;
1594 # Now parse the header
1597 $input_format = 'mbox';
1601 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1602 $input_format = 'mbox';
1605 if (defined $input_format && $input_format eq 'mbox') {
1606 if (/^Subject:\s+(.*)$/i) {
1609 elsif (/^From:\s+(.*)$/i) {
1610 ($author, $author_encoding) = unquote_rfc2047($1);
1611 $sauthor = sanitize_address($author);
1612 next if $suppress_cc{'author'};
1613 next if $suppress_cc{'self'} and $sauthor eq $sender;
1614 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1615 $1, $_) unless $quiet;
1618 elsif (/^To:\s+(.*)$/i) {
1619 foreach my $addr (parse_address_line($1)) {
1620 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1621 $addr, $_) unless $quiet;
1625 elsif (/^Cc:\s+(.*)$/i) {
1626 foreach my $addr (parse_address_line($1)) {
1627 my $qaddr = unquote_rfc2047($addr);
1628 my $saddr = sanitize_address($qaddr);
1629 if ($saddr eq $sender) {
1630 next if ($suppress_cc{'self'});
1632 next if ($suppress_cc{'cc'});
1634 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1635 $addr, $_) unless $quiet;
1639 elsif (/^Content-type:/i) {
1640 $has_content_type = 1;
1641 if (/charset="?([^ "]+)/) {
1642 $body_encoding = $1;
1646 elsif (/^MIME-Version/i) {
1647 $has_mime_version = 1;
1650 elsif (/^Message-Id: (.*)/i) {
1653 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1654 $xfer_encoding = $1 if not defined $xfer_encoding;
1656 elsif (/^In-Reply-To: (.*)/i) {
1659 elsif (/^References: (.*)/i) {
1662 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1666 # In the traditional
1667 # "send lots of email" format,
1670 # So let's support that, too.
1671 $input_format = 'lots';
1672 if (@cc == 0 && !$suppress_cc{'cc'}) {
1673 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1674 $_, $_) unless $quiet;
1676 } elsif (!defined $subject) {
1681 # Now parse the message body
1684 if (/^(Signed-off-by|Cc): (.*)/i) {
1686 my ($what, $c) = ($1, $2);
1687 # strip garbage for the address we'll use:
1688 $c = strip_garbage_one_address($c);
1689 # sanitize a bit more to decide whether to suppress the address:
1690 my $sc = sanitize_address($c);
1691 if ($sc eq $sender) {
1692 next if ($suppress_cc{'self'});
1694 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1695 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1698 printf(__("(body) Adding cc: %s from line '%s'\n"),
1699 $c, $_) unless $quiet;
1704 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1706 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1707 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1709 if ($broken_encoding{$t} && !$has_content_type) {
1710 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1711 $has_content_type = 1;
1712 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1713 $body_encoding = $auto_8bit_encoding;
1716 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1717 $subject = quote_subject($subject, $auto_8bit_encoding);
1720 if (defined $sauthor and $sauthor ne $sender) {
1721 $message = "From: $author\n\n$message";
1722 if (defined $author_encoding) {
1723 if ($has_content_type) {
1724 if ($body_encoding eq $author_encoding) {
1725 # ok, we already have the right encoding
1728 # uh oh, we should re-encode
1732 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1733 $has_content_type = 1;
1735 "Content-Type: text/plain; charset=$author_encoding";
1739 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1740 ($message, $xfer_encoding) = apply_transfer_encoding(
1741 $message, $xfer_encoding, $target_xfer_encoding);
1742 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1743 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1746 $confirm eq "always" or
1747 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1748 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1749 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1751 @to = process_address_list(@to);
1752 @cc = process_address_list(@cc);
1754 @to = (@initial_to, @to);
1755 @cc = (@initial_cc, @cc);
1757 if ($message_num == 1) {
1758 if (defined $cover_cc and $cover_cc) {
1761 if (defined $cover_to and $cover_to) {
1766 my $message_was_sent = send_message();
1767 if ($message_was_sent == -1) {
1772 # set up for the next message
1773 if ($thread && $message_was_sent &&
1774 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1775 $message_num == 1)) {
1776 $in_reply_to = $message_id;
1777 if (length $references > 0) {
1778 $references .= "\n $message_id";
1780 $references = "$message_id";
1783 $message_id = undef;
1785 if (defined $batch_size && $num_sent == $batch_size) {
1787 $smtp->quit if defined $smtp;
1790 sleep($relogin_delay) if defined $relogin_delay;
1796 foreach my $t (@files) {
1797 while (!process_file($t)) {
1798 # user edited the file
1802 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1803 # and return a results array
1804 sub recipients_cmd {
1805 my ($prefix, $what, $cmd, $file) = @_;
1808 open my $fh, "-|", "$cmd \Q$file\E"
1809 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1810 while (my $address = <$fh>) {
1811 $address =~ s/^\s*//g;
1812 $address =~ s/\s*$//g;
1813 $address = sanitize_address($address);
1814 next if ($address eq $sender and $suppress_cc{'self'});
1815 push @addresses, $address;
1816 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1817 $prefix, $what, $address, $cmd) unless $quiet;
1820 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1824 cleanup_compose_files();
1826 sub cleanup_compose_files {
1827 unlink($compose_filename, $compose_filename . ".final") if $compose;
1830 $smtp->quit if $smtp;
1832 sub apply_transfer_encoding {
1833 my $message = shift;
1837 return $message if ($from eq $to and $from ne '7bit');
1839 require MIME::QuotedPrint;
1840 require MIME::Base64;
1842 $message = MIME::QuotedPrint::decode($message)
1843 if ($from eq 'quoted-printable');
1844 $message = MIME::Base64::decode($message)
1845 if ($from eq 'base64');
1847 $to = ($message =~ /.{999,}/) ? 'quoted-printable' : '8bit'
1850 die __("cannot send message as 7bit")
1851 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1852 return ($message, $to)
1853 if ($to eq '7bit' or $to eq '8bit');
1854 return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
1855 if ($to eq 'quoted-printable');
1856 return (MIME::Base64::encode($message, "\n"), $to)
1857 if ($to eq 'base64');
1858 die __("invalid transfer encoding");
1861 sub unique_email_list {
1865 foreach my $entry (@_) {
1866 my $clean = extract_valid_address_or_die($entry);
1867 $seen{$clean} ||= 0;
1868 next if $seen{$clean}++;
1869 push @emails, $entry;
1874 sub validate_patch {
1875 my ($fn, $xfer_encoding) = @_;
1878 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1879 'sendemail-validate');
1881 if (-x $validate_hook) {
1882 my $target = abs_path($fn);
1883 # The hook needs a correct cwd and GIT_DIR.
1884 my $cwd_save = cwd();
1885 chdir($repo->wc_path() or $repo->repo_path())
1886 or die("chdir: $!");
1887 local $ENV{"GIT_DIR"} = $repo->repo_path();
1888 $hook_error = "rejected by sendemail-validate hook"
1889 if system($validate_hook, $target);
1890 chdir($cwd_save) or die("chdir: $!");
1892 return $hook_error if $hook_error;
1895 # Any long lines will be automatically fixed if we use a suitable transfer
1897 unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
1898 open(my $fh, '<', $fn)
1899 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1900 while (my $line = <$fh>) {
1901 if (length($line) > 998) {
1902 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1910 my ($last, $lastlen, $file, $known_suffix) = @_;
1911 my ($suffix, $skip);
1914 if (defined $last &&
1915 ($lastlen < length($file)) &&
1916 (substr($file, 0, $lastlen) eq $last) &&
1917 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1918 if (defined $known_suffix && $suffix eq $known_suffix) {
1919 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1922 # TRANSLATORS: please keep "[y|N]" as is.
1923 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1924 valid_re => qr/^(?:y|n)/i,
1926 $skip = ($answer ne 'y');
1928 $known_suffix = $suffix;
1932 return ($skip, $known_suffix);
1935 sub handle_backup_files {
1937 my ($last, $lastlen, $known_suffix, $skip, @result);
1938 for my $file (@file) {
1939 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1940 $file, $known_suffix);
1941 push @result, $file unless $skip;
1943 $lastlen = length($file);
1948 sub file_has_nonascii {
1950 open(my $fh, '<', $fn)
1951 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1952 while (my $line = <$fh>) {
1953 return 1 if $line =~ /[^[:ascii:]]/;
1958 sub body_or_subject_has_nonascii {
1960 open(my $fh, '<', $fn)
1961 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1962 while (my $line = <$fh>) {
1963 last if $line =~ /^$/;
1964 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1966 while (my $line = <$fh>) {
1967 return 1 if $line =~ /[^[:ascii:]]/;