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