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(catfile);
33 Getopt
::Long
::Configure qw
/ pass_through /;
37 my ($class, $reason) = @_;
38 return bless \
$reason, shift;
42 die "Cannot use readline on FakeTerm: $$self";
49 git send-email [options] <file | directory | rev-list options >
50 git send-email --dump-aliases
53 --from <str> * Email From:
54 --[no-]to <str> * Email To:
55 --[no-]cc <str> * Email Cc:
56 --[no-]bcc <str> * Email Bcc:
57 --subject <str> * Email "Subject:"
58 --in-reply-to <str> * Email "In-Reply-To:"
59 --[no-]xmailer * Add "X-Mailer:" header (default).
60 --[no-]annotate * Review each patch that will be sent in an editor.
61 --compose * Open an editor for introduction.
62 --compose-encoding <str> * Encoding to assume for introduction.
63 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
64 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
67 --envelope-sender <str> * Email envelope sender.
68 --smtp-server <str:int> * Outgoing SMTP server to use. The port
69 is optional. Default 'localhost'.
70 --smtp-server-option <str> * Outgoing SMTP server option to use.
71 --smtp-server-port <int> * Outgoing SMTP server port.
72 --smtp-user <str> * Username for SMTP-AUTH.
73 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
74 --smtp-encryption <str> * tls or ssl; anything else disables.
75 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
76 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
77 Pass an empty string to disable certificate
79 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
80 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms.
81 This setting forces to use one of the listed mechanisms.
82 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
85 --identity <str> * Use the sendemail.<id> options.
86 --to-cmd <str> * Email To: via `<str> \$patch_path`
87 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
88 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, all.
89 --[no-]cc-cover * Email Cc: addresses in the cover letter.
90 --[no-]to-cover * Email To: addresses in the cover letter.
91 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
92 --[no-]suppress-from * Send to self. Default off.
93 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
94 --[no-]thread * Use In-Reply-To: field. Default on.
97 --confirm <str> * Confirm recipients before sending;
98 auto, cc, compose, always, or never.
99 --quiet * Output one line of info per email.
100 --dry-run * Don't actually send the emails.
101 --[no-]validate * Perform patch sanity checks. Default on.
102 --[no-]format-patch * understand any non optional arguments as
103 `git format-patch` ones.
104 --force * Send even if safety checks would prevent it.
107 --dump-aliases * Dump configured aliases and exit.
113 # most mail servers generate the Date: header, but not all...
114 sub format_2822_time
{
116 my @localtm = localtime($time);
117 my @gmttm = gmtime($time);
118 my $localmin = $localtm[1] + $localtm[2] * 60;
119 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
120 if ($localtm[0] != $gmttm[0]) {
121 die "local zone differs from GMT by a non-minute interval\n";
123 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
125 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
127 } elsif ($gmttm[6] != $localtm[6]) {
128 die "local time offset greater than or equal to 24 hours\n";
130 my $offset = $localmin - $gmtmin;
131 my $offhour = $offset / 60;
132 my $offmin = abs($offset % 60);
133 if (abs($offhour) >= 24) {
134 die ("local time offset greater than or equal to 24 hours\n");
137 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
138 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
140 qw(Jan Feb Mar Apr May Jun
141 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
146 ($offset >= 0) ?
'+' : '-',
152 my $have_email_valid = eval { require Email
::Valid
; 1 };
153 my $have_mail_address = eval { require Mail
::Address
; 1 };
157 # Regexes for RFC 2047 productions.
158 my $re_token = qr/[^][()<>@,;:\\"\/?
.= \000-\037\177-\377]+/;
159 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
160 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
162 # Variables we fill in automatically, or via prompting:
163 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
164 $initial_reply_to,$initial_subject,@files,
165 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
170 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
172 my $repo = eval { Git
->repository() };
173 my @repo = $repo ?
($repo) : ();
175 $ENV{"GIT_SEND_EMAIL_NOTTY"}
176 ? new Term
::ReadLine
'git-send-email', \
*STDIN
, \
*STDOUT
177 : new Term
::ReadLine
'git-send-email';
180 $term = new FakeTerm
"$@: going non-interactive";
183 # Behavior modification variables
184 my ($quiet, $dry_run) = (0, 0);
186 my $compose_filename;
188 my $dump_aliases = 0;
190 # Handle interactive edition of files.
195 if (!defined($editor)) {
196 $editor = Git
::command_oneline
('var', 'GIT_EDITOR');
198 if (defined($multiedit) && !$multiedit) {
200 system('sh', '-c', $editor.' "$@"', $editor, $_);
201 if (($?
& 127) || ($?
>> 8)) {
202 die("the editor exited uncleanly, aborting everything");
206 system('sh', '-c', $editor.' "$@"', $editor, @_);
207 if (($?
& 127) || ($?
>> 8)) {
208 die("the editor exited uncleanly, aborting everything");
213 # Variables with corresponding config settings
214 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
215 my ($cover_cc, $cover_to);
216 my ($to_cmd, $cc_cmd);
217 my ($smtp_server, $smtp_server_port, @smtp_server_options);
218 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
219 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
220 my ($validate, $confirm);
222 my ($auto_8bit_encoding);
223 my ($compose_encoding);
224 my ($target_xfer_encoding);
226 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
228 my %config_bool_settings = (
229 "thread" => [\
$thread, 1],
230 "chainreplyto" => [\
$chain_reply_to, 0],
231 "suppressfrom" => [\
$suppress_from, undef],
232 "signedoffbycc" => [\
$signed_off_by_cc, undef],
233 "cccover" => [\
$cover_cc, undef],
234 "tocover" => [\
$cover_to, undef],
235 "signedoffcc" => [\
$signed_off_by_cc, undef], # Deprecated
236 "validate" => [\
$validate, 1],
237 "multiedit" => [\
$multiedit, undef],
238 "annotate" => [\
$annotate, undef],
239 "xmailer" => [\
$use_xmailer, 1]
242 my %config_settings = (
243 "smtpserver" => \
$smtp_server,
244 "smtpserverport" => \
$smtp_server_port,
245 "smtpserveroption" => \
@smtp_server_options,
246 "smtpuser" => \
$smtp_authuser,
247 "smtppass" => \
$smtp_authpass,
248 "smtpdomain" => \
$smtp_domain,
249 "smtpauth" => \
$smtp_auth,
250 "to" => \
@initial_to,
252 "cc" => \
@initial_cc,
254 "aliasfiletype" => \
$aliasfiletype,
256 "suppresscc" => \
@suppress_cc,
257 "envelopesender" => \
$envelope_sender,
258 "confirm" => \
$confirm,
260 "assume8bitencoding" => \
$auto_8bit_encoding,
261 "composeencoding" => \
$compose_encoding,
262 "transferencoding" => \
$target_xfer_encoding,
265 my %config_path_settings = (
266 "aliasesfile" => \
@alias_files,
267 "smtpsslcertpath" => \
$smtp_ssl_cert_path,
270 # Handle Uncouth Termination
274 print color
("reset"), "\n";
276 # SMTP password masked
279 # tmp files from --compose
280 if (defined $compose_filename) {
281 if (-e
$compose_filename) {
282 print "'$compose_filename' contains an intermediate version of the email you were composing.\n";
284 if (-e
($compose_filename . ".final")) {
285 print "'$compose_filename.final' contains the composed email.\n"
292 $SIG{TERM
} = \
&signal_handler
;
293 $SIG{INT
} = \
&signal_handler
;
295 # Begin by accumulating all the variables (defined above), that we will end up
296 # needing, first, from the command line:
299 my $rc = GetOptions
("h" => \
$help,
300 "dump-aliases" => \
$dump_aliases);
302 die "--dump-aliases incompatible with other options\n"
303 if !$help and $dump_aliases and @ARGV;
305 "sender|from=s" => \
$sender,
306 "in-reply-to=s" => \
$initial_reply_to,
307 "subject=s" => \
$initial_subject,
308 "to=s" => \
@initial_to,
309 "to-cmd=s" => \
$to_cmd,
311 "cc=s" => \
@initial_cc,
313 "bcc=s" => \
@bcclist,
314 "no-bcc" => \
$no_bcc,
315 "chain-reply-to!" => \
$chain_reply_to,
316 "no-chain-reply-to" => sub {$chain_reply_to = 0},
317 "smtp-server=s" => \
$smtp_server,
318 "smtp-server-option=s" => \
@smtp_server_options,
319 "smtp-server-port=s" => \
$smtp_server_port,
320 "smtp-user=s" => \
$smtp_authuser,
321 "smtp-pass:s" => \
$smtp_authpass,
322 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
323 "smtp-encryption=s" => \
$smtp_encryption,
324 "smtp-ssl-cert-path=s" => \
$smtp_ssl_cert_path,
325 "smtp-debug:i" => \
$debug_net_smtp,
326 "smtp-domain:s" => \
$smtp_domain,
327 "smtp-auth=s" => \
$smtp_auth,
328 "identity=s" => \
$identity,
329 "annotate!" => \
$annotate,
330 "no-annotate" => sub {$annotate = 0},
331 "compose" => \
$compose,
333 "cc-cmd=s" => \
$cc_cmd,
334 "suppress-from!" => \
$suppress_from,
335 "no-suppress-from" => sub {$suppress_from = 0},
336 "suppress-cc=s" => \
@suppress_cc,
337 "signed-off-cc|signed-off-by-cc!" => \
$signed_off_by_cc,
338 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
339 "cc-cover|cc-cover!" => \
$cover_cc,
340 "no-cc-cover" => sub {$cover_cc = 0},
341 "to-cover|to-cover!" => \
$cover_to,
342 "no-to-cover" => sub {$cover_to = 0},
343 "confirm=s" => \
$confirm,
344 "dry-run" => \
$dry_run,
345 "envelope-sender=s" => \
$envelope_sender,
346 "thread!" => \
$thread,
347 "no-thread" => sub {$thread = 0},
348 "validate!" => \
$validate,
349 "no-validate" => sub {$validate = 0},
350 "transfer-encoding=s" => \
$target_xfer_encoding,
351 "format-patch!" => \
$format_patch,
352 "no-format-patch" => sub {$format_patch = 0},
353 "8bit-encoding=s" => \
$auto_8bit_encoding,
354 "compose-encoding=s" => \
$compose_encoding,
356 "xmailer!" => \
$use_xmailer,
357 "no-xmailer" => sub {$use_xmailer = 0},
365 die "Cannot run git format-patch from outside a repository\n"
366 if $format_patch and not $repo;
368 # Now, let's fill any that aren't set in with defaults:
373 foreach my $setting (keys %config_bool_settings) {
374 my $target = $config_bool_settings{$setting}->[0];
375 $$target = Git
::config_bool
(@repo, "$prefix.$setting") unless (defined $$target);
378 foreach my $setting (keys %config_path_settings) {
379 my $target = $config_path_settings{$setting};
380 if (ref($target) eq "ARRAY") {
382 my @values = Git
::config_path
(@repo, "$prefix.$setting");
383 @
$target = @values if (@values && defined $values[0]);
387 $$target = Git
::config_path
(@repo, "$prefix.$setting") unless (defined $$target);
391 foreach my $setting (keys %config_settings) {
392 my $target = $config_settings{$setting};
393 next if $setting eq "to" and defined $no_to;
394 next if $setting eq "cc" and defined $no_cc;
395 next if $setting eq "bcc" and defined $no_bcc;
396 if (ref($target) eq "ARRAY") {
398 my @values = Git
::config
(@repo, "$prefix.$setting");
399 @
$target = @values if (@values && defined $values[0]);
403 $$target = Git
::config
(@repo, "$prefix.$setting") unless (defined $$target);
407 if (!defined $smtp_encryption) {
408 my $enc = Git
::config
(@repo, "$prefix.smtpencryption");
410 $smtp_encryption = $enc;
411 } elsif (Git
::config_bool
(@repo, "$prefix.smtpssl")) {
412 $smtp_encryption = 'ssl';
417 # read configuration from [sendemail "$identity"], fall back on [sendemail]
418 $identity = Git
::config
(@repo, "sendemail.identity") unless (defined $identity);
419 read_config
("sendemail.$identity") if (defined $identity);
420 read_config
("sendemail");
422 # fall back on builtin bool defaults
423 foreach my $setting (values %config_bool_settings) {
424 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
427 # 'default' encryption is none -- this only prevents a warning
428 $smtp_encryption = '' unless (defined $smtp_encryption);
430 # Set CC suppressions
433 foreach my $entry (@suppress_cc) {
434 die "Unknown --suppress-cc field: '$entry'\n"
435 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
436 $suppress_cc{$entry} = 1;
440 if ($suppress_cc{'all'}) {
441 foreach my $entry (qw
(cccmd cc author self sob body bodycc
)) {
442 $suppress_cc{$entry} = 1;
444 delete $suppress_cc{'all'};
447 # If explicit old-style ones are specified, they trump --suppress-cc.
448 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
449 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
451 if ($suppress_cc{'body'}) {
452 foreach my $entry (qw
(sob bodycc
)) {
453 $suppress_cc{$entry} = 1;
455 delete $suppress_cc{'body'};
458 # Set confirm's default value
459 my $confirm_unconfigured = !defined $confirm;
460 if ($confirm_unconfigured) {
461 $confirm = scalar %suppress_cc ?
'compose' : 'auto';
463 die "Unknown --confirm setting: '$confirm'\n"
464 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
466 # Debugging, print out the suppressions.
468 print "suppressions:\n";
469 foreach my $entry (keys %suppress_cc) {
470 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
474 my ($repoauthor, $repocommitter);
475 ($repoauthor) = Git
::ident_person
(@repo, 'author');
476 ($repocommitter) = Git
::ident_person
(@repo, 'committer');
478 sub parse_address_line
{
479 if ($have_mail_address) {
480 return map { $_->format } Mail
::Address
->parse($_[0]);
482 return Git
::parse_mailboxes
($_[0]);
487 return quotewords
('\s*,\s*', 1, @_);
492 sub parse_sendmail_alias
{
495 print STDERR
"warning: sendmail alias with quotes is not supported: $_\n";
496 } elsif (/:include:/) {
497 print STDERR
"warning: `:include:` not supported: $_\n";
499 print STDERR
"warning: `/file` or `|pipe` redirection not supported: $_\n";
500 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
501 my ($alias, $addr) = ($1, $2);
502 $aliases{$alias} = [ split_addrs
($addr) ];
504 print STDERR
"warning: sendmail line is not recognized: $_\n";
508 sub parse_sendmail_aliases
{
513 next if /^\s*$/ || /^\s*#/;
514 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
515 parse_sendmail_alias
($s) if $s;
518 $s =~ s/\\$//; # silently tolerate stray '\' on last line
519 parse_sendmail_alias
($s) if $s;
523 # multiline formats can be supported in the future
524 mutt
=> sub { my $fh = shift; while (<$fh>) {
525 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
526 my ($alias, $addr) = ($1, $2);
527 $addr =~ s/#.*$//; # mutt allows # comments
528 # commas delimit multiple addresses
529 my @addr = split_addrs
($addr);
531 # quotes may be escaped in the file,
532 # unescape them so we do not double-escape them later.
533 s/\\"/"/g foreach @addr;
534 $aliases{$alias} = \
@addr
536 mailrc
=> sub { my $fh = shift; while (<$fh>) {
537 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
538 # spaces delimit multiple addresses
539 $aliases{$1} = [ quotewords
('\s+', 0, $2) ];
541 pine
=> sub { my $fh = shift; my $f='\t[^\t]*';
542 for (my $x = ''; defined($x); $x = $_) {
544 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
545 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
546 $aliases{$1} = [ split_addrs
($2) ];
548 elm
=> sub { my $fh = shift;
550 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
551 my ($alias, $addr) = ($1, $2);
552 $aliases{$alias} = [ split_addrs
($addr) ];
555 sendmail
=> \
&parse_sendmail_aliases
,
556 gnus
=> sub { my $fh = shift; while (<$fh>) {
557 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
558 $aliases{$1} = [ $2 ];
562 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
563 foreach my $file (@alias_files) {
564 open my $fh, '<', $file or die "opening $file: $!\n";
565 $parse_alias{$aliasfiletype}->($fh);
571 print "$_\n" for (sort keys %aliases);
575 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
576 # $f is a revision list specification to be passed to format-patch.
577 sub is_format_patch_arg
{
581 $repo->command('rev-parse', '--verify', '--quiet', $f);
582 if (defined($format_patch)) {
583 return $format_patch;
586 File '$f' exists but it could also be the range of commits
587 to produce patches for. Please disambiguate by...
589 * Saying "./$f" if you mean a file; or
590 * Giving --format-patch option if you mean a range.
592 } catch Git
::Error
::Command with
{
593 # Not a valid revision. Treat it as a filename.
598 # Now that all the defaults are set, process the rest of the command line
599 # arguments and collect up the files that need to be processed.
601 while (defined(my $f = shift @ARGV)) {
603 push @rev_list_opts, "--", @ARGV;
605 } elsif (-d
$f and !is_format_patch_arg
($f)) {
607 or die "Failed to opendir $f: $!";
609 push @files, grep { -f
$_ } map { catfile
($f, $_) }
612 } elsif ((-f
$f or -p
$f) and !is_format_patch_arg
($f)) {
615 push @rev_list_opts, $f;
619 if (@rev_list_opts) {
620 die "Cannot run git format-patch from outside a repository\n"
622 push @files, $repo->command('format-patch', '-o', tempdir
(CLEANUP
=> 1), @rev_list_opts);
625 @files = handle_backup_files
(@files);
628 foreach my $f (@files) {
630 my $error = validate_patch
($f);
631 $error and die "fatal: $f: $error\nwarning: no patches were sent\n";
638 print $_,"\n" for (@files);
641 print STDERR
"\nNo patch files specified!\n\n";
645 sub get_patch_subject
{
647 open (my $fh, '<', $fn);
648 while (my $line = <$fh>) {
649 next unless ($line =~ /^Subject: (.*)$/);
654 die "No subject line in $fn ?";
658 # Note that this does not need to be secure, but we will make a small
659 # effort to have it be unique
660 $compose_filename = ($repo ?
661 tempfile
(".gitsendemail.msg.XXXXXX", DIR
=> $repo->repo_path()) :
662 tempfile
(".gitsendemail.msg.XXXXXX", DIR
=> "."))[1];
663 open my $c, ">", $compose_filename
664 or die "Failed to open for writing $compose_filename: $!";
667 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
668 my $tpl_subject = $initial_subject || '';
669 my $tpl_reply_to = $initial_reply_to || '';
672 From $tpl_sender # This line is ignored.
673 GIT: Lines beginning in "GIT:" will be removed.
674 GIT: Consider including an overall diffstat or table of contents
675 GIT: for the patch you are writing.
677 GIT: Clear the body content if you don't wish to send a summary.
679 Subject: $tpl_subject
680 In-Reply-To: $tpl_reply_to
684 print $c get_patch_subject
($f);
689 do_edit
($compose_filename, @files);
691 do_edit
($compose_filename);
694 open my $c2, ">", $compose_filename . ".final"
695 or die "Failed to open $compose_filename.final : " . $!;
697 open $c, "<", $compose_filename
698 or die "Failed to open $compose_filename : " . $!;
700 my $need_8bit_cte = file_has_nonascii
($compose_filename);
702 my $summary_empty = 1;
703 if (!defined $compose_encoding) {
704 $compose_encoding = "UTF-8";
709 $summary_empty = 0 unless (/^\n$/);
712 if ($need_8bit_cte) {
713 print $c2 "MIME-Version: 1.0\n",
714 "Content-Type: text/plain; ",
715 "charset=$compose_encoding\n",
716 "Content-Transfer-Encoding: 8bit\n";
718 } elsif (/^MIME-Version:/i) {
720 } elsif (/^Subject:\s*(.+)\s*$/i) {
721 $initial_subject = $1;
722 my $subject = $initial_subject;
724 quote_subject
($subject, $compose_encoding) .
726 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
727 $initial_reply_to = $1;
729 } elsif (/^From:\s*(.+)\s*$/i) {
732 } elsif (/^(?:To|Cc|Bcc):/i) {
733 print "To/Cc/Bcc fields are not interpreted yet, they have been ignored\n";
741 if ($summary_empty) {
742 print "Summary email is empty, skipping it\n";
745 } elsif ($annotate) {
750 my ($prompt, %arg) = @_;
751 my $valid_re = $arg{valid_re
};
752 my $default = $arg{default};
753 my $confirm_only = $arg{confirm_only
};
756 return defined $default ?
$default : undef
757 unless defined $term->IN and defined fileno($term->IN) and
758 defined $term->OUT and defined fileno($term->OUT);
760 $resp = $term->readline($prompt);
761 if (!defined $resp) { # EOF
763 return defined $default ?
$default : undef;
765 if ($resp eq '' and defined $default) {
768 if (!defined $valid_re or $resp =~ /$valid_re/) {
772 my $yesno = $term->readline("Are you sure you want to use <$resp> [y/N]? ");
773 if (defined $yesno && $yesno =~ /y/i) {
783 sub file_declares_8bit_cte
{
785 open (my $fh, '<', $fn);
786 while (my $line = <$fh>) {
787 last if ($line =~ /^$/);
788 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
794 foreach my $f (@files) {
795 next unless (body_or_subject_has_nonascii
($f)
796 && !file_declares_8bit_cte
($f));
797 $broken_encoding{$f} = 1;
800 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
801 print __
("The following files are 8bit, but do not declare " .
802 "a Content-Transfer-Encoding.\n");
803 foreach my $f (sort keys %broken_encoding) {
806 $auto_8bit_encoding = ask
(__
("Which 8bit encoding should I declare [UTF-8]? "),
807 valid_re
=> qr/.{4}/, confirm_only
=> 1,
813 if (get_patch_subject
($f) =~ /\Q*** SUBJECT HERE ***\E/) {
814 die "Refusing to send because the patch\n\t$f\n"
815 . "has the template subject '*** SUBJECT HERE ***'. "
816 . "Pass --force if you really want to send.\n";
821 if (defined $sender) {
822 $sender =~ s/^\s+|\s+$//g;
823 ($sender) = expand_aliases
($sender);
825 $sender = $repoauthor || $repocommitter || '';
828 # $sender could be an already sanitized address
829 # (e.g. sendemail.from could be manually sanitized by user).
830 # But it's a no-op to run sanitize_address on an already sanitized address.
831 $sender = sanitize_address
($sender);
833 my $to_whom = __
("To whom should the emails be sent (if anyone)?");
835 if (!@initial_to && !defined $to_cmd) {
836 my $to = ask
("$to_whom ",
838 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
839 push @initial_to, parse_address_line
($to) if defined $to; # sanitized/validated later
844 return map { expand_one_alias
($_) } @_;
847 my %EXPANDED_ALIASES;
848 sub expand_one_alias
{
850 if ($EXPANDED_ALIASES{$alias}) {
851 die "fatal: alias '$alias' expands to itself\n";
853 local $EXPANDED_ALIASES{$alias} = 1;
854 return $aliases{$alias} ? expand_aliases
(@
{$aliases{$alias}}) : $alias;
857 @initial_to = process_address_list
(@initial_to);
858 @initial_cc = process_address_list
(@initial_cc);
859 @bcclist = process_address_list
(@bcclist);
861 if ($thread && !defined $initial_reply_to && $prompting) {
862 $initial_reply_to = ask
(
863 __
("Message-ID to be used as In-Reply-To for the first email (if any)? "),
865 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
867 if (defined $initial_reply_to) {
868 $initial_reply_to =~ s/^\s*<?//;
869 $initial_reply_to =~ s/>?\s*$//;
870 $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
873 if (!defined $smtp_server) {
874 foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
880 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
883 if ($compose && $compose > 0) {
884 @files = ($compose_filename . ".final", @files);
887 # Variables we set as part of the loop over files
888 our ($message_id, %mail, $subject, $reply_to, $references, $message,
889 $needs_confirm, $message_num, $ask_default);
891 sub extract_valid_address
{
893 my $local_part_regexp = qr/[^<>"\s@]+/;
894 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
896 # check for a local address:
897 return $address if ($address =~ /^($local_part_regexp)$/);
899 $address =~ s/^\s*<(.*)>\s*$/$1/;
900 if ($have_email_valid) {
901 return scalar Email
::Valid
->address($address);
904 # less robust/correct than the monster regexp in Email::Valid,
905 # but still does a 99% job, and one less dependency
906 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
910 sub extract_valid_address_or_die
{
912 $address = extract_valid_address
($address);
913 die "error: unable to extract a valid address from: $address\n"
918 sub validate_address
{
920 while (!extract_valid_address
($address)) {
921 print STDERR
"error: unable to extract a valid address from: $address\n";
922 # TRANSLATORS: Make sure to include [q] [d] [e] in your
923 # translation. The program will only accept English input
925 $_ = ask
(__
("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
926 valid_re
=> qr/^(?:quit|q|drop|d|edit|e)/i,
931 cleanup_compose_files
();
934 $address = ask
("$to_whom ",
936 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
941 sub validate_address_list
{
942 return (grep { defined $_ }
943 map { validate_address
($_) } @_);
946 # Usually don't need to change anything below here.
948 # we make a "fake" message id by taking the current number
949 # of seconds since the beginning of Unix time and tacking on
950 # a random number to the end, in case we are called quicker than
951 # 1 second since the last time we were called.
953 # We'll setup a template for the message id, using the "from" address:
955 my ($message_id_stamp, $message_id_serial);
956 sub make_message_id
{
958 if (!defined $message_id_stamp) {
959 $message_id_stamp = strftime
("%Y%m%d%H%M%S.$$", gmtime(time));
960 $message_id_serial = 0;
962 $message_id_serial++;
963 $uniq = "$message_id_stamp-$message_id_serial";
966 for ($sender, $repocommitter, $repoauthor) {
967 $du_part = extract_valid_address
(sanitize_address
($_));
968 last if (defined $du_part and $du_part ne '');
970 if (not defined $du_part or $du_part eq '') {
971 require Sys
::Hostname
;
972 $du_part = 'user@' . Sys
::Hostname
::hostname
();
974 my $message_id_template = "<%s-%s>";
975 $message_id = sprintf($message_id_template, $uniq, $du_part);
976 #print "new message id = $message_id\n"; # Was useful for debugging
981 $time = time - scalar $#files;
983 sub unquote_rfc2047
{
986 my $sep = qr/[ \t]+/;
987 s
{$re_encoded_word(?
:$sep$re_encoded_word)*}{
988 my @words = split $sep, $&;
994 if ($encoding eq 'q' || $encoding eq 'Q') {
997 s/=([0-9A-F]{2})/chr(hex($1))/egi;
999 # other encodings not supported yet
1004 return wantarray ?
($_, $charset) : $_;
1009 my $encoding = shift || 'UTF-8';
1010 s/([^-a-zA-Z0-9!*+\/])/sprintf
("=%02X", ord($1))/eg
;
1011 s/(.*)/=\?$encoding\?q\?$1\?=/;
1015 sub is_rfc2047_quoted
{
1018 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1021 sub subject_needs_rfc2047_quoting
{
1024 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1028 local $subject = shift;
1029 my $encoding = shift || 'UTF-8';
1031 if (subject_needs_rfc2047_quoting
($subject)) {
1032 return quote_rfc2047
($subject, $encoding);
1037 # use the simplest quoting being able to handle the recipient
1038 sub sanitize_address
{
1039 my ($recipient) = @_;
1041 # remove garbage after email address
1042 $recipient =~ s/(.*>).*$/$1/;
1044 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1046 if (not $recipient_name) {
1050 # if recipient_name is already quoted, do nothing
1051 if (is_rfc2047_quoted
($recipient_name)) {
1055 # remove non-escaped quotes
1056 $recipient_name =~ s/(^|[^\\])"/$1/g;
1058 # rfc2047 is needed if a non-ascii char is included
1059 if ($recipient_name =~ /[^[:ascii:]]/) {
1060 $recipient_name = quote_rfc2047
($recipient_name);
1063 # double quotes are needed if specials or CTLs are included
1064 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1065 $recipient_name =~ s/([\\\r])/\\$1/g;
1066 $recipient_name = qq["$recipient_name"];
1069 return "$recipient_name $recipient_addr";
1073 sub sanitize_address_list
{
1074 return (map { sanitize_address
($_) } @_);
1077 sub process_address_list
{
1078 my @addr_list = map { parse_address_line
($_) } @_;
1079 @addr_list = expand_aliases
(@addr_list);
1080 @addr_list = sanitize_address_list
(@addr_list);
1081 @addr_list = validate_address_list
(@addr_list);
1085 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1087 # Tightly configured MTAa require that a caller sends a real DNS
1088 # domain name that corresponds the IP address in the HELO/EHLO
1089 # handshake. This is used to verify the connection and prevent
1090 # spammers from trying to hide their identity. If the DNS and IP don't
1091 # match, the receiveing MTA may deny the connection.
1093 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1095 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1096 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1098 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1099 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1103 return defined $domain && !($^O
eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1106 sub maildomain_net
{
1109 if (eval { require Net
::Domain
; 1 }) {
1110 my $domain = Net
::Domain
::domainname
();
1111 $maildomain = $domain if valid_fqdn
($domain);
1117 sub maildomain_mta
{
1120 if (eval { require Net
::SMTP
; 1 }) {
1121 for my $host (qw(mailhost localhost)) {
1122 my $smtp = Net
::SMTP
->new($host);
1123 if (defined $smtp) {
1124 my $domain = $smtp->domain;
1127 $maildomain = $domain if valid_fqdn
($domain);
1129 last if $maildomain;
1138 return maildomain_net
() || maildomain_mta
() || 'localhost.localdomain';
1141 sub smtp_host_string
{
1142 if (defined $smtp_server_port) {
1143 return "$smtp_server:$smtp_server_port";
1145 return $smtp_server;
1149 # Returns 1 if authentication succeeded or was not necessary
1150 # (smtp_user was not specified), and 0 otherwise.
1152 sub smtp_auth_maybe
{
1153 if (!defined $smtp_authuser || $auth) {
1157 # Workaround AUTH PLAIN/LOGIN interaction defect
1158 # with Authen::SASL::Cyrus
1160 require Authen
::SASL
;
1161 Authen
::SASL
->import(qw(Perl));
1164 # Check mechanism naming as defined in:
1165 # https://tools.ietf.org/html/rfc4422#page-8
1166 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1167 die "invalid smtp auth: '${smtp_auth}'";
1170 # TODO: Authentication may fail not because credentials were
1171 # invalid but due to other reasons, in which we should not
1172 # reject credentials.
1173 $auth = Git
::credential
({
1174 'protocol' => 'smtp',
1175 'host' => smtp_host_string
(),
1176 'username' => $smtp_authuser,
1177 # if there's no password, "git credential fill" will
1178 # give us one, otherwise it'll just pass this one.
1179 'password' => $smtp_authpass
1184 my $sasl = Authen
::SASL
->new(
1185 mechanism
=> $smtp_auth,
1187 user
=> $cred->{'username'},
1188 pass
=> $cred->{'password'},
1189 authname
=> $cred->{'username'},
1193 return !!$smtp->auth($sasl);
1196 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1202 sub ssl_verify_params
{
1204 require IO
::Socket
::SSL
;
1205 IO
::Socket
::SSL
->import(qw
/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1208 print STDERR
"Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1212 if (!defined $smtp_ssl_cert_path) {
1213 # use the OpenSSL defaults
1214 return (SSL_verify_mode
=> SSL_VERIFY_PEER
());
1217 if ($smtp_ssl_cert_path eq "") {
1218 return (SSL_verify_mode
=> SSL_VERIFY_NONE
());
1219 } elsif (-d
$smtp_ssl_cert_path) {
1220 return (SSL_verify_mode
=> SSL_VERIFY_PEER
(),
1221 SSL_ca_path
=> $smtp_ssl_cert_path);
1222 } elsif (-f
$smtp_ssl_cert_path) {
1223 return (SSL_verify_mode
=> SSL_VERIFY_PEER
(),
1224 SSL_ca_file
=> $smtp_ssl_cert_path);
1226 die "CA path \"$smtp_ssl_cert_path\" does not exist";
1230 sub file_name_is_absolute
{
1233 # msys does not grok DOS drive-prefixes
1234 if ($^O
eq 'msys') {
1235 return ($path =~ m
#^/# || $path =~ m#^[a-zA-Z]\:#)
1238 require File
::Spec
::Functions
;
1239 return File
::Spec
::Functions
::file_name_is_absolute
($path);
1242 # Returns 1 if the message was sent, and 0 otherwise.
1243 # In actuality, the whole program dies when there
1244 # is an error sending a message.
1247 my @recipients = unique_email_list
(@to);
1248 @cc = (grep { my $cc = extract_valid_address_or_die
($_);
1249 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1252 my $to = join (",\n\t", @recipients);
1253 @recipients = unique_email_list
(@recipients,@cc,@bcclist);
1254 @recipients = (map { extract_valid_address_or_die
($_) } @recipients);
1255 my $date = format_2822_time
($time++);
1256 my $gitversion = '@@GIT_VERSION@@';
1257 if ($gitversion =~ m/..GIT_VERSION../) {
1258 $gitversion = Git
::version
();
1261 my $cc = join(",\n\t", unique_email_list
(@cc));
1264 $ccline = "\nCc: $cc";
1266 make_message_id
() unless defined($message_id);
1268 my $header = "From: $sender
1272 Message-Id: $message_id
1275 $header .= "X-Mailer: git-send-email $gitversion\n";
1279 $header .= "In-Reply-To: $reply_to\n";
1280 $header .= "References: $references\n";
1283 $header .= join("\n", @xh) . "\n";
1286 my @sendmail_parameters = ('-i', @recipients);
1287 my $raw_from = $sender;
1288 if (defined $envelope_sender && $envelope_sender ne "auto") {
1289 $raw_from = $envelope_sender;
1291 $raw_from = extract_valid_address
($raw_from);
1292 unshift (@sendmail_parameters,
1293 '-f', $raw_from) if(defined $envelope_sender);
1295 if ($needs_confirm && !$dry_run) {
1296 print "\n$header\n";
1297 if ($needs_confirm eq "inform") {
1298 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1299 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1301 The Cc list above has been expanded by additional
1302 addresses found in the patch commit message. By default
1303 send-email prompts before sending whenever this occurs.
1304 This behavior is controlled by the sendemail.confirm
1305 configuration setting.
1307 For additional information, run 'git send-email --help'.
1308 To retain the current behavior, but squelch this message,
1309 run 'git config --global sendemail.confirm auto'.
1313 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1314 # translation. The program will only accept English input
1316 $_ = ask
(__
("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1317 valid_re
=> qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1318 default => $ask_default);
1319 die "Send this email reply required" unless defined $_;
1323 cleanup_compose_files
();
1330 unshift (@sendmail_parameters, @smtp_server_options);
1333 # We don't want to send the email.
1334 } elsif (file_name_is_absolute
($smtp_server)) {
1335 my $pid = open my $sm, '|-';
1336 defined $pid or die $!;
1338 exec($smtp_server, @sendmail_parameters) or die $!;
1340 print $sm "$header\n$message";
1341 close $sm or die $!;
1344 if (!defined $smtp_server) {
1345 die "The required SMTP server is not properly defined."
1348 if ($smtp_encryption eq 'ssl') {
1349 $smtp_server_port ||= 465; # ssmtp
1350 require Net
::SMTP
::SSL
;
1351 $smtp_domain ||= maildomain
();
1352 require IO
::Socket
::SSL
;
1354 # Suppress "variable accessed once" warning.
1357 $IO::Socket
::SSL
::DEBUG
= 1;
1360 # Net::SMTP::SSL->new() does not forward any SSL options
1361 IO
::Socket
::SSL
::set_client_defaults
(
1362 ssl_verify_params
());
1363 $smtp ||= Net
::SMTP
::SSL
->new($smtp_server,
1364 Hello
=> $smtp_domain,
1365 Port
=> $smtp_server_port,
1366 Debug
=> $debug_net_smtp);
1370 $smtp_domain ||= maildomain
();
1371 $smtp_server_port ||= 25;
1372 $smtp ||= Net
::SMTP
->new($smtp_server,
1373 Hello
=> $smtp_domain,
1374 Debug
=> $debug_net_smtp,
1375 Port
=> $smtp_server_port);
1376 if ($smtp_encryption eq 'tls' && $smtp) {
1377 require Net
::SMTP
::SSL
;
1378 $smtp->command('STARTTLS');
1380 if ($smtp->code == 220) {
1381 $smtp = Net
::SMTP
::SSL
->start_SSL($smtp,
1382 ssl_verify_params
())
1383 or die "STARTTLS failed! ".IO
::Socket
::SSL
::errstr
();
1384 $smtp_encryption = '';
1385 # Send EHLO again to receive fresh
1386 # supported commands
1387 $smtp->hello($smtp_domain);
1389 die "Server does not support STARTTLS! ".$smtp->message;
1395 die "Unable to initialize SMTP properly. Check config and use --smtp-debug. ",
1396 "VALUES: server=$smtp_server ",
1397 "encryption=$smtp_encryption ",
1398 "hello=$smtp_domain",
1399 defined $smtp_server_port ?
" port=$smtp_server_port" : "";
1402 smtp_auth_maybe
or die $smtp->message;
1404 $smtp->mail( $raw_from ) or die $smtp->message;
1405 $smtp->to( @recipients ) or die $smtp->message;
1406 $smtp->data or die $smtp->message;
1407 $smtp->datasend("$header\n") or die $smtp->message;
1408 my @lines = split /^/, $message;
1409 foreach my $line (@lines) {
1410 $smtp->datasend("$line") or die $smtp->message;
1412 $smtp->dataend() or die $smtp->message;
1413 $smtp->code =~ /250|200/ or die "Failed to send $subject\n".$smtp->message;
1416 printf (($dry_run ?
"Dry-" : "")."Sent %s\n", $subject);
1418 print($dry_run ? __
("Dry-OK. Log says:\n") : __
("OK. Log says:\n"));
1419 if (!file_name_is_absolute
($smtp_server)) {
1420 print "Server: $smtp_server\n";
1421 print "MAIL FROM:<$raw_from>\n";
1422 foreach my $entry (@recipients) {
1423 print "RCPT TO:<$entry>\n";
1426 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1428 print $header, "\n";
1430 print "Result: ", $smtp->code, ' ',
1431 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1433 print "Result: OK\n";
1440 $reply_to = $initial_reply_to;
1441 $references = $initial_reply_to || '';
1442 $subject = $initial_subject;
1445 foreach my $t (@files) {
1446 open my $fh, "<", $t or die "can't open file $t";
1449 my $sauthor = undef;
1450 my $author_encoding;
1451 my $has_content_type;
1454 my $has_mime_version;
1458 my $input_format = undef;
1462 # First unfold multiline header fields
1465 if (/^\s+\S/ and @header) {
1466 chomp($header[$#header]);
1468 $header[$#header] .= $_;
1473 # Now parse the header
1476 $input_format = 'mbox';
1480 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1481 $input_format = 'mbox';
1484 if (defined $input_format && $input_format eq 'mbox') {
1485 if (/^Subject:\s+(.*)$/i) {
1488 elsif (/^From:\s+(.*)$/i) {
1489 ($author, $author_encoding) = unquote_rfc2047
($1);
1490 $sauthor = sanitize_address
($author);
1491 next if $suppress_cc{'author'};
1492 next if $suppress_cc{'self'} and $sauthor eq $sender;
1493 printf(__
("(mbox) Adding cc: %s from line '%s'\n"),
1494 $1, $_) unless $quiet;
1497 elsif (/^To:\s+(.*)$/i) {
1498 foreach my $addr (parse_address_line
($1)) {
1499 printf(__
("(mbox) Adding to: %s from line '%s'\n"),
1500 $addr, $_) unless $quiet;
1504 elsif (/^Cc:\s+(.*)$/i) {
1505 foreach my $addr (parse_address_line
($1)) {
1506 my $qaddr = unquote_rfc2047
($addr);
1507 my $saddr = sanitize_address
($qaddr);
1508 if ($saddr eq $sender) {
1509 next if ($suppress_cc{'self'});
1511 next if ($suppress_cc{'cc'});
1513 printf(__
("(mbox) Adding cc: %s from line '%s'\n"),
1514 $addr, $_) unless $quiet;
1518 elsif (/^Content-type:/i) {
1519 $has_content_type = 1;
1520 if (/charset="?([^ "]+)/) {
1521 $body_encoding = $1;
1525 elsif (/^MIME-Version/i) {
1526 $has_mime_version = 1;
1529 elsif (/^Message-Id: (.*)/i) {
1532 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1533 $xfer_encoding = $1 if not defined $xfer_encoding;
1535 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1540 # In the traditional
1541 # "send lots of email" format,
1544 # So let's support that, too.
1545 $input_format = 'lots';
1546 if (@cc == 0 && !$suppress_cc{'cc'}) {
1547 printf(__
("(non-mbox) Adding cc: %s from line '%s'\n"),
1548 $_, $_) unless $quiet;
1550 } elsif (!defined $subject) {
1555 # Now parse the message body
1558 if (/^(Signed-off-by|Cc): (.*)$/i) {
1560 my ($what, $c) = ($1, $2);
1562 my $sc = sanitize_address
($c);
1563 if ($sc eq $sender) {
1564 next if ($suppress_cc{'self'});
1566 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1567 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1570 printf(__
("(body) Adding cc: %s from line '%s'\n"),
1571 $c, $_) unless $quiet;
1576 push @to, recipients_cmd
("to-cmd", "to", $to_cmd, $t)
1578 push @cc, recipients_cmd
("cc-cmd", "cc", $cc_cmd, $t)
1579 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1581 if ($broken_encoding{$t} && !$has_content_type) {
1582 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1583 $has_content_type = 1;
1584 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1585 $body_encoding = $auto_8bit_encoding;
1588 if ($broken_encoding{$t} && !is_rfc2047_quoted
($subject)) {
1589 $subject = quote_subject
($subject, $auto_8bit_encoding);
1592 if (defined $sauthor and $sauthor ne $sender) {
1593 $message = "From: $author\n\n$message";
1594 if (defined $author_encoding) {
1595 if ($has_content_type) {
1596 if ($body_encoding eq $author_encoding) {
1597 # ok, we already have the right encoding
1600 # uh oh, we should re-encode
1604 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1605 $has_content_type = 1;
1607 "Content-Type: text/plain; charset=$author_encoding";
1611 if (defined $target_xfer_encoding) {
1612 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1613 $message = apply_transfer_encoding
(
1614 $message, $xfer_encoding, $target_xfer_encoding);
1615 $xfer_encoding = $target_xfer_encoding;
1617 if (defined $xfer_encoding) {
1618 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1620 if (defined $xfer_encoding or $has_content_type) {
1621 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1625 $confirm eq "always" or
1626 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1627 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1628 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1630 @to = process_address_list
(@to);
1631 @cc = process_address_list
(@cc);
1633 @to = (@initial_to, @to);
1634 @cc = (@initial_cc, @cc);
1636 if ($message_num == 1) {
1637 if (defined $cover_cc and $cover_cc) {
1640 if (defined $cover_to and $cover_to) {
1645 my $message_was_sent = send_message
();
1647 # set up for the next message
1648 if ($thread && $message_was_sent &&
1649 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1650 $message_num == 1)) {
1651 $reply_to = $message_id;
1652 if (length $references > 0) {
1653 $references .= "\n $message_id";
1655 $references = "$message_id";
1658 $message_id = undef;
1661 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1662 # and return a results array
1663 sub recipients_cmd
{
1664 my ($prefix, $what, $cmd, $file) = @_;
1667 open my $fh, "-|", "$cmd \Q$file\E"
1668 or die "($prefix) Could not execute '$cmd'";
1669 while (my $address = <$fh>) {
1670 $address =~ s/^\s*//g;
1671 $address =~ s/\s*$//g;
1672 $address = sanitize_address
($address);
1673 next if ($address eq $sender and $suppress_cc{'self'});
1674 push @addresses, $address;
1675 printf("($prefix) Adding %s: %s from: '%s'\n",
1676 $what, $address, $cmd) unless $quiet;
1679 or die "($prefix) failed to close pipe to '$cmd'";
1683 cleanup_compose_files
();
1685 sub cleanup_compose_files
{
1686 unlink($compose_filename, $compose_filename . ".final") if $compose;
1689 $smtp->quit if $smtp;
1691 sub apply_transfer_encoding
{
1692 my $message = shift;
1696 return $message if ($from eq $to and $from ne '7bit');
1698 require MIME
::QuotedPrint
;
1699 require MIME
::Base64
;
1701 $message = MIME
::QuotedPrint
::decode
($message)
1702 if ($from eq 'quoted-printable');
1703 $message = MIME
::Base64
::decode
($message)
1704 if ($from eq 'base64');
1706 die "cannot send message as 7bit"
1707 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1709 if ($to eq '7bit' or $to eq '8bit');
1710 return MIME
::QuotedPrint
::encode
($message, "\n", 0)
1711 if ($to eq 'quoted-printable');
1712 return MIME
::Base64
::encode
($message, "\n")
1713 if ($to eq 'base64');
1714 die "invalid transfer encoding";
1717 sub unique_email_list
{
1721 foreach my $entry (@_) {
1722 my $clean = extract_valid_address_or_die
($entry);
1723 $seen{$clean} ||= 0;
1724 next if $seen{$clean}++;
1725 push @emails, $entry;
1730 sub validate_patch
{
1732 open(my $fh, '<', $fn)
1733 or die "unable to open $fn: $!\n";
1734 while (my $line = <$fh>) {
1735 if (length($line) > 998) {
1736 return "$.: patch contains a line longer than 998 characters";
1743 my ($last, $lastlen, $file, $known_suffix) = @_;
1744 my ($suffix, $skip);
1747 if (defined $last &&
1748 ($lastlen < length($file)) &&
1749 (substr($file, 0, $lastlen) eq $last) &&
1750 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1751 if (defined $known_suffix && $suffix eq $known_suffix) {
1752 print "Skipping $file with backup suffix '$known_suffix'.\n";
1755 my $answer = ask
("Do you really want to send $file? (y|N): ",
1756 valid_re
=> qr/^(?:y|n)/i,
1758 $skip = ($answer ne 'y');
1760 $known_suffix = $suffix;
1764 return ($skip, $known_suffix);
1767 sub handle_backup_files
{
1769 my ($last, $lastlen, $known_suffix, $skip, @result);
1770 for my $file (@file) {
1771 ($skip, $known_suffix) = handle_backup
($last, $lastlen,
1772 $file, $known_suffix);
1773 push @result, $file unless $skip;
1775 $lastlen = length($file);
1780 sub file_has_nonascii
{
1782 open(my $fh, '<', $fn)
1783 or die "unable to open $fn: $!\n";
1784 while (my $line = <$fh>) {
1785 return 1 if $line =~ /[^[:ascii:]]/;
1790 sub body_or_subject_has_nonascii
{
1792 open(my $fh, '<', $fn)
1793 or die "unable to open $fn: $!\n";
1794 while (my $line = <$fh>) {
1795 last if $line =~ /^$/;
1796 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1798 while (my $line = <$fh>) {
1799 return 1 if $line =~ /[^[:ascii:]]/;