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 --in-reply-to <str> * Email "In-Reply-To:"
63 --[no-]xmailer * Add "X-Mailer:" header (default).
64 --[no-]annotate * Review each patch that will be sent in an editor.
65 --compose * Open an editor for introduction.
66 --compose-encoding <str> * Encoding to assume for introduction.
67 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
68 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
71 --envelope-sender <str> * Email envelope sender.
72 --smtp-server <str:int> * Outgoing SMTP server to use. The port
73 is optional. Default 'localhost'.
74 --smtp-server-option <str> * Outgoing SMTP server option to use.
75 --smtp-server-port <int> * Outgoing SMTP server port.
76 --smtp-user <str> * Username for SMTP-AUTH.
77 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
78 --smtp-encryption <str> * tls or ssl; anything else disables.
79 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
80 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
81 Pass an empty string to disable certificate
83 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
84 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms.
85 This setting forces to use one of the listed mechanisms.
86 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
88 --batch-size <int> * send max <int> message per connection.
89 --relogin-delay <int> * delay <int> seconds between two successive login.
90 This option can only be used with --batch-size
93 --identity <str> * Use the sendemail.<id> options.
94 --to-cmd <str> * Email To: via `<str> \$patch_path`
95 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
96 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, all.
97 --[no-]cc-cover * Email Cc: addresses in the cover letter.
98 --[no-]to-cover * Email To: addresses in the cover letter.
99 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
100 --[no-]suppress-from * Send to self. Default off.
101 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
102 --[no-]thread * Use In-Reply-To: field. Default on.
105 --confirm <str> * Confirm recipients before sending;
106 auto, cc, compose, always, or never.
107 --quiet * Output one line of info per email.
108 --dry-run * Don't actually send the emails.
109 --[no-]validate * Perform patch sanity checks. Default on.
110 --[no-]format-patch * understand any non optional arguments as
111 `git format-patch` ones.
112 --force * Send even if safety checks would prevent it.
115 --dump-aliases * Dump configured aliases and exit.
121 # most mail servers generate the Date: header, but not all...
122 sub format_2822_time
{
124 my @localtm = localtime($time);
125 my @gmttm = gmtime($time);
126 my $localmin = $localtm[1] + $localtm[2] * 60;
127 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
128 if ($localtm[0] != $gmttm[0]) {
129 die __
("local zone differs from GMT by a non-minute interval\n");
131 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
133 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
135 } elsif ($gmttm[6] != $localtm[6]) {
136 die __
("local time offset greater than or equal to 24 hours\n");
138 my $offset = $localmin - $gmtmin;
139 my $offhour = $offset / 60;
140 my $offmin = abs($offset % 60);
141 if (abs($offhour) >= 24) {
142 die __
("local time offset greater than or equal to 24 hours\n");
145 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
146 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
148 qw(Jan Feb Mar Apr May Jun
149 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
154 ($offset >= 0) ?
'+' : '-',
160 my $have_email_valid = eval { require Email
::Valid
; 1 };
165 # Regexes for RFC 2047 productions.
166 my $re_token = qr/[^][()<>@,;:\\"\/?
.= \000-\037\177-\377]+/;
167 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
168 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
170 # Variables we fill in automatically, or via prompting:
171 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
172 $initial_reply_to,$initial_subject,@files,
173 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
178 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
180 my $repo = eval { Git
->repository() };
181 my @repo = $repo ?
($repo) : ();
183 $ENV{"GIT_SEND_EMAIL_NOTTY"}
184 ? new Term
::ReadLine
'git-send-email', \
*STDIN
, \
*STDOUT
185 : new Term
::ReadLine
'git-send-email';
188 $term = new FakeTerm
"$@: going non-interactive";
191 # Behavior modification variables
192 my ($quiet, $dry_run) = (0, 0);
194 my $compose_filename;
196 my $dump_aliases = 0;
198 # Handle interactive edition of files.
203 if (!defined($editor)) {
204 $editor = Git
::command_oneline
('var', 'GIT_EDITOR');
206 if (defined($multiedit) && !$multiedit) {
208 system('sh', '-c', $editor.' "$@"', $editor, $_);
209 if (($?
& 127) || ($?
>> 8)) {
210 die(__
("the editor exited uncleanly, aborting everything"));
214 system('sh', '-c', $editor.' "$@"', $editor, @_);
215 if (($?
& 127) || ($?
>> 8)) {
216 die(__
("the editor exited uncleanly, aborting everything"));
221 # Variables with corresponding config settings
222 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
223 my ($cover_cc, $cover_to);
224 my ($to_cmd, $cc_cmd);
225 my ($smtp_server, $smtp_server_port, @smtp_server_options);
226 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
227 my ($batch_size, $relogin_delay);
228 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
229 my ($validate, $confirm);
231 my ($auto_8bit_encoding);
232 my ($compose_encoding);
233 my ($target_xfer_encoding);
235 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
237 my %config_bool_settings = (
238 "thread" => [\
$thread, 1],
239 "chainreplyto" => [\
$chain_reply_to, 0],
240 "suppressfrom" => [\
$suppress_from, undef],
241 "signedoffbycc" => [\
$signed_off_by_cc, undef],
242 "cccover" => [\
$cover_cc, undef],
243 "tocover" => [\
$cover_to, undef],
244 "signedoffcc" => [\
$signed_off_by_cc, undef], # Deprecated
245 "validate" => [\
$validate, 1],
246 "multiedit" => [\
$multiedit, undef],
247 "annotate" => [\
$annotate, undef],
248 "xmailer" => [\
$use_xmailer, 1]
251 my %config_settings = (
252 "smtpserver" => \
$smtp_server,
253 "smtpserverport" => \
$smtp_server_port,
254 "smtpserveroption" => \
@smtp_server_options,
255 "smtpuser" => \
$smtp_authuser,
256 "smtppass" => \
$smtp_authpass,
257 "smtpdomain" => \
$smtp_domain,
258 "smtpauth" => \
$smtp_auth,
259 "smtpbatchsize" => \
$batch_size,
260 "smtprelogindelay" => \
$relogin_delay,
261 "to" => \
@initial_to,
263 "cc" => \
@initial_cc,
265 "aliasfiletype" => \
$aliasfiletype,
267 "suppresscc" => \
@suppress_cc,
268 "envelopesender" => \
$envelope_sender,
269 "confirm" => \
$confirm,
271 "assume8bitencoding" => \
$auto_8bit_encoding,
272 "composeencoding" => \
$compose_encoding,
273 "transferencoding" => \
$target_xfer_encoding,
276 my %config_path_settings = (
277 "aliasesfile" => \
@alias_files,
278 "smtpsslcertpath" => \
$smtp_ssl_cert_path,
281 # Handle Uncouth Termination
285 print color
("reset"), "\n";
287 # SMTP password masked
290 # tmp files from --compose
291 if (defined $compose_filename) {
292 if (-e
$compose_filename) {
293 printf __
("'%s' contains an intermediate version ".
294 "of the email you were composing.\n"),
297 if (-e
($compose_filename . ".final")) {
298 printf __
("'%s.final' contains the composed email.\n"),
306 $SIG{TERM
} = \
&signal_handler
;
307 $SIG{INT
} = \
&signal_handler
;
309 # Begin by accumulating all the variables (defined above), that we will end up
310 # needing, first, from the command line:
313 my $rc = GetOptions
("h" => \
$help,
314 "dump-aliases" => \
$dump_aliases);
316 die __
("--dump-aliases incompatible with other options\n")
317 if !$help and $dump_aliases and @ARGV;
319 "sender|from=s" => \
$sender,
320 "in-reply-to=s" => \
$initial_reply_to,
321 "subject=s" => \
$initial_subject,
322 "to=s" => \
@initial_to,
323 "to-cmd=s" => \
$to_cmd,
325 "cc=s" => \
@initial_cc,
327 "bcc=s" => \
@bcclist,
328 "no-bcc" => \
$no_bcc,
329 "chain-reply-to!" => \
$chain_reply_to,
330 "no-chain-reply-to" => sub {$chain_reply_to = 0},
331 "smtp-server=s" => \
$smtp_server,
332 "smtp-server-option=s" => \
@smtp_server_options,
333 "smtp-server-port=s" => \
$smtp_server_port,
334 "smtp-user=s" => \
$smtp_authuser,
335 "smtp-pass:s" => \
$smtp_authpass,
336 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
337 "smtp-encryption=s" => \
$smtp_encryption,
338 "smtp-ssl-cert-path=s" => \
$smtp_ssl_cert_path,
339 "smtp-debug:i" => \
$debug_net_smtp,
340 "smtp-domain:s" => \
$smtp_domain,
341 "smtp-auth=s" => \
$smtp_auth,
342 "identity=s" => \
$identity,
343 "annotate!" => \
$annotate,
344 "no-annotate" => sub {$annotate = 0},
345 "compose" => \
$compose,
347 "cc-cmd=s" => \
$cc_cmd,
348 "suppress-from!" => \
$suppress_from,
349 "no-suppress-from" => sub {$suppress_from = 0},
350 "suppress-cc=s" => \
@suppress_cc,
351 "signed-off-cc|signed-off-by-cc!" => \
$signed_off_by_cc,
352 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
353 "cc-cover|cc-cover!" => \
$cover_cc,
354 "no-cc-cover" => sub {$cover_cc = 0},
355 "to-cover|to-cover!" => \
$cover_to,
356 "no-to-cover" => sub {$cover_to = 0},
357 "confirm=s" => \
$confirm,
358 "dry-run" => \
$dry_run,
359 "envelope-sender=s" => \
$envelope_sender,
360 "thread!" => \
$thread,
361 "no-thread" => sub {$thread = 0},
362 "validate!" => \
$validate,
363 "no-validate" => sub {$validate = 0},
364 "transfer-encoding=s" => \
$target_xfer_encoding,
365 "format-patch!" => \
$format_patch,
366 "no-format-patch" => sub {$format_patch = 0},
367 "8bit-encoding=s" => \
$auto_8bit_encoding,
368 "compose-encoding=s" => \
$compose_encoding,
370 "xmailer!" => \
$use_xmailer,
371 "no-xmailer" => sub {$use_xmailer = 0},
372 "batch-size=i" => \
$batch_size,
373 "relogin-delay=i" => \
$relogin_delay,
381 die __
("Cannot run git format-patch from outside a repository\n")
382 if $format_patch and not $repo;
384 # Now, let's fill any that aren't set in with defaults:
389 foreach my $setting (keys %config_bool_settings) {
390 my $target = $config_bool_settings{$setting}->[0];
391 $$target = Git
::config_bool
(@repo, "$prefix.$setting") unless (defined $$target);
394 foreach my $setting (keys %config_path_settings) {
395 my $target = $config_path_settings{$setting};
396 if (ref($target) eq "ARRAY") {
398 my @values = Git
::config_path
(@repo, "$prefix.$setting");
399 @
$target = @values if (@values && defined $values[0]);
403 $$target = Git
::config_path
(@repo, "$prefix.$setting") unless (defined $$target);
407 foreach my $setting (keys %config_settings) {
408 my $target = $config_settings{$setting};
409 next if $setting eq "to" and defined $no_to;
410 next if $setting eq "cc" and defined $no_cc;
411 next if $setting eq "bcc" and defined $no_bcc;
412 if (ref($target) eq "ARRAY") {
414 my @values = Git
::config
(@repo, "$prefix.$setting");
415 @
$target = @values if (@values && defined $values[0]);
419 $$target = Git
::config
(@repo, "$prefix.$setting") unless (defined $$target);
423 if (!defined $smtp_encryption) {
424 my $enc = Git
::config
(@repo, "$prefix.smtpencryption");
426 $smtp_encryption = $enc;
427 } elsif (Git
::config_bool
(@repo, "$prefix.smtpssl")) {
428 $smtp_encryption = 'ssl';
433 # read configuration from [sendemail "$identity"], fall back on [sendemail]
434 $identity = Git
::config
(@repo, "sendemail.identity") unless (defined $identity);
435 read_config
("sendemail.$identity") if (defined $identity);
436 read_config
("sendemail");
438 # fall back on builtin bool defaults
439 foreach my $setting (values %config_bool_settings) {
440 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
443 # 'default' encryption is none -- this only prevents a warning
444 $smtp_encryption = '' unless (defined $smtp_encryption);
446 # Set CC suppressions
449 foreach my $entry (@suppress_cc) {
450 die sprintf(__
("Unknown --suppress-cc field: '%s'\n"), $entry)
451 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
452 $suppress_cc{$entry} = 1;
456 if ($suppress_cc{'all'}) {
457 foreach my $entry (qw
(cccmd cc author self sob body bodycc
)) {
458 $suppress_cc{$entry} = 1;
460 delete $suppress_cc{'all'};
463 # If explicit old-style ones are specified, they trump --suppress-cc.
464 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
465 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
467 if ($suppress_cc{'body'}) {
468 foreach my $entry (qw
(sob bodycc
)) {
469 $suppress_cc{$entry} = 1;
471 delete $suppress_cc{'body'};
474 # Set confirm's default value
475 my $confirm_unconfigured = !defined $confirm;
476 if ($confirm_unconfigured) {
477 $confirm = scalar %suppress_cc ?
'compose' : 'auto';
479 die sprintf(__
("Unknown --confirm setting: '%s'\n"), $confirm)
480 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
482 # Debugging, print out the suppressions.
484 print "suppressions:\n";
485 foreach my $entry (keys %suppress_cc) {
486 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
490 my ($repoauthor, $repocommitter);
491 ($repoauthor) = Git
::ident_person
(@repo, 'author');
492 ($repocommitter) = Git
::ident_person
(@repo, 'committer');
494 sub parse_address_line
{
495 return map { $_->format } Mail
::Address
->parse($_[0]);
499 return quotewords
('\s*,\s*', 1, @_);
504 sub parse_sendmail_alias
{
507 printf STDERR __
("warning: sendmail alias with quotes is not supported: %s\n"), $_;
508 } elsif (/:include:/) {
509 printf STDERR __
("warning: `:include:` not supported: %s\n"), $_;
511 printf STDERR __
("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
512 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
513 my ($alias, $addr) = ($1, $2);
514 $aliases{$alias} = [ split_addrs
($addr) ];
516 printf STDERR __
("warning: sendmail line is not recognized: %s\n"), $_;
520 sub parse_sendmail_aliases
{
525 next if /^\s*$/ || /^\s*#/;
526 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
527 parse_sendmail_alias
($s) if $s;
530 $s =~ s/\\$//; # silently tolerate stray '\' on last line
531 parse_sendmail_alias
($s) if $s;
535 # multiline formats can be supported in the future
536 mutt
=> sub { my $fh = shift; while (<$fh>) {
537 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
538 my ($alias, $addr) = ($1, $2);
539 $addr =~ s/#.*$//; # mutt allows # comments
540 # commas delimit multiple addresses
541 my @addr = split_addrs
($addr);
543 # quotes may be escaped in the file,
544 # unescape them so we do not double-escape them later.
545 s/\\"/"/g foreach @addr;
546 $aliases{$alias} = \
@addr
548 mailrc
=> sub { my $fh = shift; while (<$fh>) {
549 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
550 # spaces delimit multiple addresses
551 $aliases{$1} = [ quotewords
('\s+', 0, $2) ];
553 pine
=> sub { my $fh = shift; my $f='\t[^\t]*';
554 for (my $x = ''; defined($x); $x = $_) {
556 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
557 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
558 $aliases{$1} = [ split_addrs
($2) ];
560 elm
=> sub { my $fh = shift;
562 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
563 my ($alias, $addr) = ($1, $2);
564 $aliases{$alias} = [ split_addrs
($addr) ];
567 sendmail
=> \
&parse_sendmail_aliases
,
568 gnus
=> sub { my $fh = shift; while (<$fh>) {
569 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
570 $aliases{$1} = [ $2 ];
574 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
575 foreach my $file (@alias_files) {
576 open my $fh, '<', $file or die "opening $file: $!\n";
577 $parse_alias{$aliasfiletype}->($fh);
583 print "$_\n" for (sort keys %aliases);
587 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
588 # $f is a revision list specification to be passed to format-patch.
589 sub is_format_patch_arg
{
593 $repo->command('rev-parse', '--verify', '--quiet', $f);
594 if (defined($format_patch)) {
595 return $format_patch;
597 die sprintf(__
<<EOF, $f, $f);
598 File '%s' exists but it could also be the range of commits
599 to produce patches for. Please disambiguate by...
601 * Saying "./%s" if you mean a file; or
602 * Giving --format-patch option if you mean a range.
604 } catch Git
::Error
::Command with
{
605 # Not a valid revision. Treat it as a filename.
610 # Now that all the defaults are set, process the rest of the command line
611 # arguments and collect up the files that need to be processed.
613 while (defined(my $f = shift @ARGV)) {
615 push @rev_list_opts, "--", @ARGV;
617 } elsif (-d
$f and !is_format_patch_arg
($f)) {
619 or die sprintf(__
("Failed to opendir %s: %s"), $f, $!);
621 push @files, grep { -f
$_ } map { catfile
($f, $_) }
624 } elsif ((-f
$f or -p
$f) and !is_format_patch_arg
($f)) {
627 push @rev_list_opts, $f;
631 if (@rev_list_opts) {
632 die __
("Cannot run git format-patch from outside a repository\n")
634 push @files, $repo->command('format-patch', '-o', tempdir
(CLEANUP
=> 1), @rev_list_opts);
637 @files = handle_backup_files
(@files);
640 foreach my $f (@files) {
642 my $error = validate_patch
($f);
643 $error and die sprintf(__
("fatal: %s: %s\nwarning: no patches were sent\n"),
651 print $_,"\n" for (@files);
654 print STDERR __
("\nNo patch files specified!\n\n");
658 sub get_patch_subject
{
660 open (my $fh, '<', $fn);
661 while (my $line = <$fh>) {
662 next unless ($line =~ /^Subject: (.*)$/);
667 die sprintf(__
("No subject line in %s?"), $fn);
671 # Note that this does not need to be secure, but we will make a small
672 # effort to have it be unique
673 $compose_filename = ($repo ?
674 tempfile
(".gitsendemail.msg.XXXXXX", DIR
=> $repo->repo_path()) :
675 tempfile
(".gitsendemail.msg.XXXXXX", DIR
=> "."))[1];
676 open my $c, ">", $compose_filename
677 or die sprintf(__
("Failed to open for writing %s: %s"), $compose_filename, $!);
680 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
681 my $tpl_subject = $initial_subject || '';
682 my $tpl_reply_to = $initial_reply_to || '';
684 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
685 From $tpl_sender # This line is ignored.
687 Lines beginning in "GIT:" will be removed.
688 Consider including an overall diffstat or table of contents
689 for the patch you are writing.
691 Clear the body content if you don't wish to send a summary.
694 Subject: $tpl_subject
695 In-Reply-To: $tpl_reply_to
699 print $c get_patch_subject($f);
704 do_edit($compose_filename, @files);
706 do_edit($compose_filename);
709 open my $c2, ">", $compose_filename . ".final"
710 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
712 open $c, "<", $compose_filename
713 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
715 my $need_8bit_cte = file_has_nonascii($compose_filename);
717 my $summary_empty = 1;
718 if (!defined $compose_encoding) {
719 $compose_encoding = "UTF-8";
724 $summary_empty = 0 unless (/^\n$/);
727 if ($need_8bit_cte) {
728 print $c2 "MIME-Version: 1.0\n",
729 "Content-Type: text/plain; ",
730 "charset=$compose_encoding\n",
731 "Content-Transfer-Encoding: 8bit\n";
733 } elsif (/^MIME-Version:/i) {
735 } elsif (/^Subject:\s*(.+)\s*$/i) {
736 $initial_subject = $1;
737 my $subject = $initial_subject;
739 quote_subject($subject, $compose_encoding) .
741 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
742 $initial_reply_to = $1;
744 } elsif (/^From:\s*(.+)\s*$/i) {
747 } elsif (/^(?:To|Cc|Bcc):/i) {
748 print __("To/Cc/Bcc fields are not interpreted yet, they have been ignored\n");
756 if ($summary_empty) {
757 print __("Summary email is empty, skipping it\n");
760 } elsif ($annotate) {
765 my ($prompt, %arg) = @_;
766 my $valid_re = $arg{valid_re};
767 my $default = $arg{default};
768 my $confirm_only = $arg{confirm_only};
771 return defined $default ? $default : undef
772 unless defined $term->IN and defined fileno($term->IN) and
773 defined $term->OUT and defined fileno($term->OUT);
775 $resp = $term->readline($prompt);
776 if (!defined $resp) { # EOF
778 return defined $default ? $default : undef;
780 if ($resp eq '' and defined $default) {
783 if (!defined $valid_re or $resp =~ /$valid_re/) {
787 my $yesno = $term->readline(
788 # TRANSLATORS: please keep [y/N] as is.
789 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
790 if (defined $yesno && $yesno =~ /y/i) {
800 sub file_declares_8bit_cte {
802 open (my $fh, '<', $fn);
803 while (my $line = <$fh>) {
804 last if ($line =~ /^$/);
805 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
811 foreach my $f (@files) {
812 next unless (body_or_subject_has_nonascii($f)
813 && !file_declares_8bit_cte($f));
814 $broken_encoding{$f} = 1;
817 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
818 print __("The following files are 8bit, but do not declare " .
819 "a Content-Transfer-Encoding.\n");
820 foreach my $f (sort keys %broken_encoding) {
823 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
824 valid_re => qr/.{4}/, confirm_only => 1,
830 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
831 die sprintf(__("Refusing to send because the patch\n\t%s\n"
832 . "has the template subject '*** SUBJECT HERE ***'. "
833 . "Pass --force if you really want to send.\n"), $f);
838 if (defined $sender) {
839 $sender =~ s/^\s+|\s+$//g;
840 ($sender) = expand_aliases($sender);
842 $sender = $repoauthor || $repocommitter || '';
845 # $sender could be an already sanitized address
846 # (e.g. sendemail.from could be manually sanitized by user).
847 # But it's a no-op to run sanitize_address on an already sanitized address.
848 $sender = sanitize_address($sender);
850 my $to_whom = __("To whom should the emails be sent (if anyone)?");
852 if (!@initial_to && !defined $to_cmd) {
853 my $to = ask("$to_whom ",
855 valid_re => qr/\@.*\./, confirm_only => 1);
856 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
861 return map { expand_one_alias($_) } @_;
864 my %EXPANDED_ALIASES;
865 sub expand_one_alias {
867 if ($EXPANDED_ALIASES{$alias}) {
868 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
870 local $EXPANDED_ALIASES{$alias} = 1;
871 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
874 @initial_to = process_address_list(@initial_to);
875 @initial_cc = process_address_list(@initial_cc);
876 @bcclist = process_address_list(@bcclist);
878 if ($thread && !defined $initial_reply_to && $prompting) {
879 $initial_reply_to = ask(
880 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
882 valid_re => qr/\@.*\./, confirm_only => 1);
884 if (defined $initial_reply_to) {
885 $initial_reply_to =~ s/^\s*<?//;
886 $initial_reply_to =~ s/>?\s*$//;
887 $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
890 if (!defined $smtp_server) {
891 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
892 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH
};
893 foreach (@sendmail_paths) {
899 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
902 if ($compose && $compose > 0) {
903 @files = ($compose_filename . ".final", @files);
906 # Variables we set as part of the loop over files
907 our ($message_id, %mail, $subject, $reply_to, $references, $message,
908 $needs_confirm, $message_num, $ask_default);
910 sub extract_valid_address
{
912 my $local_part_regexp = qr/[^<>"\s@]+/;
913 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
915 # check for a local address:
916 return $address if ($address =~ /^($local_part_regexp)$/);
918 $address =~ s/^\s*<(.*)>\s*$/$1/;
919 if ($have_email_valid) {
920 return scalar Email
::Valid
->address($address);
923 # less robust/correct than the monster regexp in Email::Valid,
924 # but still does a 99% job, and one less dependency
925 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
929 sub extract_valid_address_or_die
{
931 $address = extract_valid_address
($address);
932 die sprintf(__
("error: unable to extract a valid address from: %s\n"), $address)
937 sub validate_address
{
939 while (!extract_valid_address
($address)) {
940 printf STDERR __
("error: unable to extract a valid address from: %s\n"), $address;
941 # TRANSLATORS: Make sure to include [q] [d] [e] in your
942 # translation. The program will only accept English input
944 $_ = ask
(__
("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
945 valid_re
=> qr/^(?:quit|q|drop|d|edit|e)/i,
950 cleanup_compose_files
();
953 $address = ask
("$to_whom ",
955 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
960 sub validate_address_list
{
961 return (grep { defined $_ }
962 map { validate_address
($_) } @_);
965 # Usually don't need to change anything below here.
967 # we make a "fake" message id by taking the current number
968 # of seconds since the beginning of Unix time and tacking on
969 # a random number to the end, in case we are called quicker than
970 # 1 second since the last time we were called.
972 # We'll setup a template for the message id, using the "from" address:
974 my ($message_id_stamp, $message_id_serial);
975 sub make_message_id
{
977 if (!defined $message_id_stamp) {
978 $message_id_stamp = strftime
("%Y%m%d%H%M%S.$$", gmtime(time));
979 $message_id_serial = 0;
981 $message_id_serial++;
982 $uniq = "$message_id_stamp-$message_id_serial";
985 for ($sender, $repocommitter, $repoauthor) {
986 $du_part = extract_valid_address
(sanitize_address
($_));
987 last if (defined $du_part and $du_part ne '');
989 if (not defined $du_part or $du_part eq '') {
990 require Sys
::Hostname
;
991 $du_part = 'user@' . Sys
::Hostname
::hostname
();
993 my $message_id_template = "<%s-%s>";
994 $message_id = sprintf($message_id_template, $uniq, $du_part);
995 #print "new message id = $message_id\n"; # Was useful for debugging
1000 $time = time - scalar $#files;
1002 sub unquote_rfc2047
{
1005 my $sep = qr/[ \t]+/;
1006 s
{$re_encoded_word(?
:$sep$re_encoded_word)*}{
1007 my @words = split $sep, $&;
1009 m/$re_encoded_word/;
1013 if ($encoding eq 'q' || $encoding eq 'Q') {
1016 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1018 # other encodings not supported yet
1023 return wantarray ?
($_, $charset) : $_;
1028 my $encoding = shift || 'UTF-8';
1029 s/([^-a-zA-Z0-9!*+\/])/sprintf
("=%02X", ord($1))/eg
;
1030 s/(.*)/=\?$encoding\?q\?$1\?=/;
1034 sub is_rfc2047_quoted
{
1037 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1040 sub subject_needs_rfc2047_quoting
{
1043 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1047 local $subject = shift;
1048 my $encoding = shift || 'UTF-8';
1050 if (subject_needs_rfc2047_quoting
($subject)) {
1051 return quote_rfc2047
($subject, $encoding);
1056 # use the simplest quoting being able to handle the recipient
1057 sub sanitize_address
{
1058 my ($recipient) = @_;
1060 # remove garbage after email address
1061 $recipient =~ s/(.*>).*$/$1/;
1063 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1065 if (not $recipient_name) {
1069 # if recipient_name is already quoted, do nothing
1070 if (is_rfc2047_quoted
($recipient_name)) {
1074 # remove non-escaped quotes
1075 $recipient_name =~ s/(^|[^\\])"/$1/g;
1077 # rfc2047 is needed if a non-ascii char is included
1078 if ($recipient_name =~ /[^[:ascii:]]/) {
1079 $recipient_name = quote_rfc2047
($recipient_name);
1082 # double quotes are needed if specials or CTLs are included
1083 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1084 $recipient_name =~ s/([\\\r])/\\$1/g;
1085 $recipient_name = qq["$recipient_name"];
1088 return "$recipient_name $recipient_addr";
1092 sub strip_garbage_one_address
{
1095 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1096 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1097 # Foo Bar <foobar@example.com> [possibly garbage here]
1100 if ($addr =~ /^(<[^>]*>).*/) {
1101 # <foo@example.com> [possibly garbage here]
1102 # if garbage contains other addresses, they are ignored.
1105 if ($addr =~ /^([^"#,\s]*)/) {
1106 # address without quoting: remove anything after the address
1112 sub sanitize_address_list
{
1113 return (map { sanitize_address
($_) } @_);
1116 sub process_address_list
{
1117 my @addr_list = map { parse_address_line
($_) } @_;
1118 @addr_list = expand_aliases
(@addr_list);
1119 @addr_list = sanitize_address_list
(@addr_list);
1120 @addr_list = validate_address_list
(@addr_list);
1124 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1126 # Tightly configured MTAa require that a caller sends a real DNS
1127 # domain name that corresponds the IP address in the HELO/EHLO
1128 # handshake. This is used to verify the connection and prevent
1129 # spammers from trying to hide their identity. If the DNS and IP don't
1130 # match, the receiveing MTA may deny the connection.
1132 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1134 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1135 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1137 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1138 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1142 return defined $domain && !($^O
eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1145 sub maildomain_net
{
1148 my $domain = Net
::Domain
::domainname
();
1149 $maildomain = $domain if valid_fqdn
($domain);
1154 sub maildomain_mta
{
1157 for my $host (qw(mailhost localhost)) {
1158 my $smtp = Net
::SMTP
->new($host);
1159 if (defined $smtp) {
1160 my $domain = $smtp->domain;
1163 $maildomain = $domain if valid_fqdn
($domain);
1165 last if $maildomain;
1173 return maildomain_net
() || maildomain_mta
() || 'localhost.localdomain';
1176 sub smtp_host_string
{
1177 if (defined $smtp_server_port) {
1178 return "$smtp_server:$smtp_server_port";
1180 return $smtp_server;
1184 # Returns 1 if authentication succeeded or was not necessary
1185 # (smtp_user was not specified), and 0 otherwise.
1187 sub smtp_auth_maybe
{
1188 if (!defined $smtp_authuser || $auth) {
1192 # Workaround AUTH PLAIN/LOGIN interaction defect
1193 # with Authen::SASL::Cyrus
1195 require Authen
::SASL
;
1196 Authen
::SASL
->import(qw(Perl));
1199 # Check mechanism naming as defined in:
1200 # https://tools.ietf.org/html/rfc4422#page-8
1201 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1202 die "invalid smtp auth: '${smtp_auth}'";
1205 # TODO: Authentication may fail not because credentials were
1206 # invalid but due to other reasons, in which we should not
1207 # reject credentials.
1208 $auth = Git
::credential
({
1209 'protocol' => 'smtp',
1210 'host' => smtp_host_string
(),
1211 'username' => $smtp_authuser,
1212 # if there's no password, "git credential fill" will
1213 # give us one, otherwise it'll just pass this one.
1214 'password' => $smtp_authpass
1219 my $sasl = Authen
::SASL
->new(
1220 mechanism
=> $smtp_auth,
1222 user
=> $cred->{'username'},
1223 pass
=> $cred->{'password'},
1224 authname
=> $cred->{'username'},
1228 return !!$smtp->auth($sasl);
1231 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1237 sub ssl_verify_params
{
1239 require IO
::Socket
::SSL
;
1240 IO
::Socket
::SSL
->import(qw
/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1243 print STDERR
"Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1247 if (!defined $smtp_ssl_cert_path) {
1248 # use the OpenSSL defaults
1249 return (SSL_verify_mode
=> SSL_VERIFY_PEER
());
1252 if ($smtp_ssl_cert_path eq "") {
1253 return (SSL_verify_mode
=> SSL_VERIFY_NONE
());
1254 } elsif (-d
$smtp_ssl_cert_path) {
1255 return (SSL_verify_mode
=> SSL_VERIFY_PEER
(),
1256 SSL_ca_path
=> $smtp_ssl_cert_path);
1257 } elsif (-f
$smtp_ssl_cert_path) {
1258 return (SSL_verify_mode
=> SSL_VERIFY_PEER
(),
1259 SSL_ca_file
=> $smtp_ssl_cert_path);
1261 die sprintf(__
("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1265 sub file_name_is_absolute
{
1268 # msys does not grok DOS drive-prefixes
1269 if ($^O
eq 'msys') {
1270 return ($path =~ m
#^/# || $path =~ m#^[a-zA-Z]\:#)
1273 require File
::Spec
::Functions
;
1274 return File
::Spec
::Functions
::file_name_is_absolute
($path);
1277 # Returns 1 if the message was sent, and 0 otherwise.
1278 # In actuality, the whole program dies when there
1279 # is an error sending a message.
1282 my @recipients = unique_email_list
(@to);
1283 @cc = (grep { my $cc = extract_valid_address_or_die
($_);
1284 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1287 my $to = join (",\n\t", @recipients);
1288 @recipients = unique_email_list
(@recipients,@cc,@bcclist);
1289 @recipients = (map { extract_valid_address_or_die
($_) } @recipients);
1290 my $date = format_2822_time
($time++);
1291 my $gitversion = '@@GIT_VERSION@@';
1292 if ($gitversion =~ m/..GIT_VERSION../) {
1293 $gitversion = Git
::version
();
1296 my $cc = join(",\n\t", unique_email_list
(@cc));
1299 $ccline = "\nCc: $cc";
1301 make_message_id
() unless defined($message_id);
1303 my $header = "From: $sender
1307 Message-Id: $message_id
1310 $header .= "X-Mailer: git-send-email $gitversion\n";
1314 $header .= "In-Reply-To: $reply_to\n";
1315 $header .= "References: $references\n";
1318 $header .= join("\n", @xh) . "\n";
1321 my @sendmail_parameters = ('-i', @recipients);
1322 my $raw_from = $sender;
1323 if (defined $envelope_sender && $envelope_sender ne "auto") {
1324 $raw_from = $envelope_sender;
1326 $raw_from = extract_valid_address
($raw_from);
1327 unshift (@sendmail_parameters,
1328 '-f', $raw_from) if(defined $envelope_sender);
1330 if ($needs_confirm && !$dry_run) {
1331 print "\n$header\n";
1332 if ($needs_confirm eq "inform") {
1333 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1334 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1336 The Cc list above has been expanded by additional
1337 addresses found in the patch commit message. By default
1338 send-email prompts before sending whenever this occurs.
1339 This behavior is controlled by the sendemail.confirm
1340 configuration setting.
1342 For additional information, run 'git send-email --help'.
1343 To retain the current behavior, but squelch this message,
1344 run 'git config --global sendemail.confirm auto'.
1348 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1349 # translation. The program will only accept English input
1351 $_ = ask
(__
("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1352 valid_re
=> qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1353 default => $ask_default);
1354 die __
("Send this email reply required") unless defined $_;
1358 cleanup_compose_files
();
1365 unshift (@sendmail_parameters, @smtp_server_options);
1368 # We don't want to send the email.
1369 } elsif (file_name_is_absolute
($smtp_server)) {
1370 my $pid = open my $sm, '|-';
1371 defined $pid or die $!;
1373 exec($smtp_server, @sendmail_parameters) or die $!;
1375 print $sm "$header\n$message";
1376 close $sm or die $!;
1379 if (!defined $smtp_server) {
1380 die __
("The required SMTP server is not properly defined.")
1384 my $use_net_smtp_ssl = version
->parse($Net::SMTP
::VERSION
) < version
->parse("2.34");
1385 $smtp_domain ||= maildomain
();
1387 if ($smtp_encryption eq 'ssl') {
1388 $smtp_server_port ||= 465; # ssmtp
1389 require IO
::Socket
::SSL
;
1391 # Suppress "variable accessed once" warning.
1394 $IO::Socket
::SSL
::DEBUG
= 1;
1397 # Net::SMTP::SSL->new() does not forward any SSL options
1398 IO
::Socket
::SSL
::set_client_defaults
(
1399 ssl_verify_params
());
1401 if ($use_net_smtp_ssl) {
1402 require Net
::SMTP
::SSL
;
1403 $smtp ||= Net
::SMTP
::SSL
->new($smtp_server,
1404 Hello
=> $smtp_domain,
1405 Port
=> $smtp_server_port,
1406 Debug
=> $debug_net_smtp);
1409 $smtp ||= Net
::SMTP
->new($smtp_server,
1410 Hello
=> $smtp_domain,
1411 Port
=> $smtp_server_port,
1412 Debug
=> $debug_net_smtp,
1417 $smtp_server_port ||= 25;
1418 $smtp ||= Net
::SMTP
->new($smtp_server,
1419 Hello
=> $smtp_domain,
1420 Debug
=> $debug_net_smtp,
1421 Port
=> $smtp_server_port);
1422 if ($smtp_encryption eq 'tls' && $smtp) {
1423 if ($use_net_smtp_ssl) {
1424 $smtp->command('STARTTLS');
1426 if ($smtp->code != 220) {
1427 die sprintf(__
("Server does not support STARTTLS! %s"), $smtp->message);
1429 require Net
::SMTP
::SSL
;
1430 $smtp = Net
::SMTP
::SSL
->start_SSL($smtp,
1431 ssl_verify_params
())
1432 or die sprintf(__
("STARTTLS failed! %s"), IO
::Socket
::SSL
::errstr
());
1435 $smtp->starttls(ssl_verify_params
())
1436 or die sprintf(__
("STARTTLS failed! %s"), IO
::Socket
::SSL
::errstr
());
1438 $smtp_encryption = '';
1439 # Send EHLO again to receive fresh
1440 # supported commands
1441 $smtp->hello($smtp_domain);
1446 die __
("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1447 " VALUES: server=$smtp_server ",
1448 "encryption=$smtp_encryption ",
1449 "hello=$smtp_domain",
1450 defined $smtp_server_port ?
" port=$smtp_server_port" : "";
1453 smtp_auth_maybe
or die $smtp->message;
1455 $smtp->mail( $raw_from ) or die $smtp->message;
1456 $smtp->to( @recipients ) or die $smtp->message;
1457 $smtp->data or die $smtp->message;
1458 $smtp->datasend("$header\n") or die $smtp->message;
1459 my @lines = split /^/, $message;
1460 foreach my $line (@lines) {
1461 $smtp->datasend("$line") or die $smtp->message;
1463 $smtp->dataend() or die $smtp->message;
1464 $smtp->code =~ /250|200/ or die sprintf(__
("Failed to send %s\n"), $subject).$smtp->message;
1467 printf($dry_run ? __
("Dry-Sent %s\n") : __
("Sent %s\n"), $subject);
1469 print($dry_run ? __
("Dry-OK. Log says:\n") : __
("OK. Log says:\n"));
1470 if (!file_name_is_absolute
($smtp_server)) {
1471 print "Server: $smtp_server\n";
1472 print "MAIL FROM:<$raw_from>\n";
1473 foreach my $entry (@recipients) {
1474 print "RCPT TO:<$entry>\n";
1477 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1479 print $header, "\n";
1481 print __
("Result: "), $smtp->code, ' ',
1482 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1484 print __
("Result: OK\n");
1491 $reply_to = $initial_reply_to;
1492 $references = $initial_reply_to || '';
1493 $subject = $initial_subject;
1496 foreach my $t (@files) {
1497 open my $fh, "<", $t or die sprintf(__
("can't open file %s"), $t);
1500 my $sauthor = undef;
1501 my $author_encoding;
1502 my $has_content_type;
1505 my $has_mime_version;
1509 my $input_format = undef;
1513 # First unfold multiline header fields
1516 if (/^\s+\S/ and @header) {
1517 chomp($header[$#header]);
1519 $header[$#header] .= $_;
1524 # Now parse the header
1527 $input_format = 'mbox';
1531 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1532 $input_format = 'mbox';
1535 if (defined $input_format && $input_format eq 'mbox') {
1536 if (/^Subject:\s+(.*)$/i) {
1539 elsif (/^From:\s+(.*)$/i) {
1540 ($author, $author_encoding) = unquote_rfc2047
($1);
1541 $sauthor = sanitize_address
($author);
1542 next if $suppress_cc{'author'};
1543 next if $suppress_cc{'self'} and $sauthor eq $sender;
1544 printf(__
("(mbox) Adding cc: %s from line '%s'\n"),
1545 $1, $_) unless $quiet;
1548 elsif (/^To:\s+(.*)$/i) {
1549 foreach my $addr (parse_address_line
($1)) {
1550 printf(__
("(mbox) Adding to: %s from line '%s'\n"),
1551 $addr, $_) unless $quiet;
1555 elsif (/^Cc:\s+(.*)$/i) {
1556 foreach my $addr (parse_address_line
($1)) {
1557 my $qaddr = unquote_rfc2047
($addr);
1558 my $saddr = sanitize_address
($qaddr);
1559 if ($saddr eq $sender) {
1560 next if ($suppress_cc{'self'});
1562 next if ($suppress_cc{'cc'});
1564 printf(__
("(mbox) Adding cc: %s from line '%s'\n"),
1565 $addr, $_) unless $quiet;
1569 elsif (/^Content-type:/i) {
1570 $has_content_type = 1;
1571 if (/charset="?([^ "]+)/) {
1572 $body_encoding = $1;
1576 elsif (/^MIME-Version/i) {
1577 $has_mime_version = 1;
1580 elsif (/^Message-Id: (.*)/i) {
1583 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1584 $xfer_encoding = $1 if not defined $xfer_encoding;
1586 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1591 # In the traditional
1592 # "send lots of email" format,
1595 # So let's support that, too.
1596 $input_format = 'lots';
1597 if (@cc == 0 && !$suppress_cc{'cc'}) {
1598 printf(__
("(non-mbox) Adding cc: %s from line '%s'\n"),
1599 $_, $_) unless $quiet;
1601 } elsif (!defined $subject) {
1606 # Now parse the message body
1609 if (/^(Signed-off-by|Cc): (.*)/i) {
1611 my ($what, $c) = ($1, $2);
1612 # strip garbage for the address we'll use:
1613 $c = strip_garbage_one_address
($c);
1614 # sanitize a bit more to decide whether to suppress the address:
1615 my $sc = sanitize_address
($c);
1616 if ($sc eq $sender) {
1617 next if ($suppress_cc{'self'});
1619 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1620 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1623 printf(__
("(body) Adding cc: %s from line '%s'\n"),
1624 $c, $_) unless $quiet;
1629 push @to, recipients_cmd
("to-cmd", "to", $to_cmd, $t)
1631 push @cc, recipients_cmd
("cc-cmd", "cc", $cc_cmd, $t)
1632 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1634 if ($broken_encoding{$t} && !$has_content_type) {
1635 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1636 $has_content_type = 1;
1637 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1638 $body_encoding = $auto_8bit_encoding;
1641 if ($broken_encoding{$t} && !is_rfc2047_quoted
($subject)) {
1642 $subject = quote_subject
($subject, $auto_8bit_encoding);
1645 if (defined $sauthor and $sauthor ne $sender) {
1646 $message = "From: $author\n\n$message";
1647 if (defined $author_encoding) {
1648 if ($has_content_type) {
1649 if ($body_encoding eq $author_encoding) {
1650 # ok, we already have the right encoding
1653 # uh oh, we should re-encode
1657 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1658 $has_content_type = 1;
1660 "Content-Type: text/plain; charset=$author_encoding";
1664 if (defined $target_xfer_encoding) {
1665 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1666 $message = apply_transfer_encoding
(
1667 $message, $xfer_encoding, $target_xfer_encoding);
1668 $xfer_encoding = $target_xfer_encoding;
1670 if (defined $xfer_encoding) {
1671 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1673 if (defined $xfer_encoding or $has_content_type) {
1674 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1678 $confirm eq "always" or
1679 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1680 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1681 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1683 @to = process_address_list
(@to);
1684 @cc = process_address_list
(@cc);
1686 @to = (@initial_to, @to);
1687 @cc = (@initial_cc, @cc);
1689 if ($message_num == 1) {
1690 if (defined $cover_cc and $cover_cc) {
1693 if (defined $cover_to and $cover_to) {
1698 my $message_was_sent = send_message
();
1700 # set up for the next message
1701 if ($thread && $message_was_sent &&
1702 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1703 $message_num == 1)) {
1704 $reply_to = $message_id;
1705 if (length $references > 0) {
1706 $references .= "\n $message_id";
1708 $references = "$message_id";
1711 $message_id = undef;
1713 if (defined $batch_size && $num_sent == $batch_size) {
1715 $smtp->quit if defined $smtp;
1718 sleep($relogin_delay) if defined $relogin_delay;
1722 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1723 # and return a results array
1724 sub recipients_cmd
{
1725 my ($prefix, $what, $cmd, $file) = @_;
1728 open my $fh, "-|", "$cmd \Q$file\E"
1729 or die sprintf(__
("(%s) Could not execute '%s'"), $prefix, $cmd);
1730 while (my $address = <$fh>) {
1731 $address =~ s/^\s*//g;
1732 $address =~ s/\s*$//g;
1733 $address = sanitize_address
($address);
1734 next if ($address eq $sender and $suppress_cc{'self'});
1735 push @addresses, $address;
1736 printf(__
("(%s) Adding %s: %s from: '%s'\n"),
1737 $prefix, $what, $address, $cmd) unless $quiet;
1740 or die sprintf(__
("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1744 cleanup_compose_files
();
1746 sub cleanup_compose_files
{
1747 unlink($compose_filename, $compose_filename . ".final") if $compose;
1750 $smtp->quit if $smtp;
1752 sub apply_transfer_encoding
{
1753 my $message = shift;
1757 return $message if ($from eq $to and $from ne '7bit');
1759 require MIME
::QuotedPrint
;
1760 require MIME
::Base64
;
1762 $message = MIME
::QuotedPrint
::decode
($message)
1763 if ($from eq 'quoted-printable');
1764 $message = MIME
::Base64
::decode
($message)
1765 if ($from eq 'base64');
1767 die __
("cannot send message as 7bit")
1768 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1770 if ($to eq '7bit' or $to eq '8bit');
1771 return MIME
::QuotedPrint
::encode
($message, "\n", 0)
1772 if ($to eq 'quoted-printable');
1773 return MIME
::Base64
::encode
($message, "\n")
1774 if ($to eq 'base64');
1775 die __
("invalid transfer encoding");
1778 sub unique_email_list
{
1782 foreach my $entry (@_) {
1783 my $clean = extract_valid_address_or_die
($entry);
1784 $seen{$clean} ||= 0;
1785 next if $seen{$clean}++;
1786 push @emails, $entry;
1791 sub validate_patch
{
1795 my $validate_hook = catfile
(catdir
($repo->repo_path(), 'hooks'),
1796 'sendemail-validate');
1798 if (-x
$validate_hook) {
1799 my $target = abs_path
($fn);
1800 # The hook needs a correct cwd and GIT_DIR.
1801 my $cwd_save = cwd
();
1802 chdir($repo->wc_path() or $repo->repo_path())
1803 or die("chdir: $!");
1804 local $ENV{"GIT_DIR"} = $repo->repo_path();
1805 $hook_error = "rejected by sendemail-validate hook"
1806 if system($validate_hook, $target);
1807 chdir($cwd_save) or die("chdir: $!");
1809 return $hook_error if $hook_error;
1812 open(my $fh, '<', $fn)
1813 or die sprintf(__
("unable to open %s: %s\n"), $fn, $!);
1814 while (my $line = <$fh>) {
1815 if (length($line) > 998) {
1816 return sprintf(__
("%s: patch contains a line longer than 998 characters"), $.);
1823 my ($last, $lastlen, $file, $known_suffix) = @_;
1824 my ($suffix, $skip);
1827 if (defined $last &&
1828 ($lastlen < length($file)) &&
1829 (substr($file, 0, $lastlen) eq $last) &&
1830 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1831 if (defined $known_suffix && $suffix eq $known_suffix) {
1832 printf(__
("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1835 # TRANSLATORS: please keep "[y|N]" as is.
1836 my $answer = ask
(sprintf(__
("Do you really want to send %s? [y|N]: "), $file),
1837 valid_re
=> qr/^(?:y|n)/i,
1839 $skip = ($answer ne 'y');
1841 $known_suffix = $suffix;
1845 return ($skip, $known_suffix);
1848 sub handle_backup_files
{
1850 my ($last, $lastlen, $known_suffix, $skip, @result);
1851 for my $file (@file) {
1852 ($skip, $known_suffix) = handle_backup
($last, $lastlen,
1853 $file, $known_suffix);
1854 push @result, $file unless $skip;
1856 $lastlen = length($file);
1861 sub file_has_nonascii
{
1863 open(my $fh, '<', $fn)
1864 or die sprintf(__
("unable to open %s: %s\n"), $fn, $!);
1865 while (my $line = <$fh>) {
1866 return 1 if $line =~ /[^[:ascii:]]/;
1871 sub body_or_subject_has_nonascii
{
1873 open(my $fh, '<', $fn)
1874 or die sprintf(__
("unable to open %s: %s\n"), $fn, $!);
1875 while (my $line = <$fh>) {
1876 last if $line =~ /^$/;
1877 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1879 while (my $line = <$fh>) {
1880 return 1 if $line =~ /[^[:ascii:]]/;