object-store: factor out odb_clear_loose_cache()
[git/raj.git] / git-send-email.perl
blob8eb63b5a2f8d07038f6c8ef645a483cd77ffd99f
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 Git::LoadCPAN::Error qw(:try);
30 use Cwd qw(abs_path cwd);
31 use Git;
32 use Git::I18N;
33 use Net::Domain ();
34 use Net::SMTP ();
35 use Git::LoadCPAN::Mail::Address;
37 Getopt::Long::Configure qw/ pass_through /;
39 package FakeTerm;
40 sub new {
41 my ($class, $reason) = @_;
42 return bless \$reason, shift;
44 sub readline {
45 my $self = shift;
46 die "Cannot use readline on FakeTerm: $$self";
48 package main;
51 sub usage {
52 print <<EOT;
53 git send-email [options] <file | directory | rev-list options >
54 git send-email --dump-aliases
56 Composing:
57 --from <str> * Email From:
58 --[no-]to <str> * Email To:
59 --[no-]cc <str> * Email Cc:
60 --[no-]bcc <str> * Email Bcc:
61 --subject <str> * Email "Subject:"
62 --reply-to <str> * Email "Reply-To:"
63 --in-reply-to <str> * Email "In-Reply-To:"
64 --[no-]xmailer * Add "X-Mailer:" header (default).
65 --[no-]annotate * Review each patch that will be sent in an editor.
66 --compose * Open an editor for introduction.
67 --compose-encoding <str> * Encoding to assume for introduction.
68 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
69 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
71 Sending:
72 --envelope-sender <str> * Email envelope sender.
73 --smtp-server <str:int> * Outgoing SMTP server to use. The port
74 is optional. Default 'localhost'.
75 --smtp-server-option <str> * Outgoing SMTP server option to use.
76 --smtp-server-port <int> * Outgoing SMTP server port.
77 --smtp-user <str> * Username for SMTP-AUTH.
78 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
79 --smtp-encryption <str> * tls or ssl; anything else disables.
80 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
81 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
82 Pass an empty string to disable certificate
83 verification.
84 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
85 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms, or
86 "none" to disable authentication.
87 This setting forces to use one of the listed mechanisms.
88 --no-smtp-auth Disable SMTP authentication. Shorthand for
89 `--smtp-auth=none`
90 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
92 --batch-size <int> * send max <int> message per connection.
93 --relogin-delay <int> * delay <int> seconds between two successive login.
94 This option can only be used with --batch-size
96 Automating:
97 --identity <str> * Use the sendemail.<id> options.
98 --to-cmd <str> * Email To: via `<str> \$patch_path`
99 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
100 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, misc-by, all.
101 --[no-]cc-cover * Email Cc: addresses in the cover letter.
102 --[no-]to-cover * Email To: addresses in the cover letter.
103 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
104 --[no-]suppress-from * Send to self. Default off.
105 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
106 --[no-]thread * Use In-Reply-To: field. Default on.
108 Administering:
109 --confirm <str> * Confirm recipients before sending;
110 auto, cc, compose, always, or never.
111 --quiet * Output one line of info per email.
112 --dry-run * Don't actually send the emails.
113 --[no-]validate * Perform patch sanity checks. Default on.
114 --[no-]format-patch * understand any non optional arguments as
115 `git format-patch` ones.
116 --force * Send even if safety checks would prevent it.
118 Information:
119 --dump-aliases * Dump configured aliases and exit.
122 exit(1);
125 sub completion_helper {
126 print Git::command('format-patch', '--git-completion-helper');
127 exit(0);
130 # most mail servers generate the Date: header, but not all...
131 sub format_2822_time {
132 my ($time) = @_;
133 my @localtm = localtime($time);
134 my @gmttm = gmtime($time);
135 my $localmin = $localtm[1] + $localtm[2] * 60;
136 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
137 if ($localtm[0] != $gmttm[0]) {
138 die __("local zone differs from GMT by a non-minute interval\n");
140 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
141 $localmin += 1440;
142 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
143 $localmin -= 1440;
144 } elsif ($gmttm[6] != $localtm[6]) {
145 die __("local time offset greater than or equal to 24 hours\n");
147 my $offset = $localmin - $gmtmin;
148 my $offhour = $offset / 60;
149 my $offmin = abs($offset % 60);
150 if (abs($offhour) >= 24) {
151 die __("local time offset greater than or equal to 24 hours\n");
154 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
155 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
156 $localtm[3],
157 qw(Jan Feb Mar Apr May Jun
158 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
159 $localtm[5]+1900,
160 $localtm[2],
161 $localtm[1],
162 $localtm[0],
163 ($offset >= 0) ? '+' : '-',
164 abs($offhour),
165 $offmin,
169 my $have_email_valid = eval { require Email::Valid; 1 };
170 my $smtp;
171 my $auth;
172 my $num_sent = 0;
174 # Regexes for RFC 2047 productions.
175 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
176 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
177 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
179 # Variables we fill in automatically, or via prompting:
180 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
181 $initial_in_reply_to,$reply_to,$initial_subject,@files,
182 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
184 my $envelope_sender;
186 # Example reply to:
187 #$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
189 my $repo = eval { Git->repository() };
190 my @repo = $repo ? ($repo) : ();
191 my $term = eval {
192 $ENV{"GIT_SEND_EMAIL_NOTTY"}
193 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
194 : new Term::ReadLine 'git-send-email';
196 if ($@) {
197 $term = new FakeTerm "$@: going non-interactive";
200 # Behavior modification variables
201 my ($quiet, $dry_run) = (0, 0);
202 my $format_patch;
203 my $compose_filename;
204 my $force = 0;
205 my $dump_aliases = 0;
207 # Handle interactive edition of files.
208 my $multiedit;
209 my $editor;
211 sub do_edit {
212 if (!defined($editor)) {
213 $editor = Git::command_oneline('var', 'GIT_EDITOR');
215 if (defined($multiedit) && !$multiedit) {
216 map {
217 system('sh', '-c', $editor.' "$@"', $editor, $_);
218 if (($? & 127) || ($? >> 8)) {
219 die(__("the editor exited uncleanly, aborting everything"));
221 } @_;
222 } else {
223 system('sh', '-c', $editor.' "$@"', $editor, @_);
224 if (($? & 127) || ($? >> 8)) {
225 die(__("the editor exited uncleanly, aborting everything"));
230 # Variables with corresponding config settings
231 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
232 my ($cover_cc, $cover_to);
233 my ($to_cmd, $cc_cmd);
234 my ($smtp_server, $smtp_server_port, @smtp_server_options);
235 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
236 my ($batch_size, $relogin_delay);
237 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
238 my ($validate, $confirm);
239 my (@suppress_cc);
240 my ($auto_8bit_encoding);
241 my ($compose_encoding);
242 my $target_xfer_encoding = 'auto';
244 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
246 my %config_bool_settings = (
247 "thread" => [\$thread, 1],
248 "chainreplyto" => [\$chain_reply_to, 0],
249 "suppressfrom" => [\$suppress_from, undef],
250 "signedoffbycc" => [\$signed_off_by_cc, undef],
251 "cccover" => [\$cover_cc, undef],
252 "tocover" => [\$cover_to, undef],
253 "signedoffcc" => [\$signed_off_by_cc, undef], # Deprecated
254 "validate" => [\$validate, 1],
255 "multiedit" => [\$multiedit, undef],
256 "annotate" => [\$annotate, undef],
257 "xmailer" => [\$use_xmailer, 1]
260 my %config_settings = (
261 "smtpserver" => \$smtp_server,
262 "smtpserverport" => \$smtp_server_port,
263 "smtpserveroption" => \@smtp_server_options,
264 "smtpuser" => \$smtp_authuser,
265 "smtppass" => \$smtp_authpass,
266 "smtpdomain" => \$smtp_domain,
267 "smtpauth" => \$smtp_auth,
268 "smtpbatchsize" => \$batch_size,
269 "smtprelogindelay" => \$relogin_delay,
270 "to" => \@initial_to,
271 "tocmd" => \$to_cmd,
272 "cc" => \@initial_cc,
273 "cccmd" => \$cc_cmd,
274 "aliasfiletype" => \$aliasfiletype,
275 "bcc" => \@bcclist,
276 "suppresscc" => \@suppress_cc,
277 "envelopesender" => \$envelope_sender,
278 "confirm" => \$confirm,
279 "from" => \$sender,
280 "assume8bitencoding" => \$auto_8bit_encoding,
281 "composeencoding" => \$compose_encoding,
282 "transferencoding" => \$target_xfer_encoding,
285 my %config_path_settings = (
286 "aliasesfile" => \@alias_files,
287 "smtpsslcertpath" => \$smtp_ssl_cert_path,
290 # Handle Uncouth Termination
291 sub signal_handler {
293 # Make text normal
294 print color("reset"), "\n";
296 # SMTP password masked
297 system "stty echo";
299 # tmp files from --compose
300 if (defined $compose_filename) {
301 if (-e $compose_filename) {
302 printf __("'%s' contains an intermediate version ".
303 "of the email you were composing.\n"),
304 $compose_filename;
306 if (-e ($compose_filename . ".final")) {
307 printf __("'%s.final' contains the composed email.\n"),
308 $compose_filename;
312 exit;
315 $SIG{TERM} = \&signal_handler;
316 $SIG{INT} = \&signal_handler;
318 # Begin by accumulating all the variables (defined above), that we will end up
319 # needing, first, from the command line:
321 my $help;
322 my $git_completion_helper;
323 my $rc = GetOptions("h" => \$help,
324 "dump-aliases" => \$dump_aliases);
325 usage() unless $rc;
326 die __("--dump-aliases incompatible with other options\n")
327 if !$help and $dump_aliases and @ARGV;
328 $rc = GetOptions(
329 "sender|from=s" => \$sender,
330 "in-reply-to=s" => \$initial_in_reply_to,
331 "reply-to=s" => \$reply_to,
332 "subject=s" => \$initial_subject,
333 "to=s" => \@initial_to,
334 "to-cmd=s" => \$to_cmd,
335 "no-to" => \$no_to,
336 "cc=s" => \@initial_cc,
337 "no-cc" => \$no_cc,
338 "bcc=s" => \@bcclist,
339 "no-bcc" => \$no_bcc,
340 "chain-reply-to!" => \$chain_reply_to,
341 "no-chain-reply-to" => sub {$chain_reply_to = 0},
342 "smtp-server=s" => \$smtp_server,
343 "smtp-server-option=s" => \@smtp_server_options,
344 "smtp-server-port=s" => \$smtp_server_port,
345 "smtp-user=s" => \$smtp_authuser,
346 "smtp-pass:s" => \$smtp_authpass,
347 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
348 "smtp-encryption=s" => \$smtp_encryption,
349 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
350 "smtp-debug:i" => \$debug_net_smtp,
351 "smtp-domain:s" => \$smtp_domain,
352 "smtp-auth=s" => \$smtp_auth,
353 "no-smtp-auth" => sub {$smtp_auth = 'none'},
354 "identity=s" => \$identity,
355 "annotate!" => \$annotate,
356 "no-annotate" => sub {$annotate = 0},
357 "compose" => \$compose,
358 "quiet" => \$quiet,
359 "cc-cmd=s" => \$cc_cmd,
360 "suppress-from!" => \$suppress_from,
361 "no-suppress-from" => sub {$suppress_from = 0},
362 "suppress-cc=s" => \@suppress_cc,
363 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
364 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
365 "cc-cover|cc-cover!" => \$cover_cc,
366 "no-cc-cover" => sub {$cover_cc = 0},
367 "to-cover|to-cover!" => \$cover_to,
368 "no-to-cover" => sub {$cover_to = 0},
369 "confirm=s" => \$confirm,
370 "dry-run" => \$dry_run,
371 "envelope-sender=s" => \$envelope_sender,
372 "thread!" => \$thread,
373 "no-thread" => sub {$thread = 0},
374 "validate!" => \$validate,
375 "no-validate" => sub {$validate = 0},
376 "transfer-encoding=s" => \$target_xfer_encoding,
377 "format-patch!" => \$format_patch,
378 "no-format-patch" => sub {$format_patch = 0},
379 "8bit-encoding=s" => \$auto_8bit_encoding,
380 "compose-encoding=s" => \$compose_encoding,
381 "force" => \$force,
382 "xmailer!" => \$use_xmailer,
383 "no-xmailer" => sub {$use_xmailer = 0},
384 "batch-size=i" => \$batch_size,
385 "relogin-delay=i" => \$relogin_delay,
386 "git-completion-helper" => \$git_completion_helper,
389 usage() if $help;
390 completion_helper() if $git_completion_helper;
391 unless ($rc) {
392 usage();
395 die __("Cannot run git format-patch from outside a repository\n")
396 if $format_patch and not $repo;
398 die __("`batch-size` and `relogin` must be specified together " .
399 "(via command-line or configuration option)\n")
400 if defined $relogin_delay and not defined $batch_size;
402 # Now, let's fill any that aren't set in with defaults:
404 sub read_config {
405 my ($prefix) = @_;
407 foreach my $setting (keys %config_bool_settings) {
408 my $target = $config_bool_settings{$setting}->[0];
409 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
412 foreach my $setting (keys %config_path_settings) {
413 my $target = $config_path_settings{$setting};
414 if (ref($target) eq "ARRAY") {
415 unless (@$target) {
416 my @values = Git::config_path(@repo, "$prefix.$setting");
417 @$target = @values if (@values && defined $values[0]);
420 else {
421 $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
425 foreach my $setting (keys %config_settings) {
426 my $target = $config_settings{$setting};
427 next if $setting eq "to" and defined $no_to;
428 next if $setting eq "cc" and defined $no_cc;
429 next if $setting eq "bcc" and defined $no_bcc;
430 if (ref($target) eq "ARRAY") {
431 unless (@$target) {
432 my @values = Git::config(@repo, "$prefix.$setting");
433 @$target = @values if (@values && defined $values[0]);
436 else {
437 $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
441 if (!defined $smtp_encryption) {
442 my $enc = Git::config(@repo, "$prefix.smtpencryption");
443 if (defined $enc) {
444 $smtp_encryption = $enc;
445 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
446 $smtp_encryption = 'ssl';
451 # read configuration from [sendemail "$identity"], fall back on [sendemail]
452 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
453 read_config("sendemail.$identity") if (defined $identity);
454 read_config("sendemail");
456 # fall back on builtin bool defaults
457 foreach my $setting (values %config_bool_settings) {
458 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
461 # 'default' encryption is none -- this only prevents a warning
462 $smtp_encryption = '' unless (defined $smtp_encryption);
464 # Set CC suppressions
465 my(%suppress_cc);
466 if (@suppress_cc) {
467 foreach my $entry (@suppress_cc) {
468 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
469 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc|misc-by)$/;
470 $suppress_cc{$entry} = 1;
474 if ($suppress_cc{'all'}) {
475 foreach my $entry (qw (cccmd cc author self sob body bodycc misc-by)) {
476 $suppress_cc{$entry} = 1;
478 delete $suppress_cc{'all'};
481 # If explicit old-style ones are specified, they trump --suppress-cc.
482 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
483 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
485 if ($suppress_cc{'body'}) {
486 foreach my $entry (qw (sob bodycc misc-by)) {
487 $suppress_cc{$entry} = 1;
489 delete $suppress_cc{'body'};
492 # Set confirm's default value
493 my $confirm_unconfigured = !defined $confirm;
494 if ($confirm_unconfigured) {
495 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
497 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
498 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
500 # Debugging, print out the suppressions.
501 if (0) {
502 print "suppressions:\n";
503 foreach my $entry (keys %suppress_cc) {
504 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
508 my ($repoauthor, $repocommitter);
509 ($repoauthor) = Git::ident_person(@repo, 'author');
510 ($repocommitter) = Git::ident_person(@repo, 'committer');
512 sub parse_address_line {
513 return map { $_->format } Mail::Address->parse($_[0]);
516 sub split_addrs {
517 return quotewords('\s*,\s*', 1, @_);
520 my %aliases;
522 sub parse_sendmail_alias {
523 local $_ = shift;
524 if (/"/) {
525 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
526 } elsif (/:include:/) {
527 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
528 } elsif (/[\/|]/) {
529 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
530 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
531 my ($alias, $addr) = ($1, $2);
532 $aliases{$alias} = [ split_addrs($addr) ];
533 } else {
534 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
538 sub parse_sendmail_aliases {
539 my $fh = shift;
540 my $s = '';
541 while (<$fh>) {
542 chomp;
543 next if /^\s*$/ || /^\s*#/;
544 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
545 parse_sendmail_alias($s) if $s;
546 $s = $_;
548 $s =~ s/\\$//; # silently tolerate stray '\' on last line
549 parse_sendmail_alias($s) if $s;
552 my %parse_alias = (
553 # multiline formats can be supported in the future
554 mutt => sub { my $fh = shift; while (<$fh>) {
555 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
556 my ($alias, $addr) = ($1, $2);
557 $addr =~ s/#.*$//; # mutt allows # comments
558 # commas delimit multiple addresses
559 my @addr = split_addrs($addr);
561 # quotes may be escaped in the file,
562 # unescape them so we do not double-escape them later.
563 s/\\"/"/g foreach @addr;
564 $aliases{$alias} = \@addr
565 }}},
566 mailrc => sub { my $fh = shift; while (<$fh>) {
567 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
568 # spaces delimit multiple addresses
569 $aliases{$1} = [ quotewords('\s+', 0, $2) ];
570 }}},
571 pine => sub { my $fh = shift; my $f='\t[^\t]*';
572 for (my $x = ''; defined($x); $x = $_) {
573 chomp $x;
574 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
575 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
576 $aliases{$1} = [ split_addrs($2) ];
578 elm => sub { my $fh = shift;
579 while (<$fh>) {
580 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
581 my ($alias, $addr) = ($1, $2);
582 $aliases{$alias} = [ split_addrs($addr) ];
584 } },
585 sendmail => \&parse_sendmail_aliases,
586 gnus => sub { my $fh = shift; while (<$fh>) {
587 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
588 $aliases{$1} = [ $2 ];
592 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
593 foreach my $file (@alias_files) {
594 open my $fh, '<', $file or die "opening $file: $!\n";
595 $parse_alias{$aliasfiletype}->($fh);
596 close $fh;
600 if ($dump_aliases) {
601 print "$_\n" for (sort keys %aliases);
602 exit(0);
605 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
606 # $f is a revision list specification to be passed to format-patch.
607 sub is_format_patch_arg {
608 return unless $repo;
609 my $f = shift;
610 try {
611 $repo->command('rev-parse', '--verify', '--quiet', $f);
612 if (defined($format_patch)) {
613 return $format_patch;
615 die sprintf(__ <<EOF, $f, $f);
616 File '%s' exists but it could also be the range of commits
617 to produce patches for. Please disambiguate by...
619 * Saying "./%s" if you mean a file; or
620 * Giving --format-patch option if you mean a range.
622 } catch Git::Error::Command with {
623 # Not a valid revision. Treat it as a filename.
624 return 0;
628 # Now that all the defaults are set, process the rest of the command line
629 # arguments and collect up the files that need to be processed.
630 my @rev_list_opts;
631 while (defined(my $f = shift @ARGV)) {
632 if ($f eq "--") {
633 push @rev_list_opts, "--", @ARGV;
634 @ARGV = ();
635 } elsif (-d $f and !is_format_patch_arg($f)) {
636 opendir my $dh, $f
637 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
639 push @files, grep { -f $_ } map { catfile($f, $_) }
640 sort readdir $dh;
641 closedir $dh;
642 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
643 push @files, $f;
644 } else {
645 push @rev_list_opts, $f;
649 if (@rev_list_opts) {
650 die __("Cannot run git format-patch from outside a repository\n")
651 unless $repo;
652 push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
655 @files = handle_backup_files(@files);
657 if ($validate) {
658 foreach my $f (@files) {
659 unless (-p $f) {
660 my $error = validate_patch($f, $target_xfer_encoding);
661 $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
662 $f, $error);
667 if (@files) {
668 unless ($quiet) {
669 print $_,"\n" for (@files);
671 } else {
672 print STDERR __("\nNo patch files specified!\n\n");
673 usage();
676 sub get_patch_subject {
677 my $fn = shift;
678 open (my $fh, '<', $fn);
679 while (my $line = <$fh>) {
680 next unless ($line =~ /^Subject: (.*)$/);
681 close $fh;
682 return "GIT: $1\n";
684 close $fh;
685 die sprintf(__("No subject line in %s?"), $fn);
688 if ($compose) {
689 # Note that this does not need to be secure, but we will make a small
690 # effort to have it be unique
691 $compose_filename = ($repo ?
692 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
693 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
694 open my $c, ">", $compose_filename
695 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
698 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
699 my $tpl_subject = $initial_subject || '';
700 my $tpl_in_reply_to = $initial_in_reply_to || '';
701 my $tpl_reply_to = $reply_to || '';
703 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
704 From $tpl_sender # This line is ignored.
705 EOT1
706 Lines beginning in "GIT:" will be removed.
707 Consider including an overall diffstat or table of contents
708 for the patch you are writing.
710 Clear the body content if you don't wish to send a summary.
711 EOT2
712 From: $tpl_sender
713 Reply-To: $tpl_reply_to
714 Subject: $tpl_subject
715 In-Reply-To: $tpl_in_reply_to
717 EOT3
718 for my $f (@files) {
719 print $c get_patch_subject($f);
721 close $c;
723 if ($annotate) {
724 do_edit($compose_filename, @files);
725 } else {
726 do_edit($compose_filename);
729 open $c, "<", $compose_filename
730 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
732 if (!defined $compose_encoding) {
733 $compose_encoding = "UTF-8";
736 my %parsed_email;
737 while (my $line = <$c>) {
738 next if $line =~ m/^GIT:/;
739 parse_header_line($line, \%parsed_email);
740 if ($line =~ /^$/) {
741 $parsed_email{'body'} = filter_body($c);
744 close $c;
746 open my $c2, ">", $compose_filename . ".final"
747 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
750 if ($parsed_email{'From'}) {
751 $sender = delete($parsed_email{'From'});
753 if ($parsed_email{'In-Reply-To'}) {
754 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
756 if ($parsed_email{'Reply-To'}) {
757 $reply_to = delete($parsed_email{'Reply-To'});
759 if ($parsed_email{'Subject'}) {
760 $initial_subject = delete($parsed_email{'Subject'});
761 print $c2 "Subject: " .
762 quote_subject($initial_subject, $compose_encoding) .
763 "\n";
766 if ($parsed_email{'MIME-Version'}) {
767 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
768 "Content-Type: $parsed_email{'Content-Type'};\n",
769 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
770 delete($parsed_email{'MIME-Version'});
771 delete($parsed_email{'Content-Type'});
772 delete($parsed_email{'Content-Transfer-Encoding'});
773 } elsif (file_has_nonascii($compose_filename)) {
774 my $content_type = (delete($parsed_email{'Content-Type'}) or
775 "text/plain; charset=$compose_encoding");
776 print $c2 "MIME-Version: 1.0\n",
777 "Content-Type: $content_type\n",
778 "Content-Transfer-Encoding: 8bit\n";
780 # Preserve unknown headers
781 foreach my $key (keys %parsed_email) {
782 next if $key eq 'body';
783 print $c2 "$key: $parsed_email{$key}";
786 if ($parsed_email{'body'}) {
787 print $c2 "\n$parsed_email{'body'}\n";
788 delete($parsed_email{'body'});
789 } else {
790 print __("Summary email is empty, skipping it\n");
791 $compose = -1;
794 close $c2;
796 } elsif ($annotate) {
797 do_edit(@files);
800 sub ask {
801 my ($prompt, %arg) = @_;
802 my $valid_re = $arg{valid_re};
803 my $default = $arg{default};
804 my $confirm_only = $arg{confirm_only};
805 my $resp;
806 my $i = 0;
807 return defined $default ? $default : undef
808 unless defined $term->IN and defined fileno($term->IN) and
809 defined $term->OUT and defined fileno($term->OUT);
810 while ($i++ < 10) {
811 $resp = $term->readline($prompt);
812 if (!defined $resp) { # EOF
813 print "\n";
814 return defined $default ? $default : undef;
816 if ($resp eq '' and defined $default) {
817 return $default;
819 if (!defined $valid_re or $resp =~ /$valid_re/) {
820 return $resp;
822 if ($confirm_only) {
823 my $yesno = $term->readline(
824 # TRANSLATORS: please keep [y/N] as is.
825 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
826 if (defined $yesno && $yesno =~ /y/i) {
827 return $resp;
831 return;
834 sub parse_header_line {
835 my $lines = shift;
836 my $parsed_line = shift;
837 my $addr_pat = join "|", qw(To Cc Bcc);
839 foreach (split(/\n/, $lines)) {
840 if (/^($addr_pat):\s*(.+)$/i) {
841 $parsed_line->{$1} = [ parse_address_line($2) ];
842 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
843 $parsed_line->{$1} = $2;
848 sub filter_body {
849 my $c = shift;
850 my $body = "";
851 while (my $body_line = <$c>) {
852 if ($body_line !~ m/^GIT:/) {
853 $body .= $body_line;
856 return $body;
860 my %broken_encoding;
862 sub file_declares_8bit_cte {
863 my $fn = shift;
864 open (my $fh, '<', $fn);
865 while (my $line = <$fh>) {
866 last if ($line =~ /^$/);
867 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
869 close $fh;
870 return 0;
873 foreach my $f (@files) {
874 next unless (body_or_subject_has_nonascii($f)
875 && !file_declares_8bit_cte($f));
876 $broken_encoding{$f} = 1;
879 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
880 print __("The following files are 8bit, but do not declare " .
881 "a Content-Transfer-Encoding.\n");
882 foreach my $f (sort keys %broken_encoding) {
883 print " $f\n";
885 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
886 valid_re => qr/.{4}/, confirm_only => 1,
887 default => "UTF-8");
890 if (!$force) {
891 for my $f (@files) {
892 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
893 die sprintf(__("Refusing to send because the patch\n\t%s\n"
894 . "has the template subject '*** SUBJECT HERE ***'. "
895 . "Pass --force if you really want to send.\n"), $f);
900 if (defined $sender) {
901 $sender =~ s/^\s+|\s+$//g;
902 ($sender) = expand_aliases($sender);
903 } else {
904 $sender = $repoauthor || $repocommitter || '';
907 # $sender could be an already sanitized address
908 # (e.g. sendemail.from could be manually sanitized by user).
909 # But it's a no-op to run sanitize_address on an already sanitized address.
910 $sender = sanitize_address($sender);
912 my $to_whom = __("To whom should the emails be sent (if anyone)?");
913 my $prompting = 0;
914 if (!@initial_to && !defined $to_cmd) {
915 my $to = ask("$to_whom ",
916 default => "",
917 valid_re => qr/\@.*\./, confirm_only => 1);
918 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
919 $prompting++;
922 sub expand_aliases {
923 return map { expand_one_alias($_) } @_;
926 my %EXPANDED_ALIASES;
927 sub expand_one_alias {
928 my $alias = shift;
929 if ($EXPANDED_ALIASES{$alias}) {
930 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
932 local $EXPANDED_ALIASES{$alias} = 1;
933 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
936 @initial_to = process_address_list(@initial_to);
937 @initial_cc = process_address_list(@initial_cc);
938 @bcclist = process_address_list(@bcclist);
940 if ($thread && !defined $initial_in_reply_to && $prompting) {
941 $initial_in_reply_to = ask(
942 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
943 default => "",
944 valid_re => qr/\@.*\./, confirm_only => 1);
946 if (defined $initial_in_reply_to) {
947 $initial_in_reply_to =~ s/^\s*<?//;
948 $initial_in_reply_to =~ s/>?\s*$//;
949 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
952 if (defined $reply_to) {
953 $reply_to =~ s/^\s+|\s+$//g;
954 ($reply_to) = expand_aliases($reply_to);
955 $reply_to = sanitize_address($reply_to);
958 if (!defined $smtp_server) {
959 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
960 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
961 foreach (@sendmail_paths) {
962 if (-x $_) {
963 $smtp_server = $_;
964 last;
967 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
970 if ($compose && $compose > 0) {
971 @files = ($compose_filename . ".final", @files);
974 # Variables we set as part of the loop over files
975 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
976 $needs_confirm, $message_num, $ask_default);
978 sub extract_valid_address {
979 my $address = shift;
980 my $local_part_regexp = qr/[^<>"\s@]+/;
981 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
983 # check for a local address:
984 return $address if ($address =~ /^($local_part_regexp)$/);
986 $address =~ s/^\s*<(.*)>\s*$/$1/;
987 if ($have_email_valid) {
988 return scalar Email::Valid->address($address);
991 # less robust/correct than the monster regexp in Email::Valid,
992 # but still does a 99% job, and one less dependency
993 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
994 return;
997 sub extract_valid_address_or_die {
998 my $address = shift;
999 $address = extract_valid_address($address);
1000 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1001 if !$address;
1002 return $address;
1005 sub validate_address {
1006 my $address = shift;
1007 while (!extract_valid_address($address)) {
1008 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1009 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1010 # translation. The program will only accept English input
1011 # at this point.
1012 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1013 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1014 default => 'q');
1015 if (/^d/i) {
1016 return undef;
1017 } elsif (/^q/i) {
1018 cleanup_compose_files();
1019 exit(0);
1021 $address = ask("$to_whom ",
1022 default => "",
1023 valid_re => qr/\@.*\./, confirm_only => 1);
1025 return $address;
1028 sub validate_address_list {
1029 return (grep { defined $_ }
1030 map { validate_address($_) } @_);
1033 # Usually don't need to change anything below here.
1035 # we make a "fake" message id by taking the current number
1036 # of seconds since the beginning of Unix time and tacking on
1037 # a random number to the end, in case we are called quicker than
1038 # 1 second since the last time we were called.
1040 # We'll setup a template for the message id, using the "from" address:
1042 my ($message_id_stamp, $message_id_serial);
1043 sub make_message_id {
1044 my $uniq;
1045 if (!defined $message_id_stamp) {
1046 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1047 $message_id_serial = 0;
1049 $message_id_serial++;
1050 $uniq = "$message_id_stamp-$message_id_serial";
1052 my $du_part;
1053 for ($sender, $repocommitter, $repoauthor) {
1054 $du_part = extract_valid_address(sanitize_address($_));
1055 last if (defined $du_part and $du_part ne '');
1057 if (not defined $du_part or $du_part eq '') {
1058 require Sys::Hostname;
1059 $du_part = 'user@' . Sys::Hostname::hostname();
1061 my $message_id_template = "<%s-%s>";
1062 $message_id = sprintf($message_id_template, $uniq, $du_part);
1063 #print "new message id = $message_id\n"; # Was useful for debugging
1068 $time = time - scalar $#files;
1070 sub unquote_rfc2047 {
1071 local ($_) = @_;
1072 my $charset;
1073 my $sep = qr/[ \t]+/;
1074 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1075 my @words = split $sep, $&;
1076 foreach (@words) {
1077 m/$re_encoded_word/;
1078 $charset = $1;
1079 my $encoding = $2;
1080 my $text = $3;
1081 if ($encoding eq 'q' || $encoding eq 'Q') {
1082 $_ = $text;
1083 s/_/ /g;
1084 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1085 } else {
1086 # other encodings not supported yet
1089 join '', @words;
1090 }eg;
1091 return wantarray ? ($_, $charset) : $_;
1094 sub quote_rfc2047 {
1095 local $_ = shift;
1096 my $encoding = shift || 'UTF-8';
1097 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1098 s/(.*)/=\?$encoding\?q\?$1\?=/;
1099 return $_;
1102 sub is_rfc2047_quoted {
1103 my $s = shift;
1104 length($s) <= 75 &&
1105 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1108 sub subject_needs_rfc2047_quoting {
1109 my $s = shift;
1111 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1114 sub quote_subject {
1115 local $subject = shift;
1116 my $encoding = shift || 'UTF-8';
1118 if (subject_needs_rfc2047_quoting($subject)) {
1119 return quote_rfc2047($subject, $encoding);
1121 return $subject;
1124 # use the simplest quoting being able to handle the recipient
1125 sub sanitize_address {
1126 my ($recipient) = @_;
1128 # remove garbage after email address
1129 $recipient =~ s/(.*>).*$/$1/;
1131 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1133 if (not $recipient_name) {
1134 return $recipient;
1137 # if recipient_name is already quoted, do nothing
1138 if (is_rfc2047_quoted($recipient_name)) {
1139 return $recipient;
1142 # remove non-escaped quotes
1143 $recipient_name =~ s/(^|[^\\])"/$1/g;
1145 # rfc2047 is needed if a non-ascii char is included
1146 if ($recipient_name =~ /[^[:ascii:]]/) {
1147 $recipient_name = quote_rfc2047($recipient_name);
1150 # double quotes are needed if specials or CTLs are included
1151 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1152 $recipient_name =~ s/([\\\r])/\\$1/g;
1153 $recipient_name = qq["$recipient_name"];
1156 return "$recipient_name $recipient_addr";
1160 sub strip_garbage_one_address {
1161 my ($addr) = @_;
1162 chomp $addr;
1163 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1164 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1165 # Foo Bar <foobar@example.com> [possibly garbage here]
1166 return $1;
1168 if ($addr =~ /^(<[^>]*>).*/) {
1169 # <foo@example.com> [possibly garbage here]
1170 # if garbage contains other addresses, they are ignored.
1171 return $1;
1173 if ($addr =~ /^([^"#,\s]*)/) {
1174 # address without quoting: remove anything after the address
1175 return $1;
1177 return $addr;
1180 sub sanitize_address_list {
1181 return (map { sanitize_address($_) } @_);
1184 sub process_address_list {
1185 my @addr_list = map { parse_address_line($_) } @_;
1186 @addr_list = expand_aliases(@addr_list);
1187 @addr_list = sanitize_address_list(@addr_list);
1188 @addr_list = validate_address_list(@addr_list);
1189 return @addr_list;
1192 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1194 # Tightly configured MTAa require that a caller sends a real DNS
1195 # domain name that corresponds the IP address in the HELO/EHLO
1196 # handshake. This is used to verify the connection and prevent
1197 # spammers from trying to hide their identity. If the DNS and IP don't
1198 # match, the receiveing MTA may deny the connection.
1200 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1202 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1203 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1205 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1206 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1208 sub valid_fqdn {
1209 my $domain = shift;
1210 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1213 sub maildomain_net {
1214 my $maildomain;
1216 my $domain = Net::Domain::domainname();
1217 $maildomain = $domain if valid_fqdn($domain);
1219 return $maildomain;
1222 sub maildomain_mta {
1223 my $maildomain;
1225 for my $host (qw(mailhost localhost)) {
1226 my $smtp = Net::SMTP->new($host);
1227 if (defined $smtp) {
1228 my $domain = $smtp->domain;
1229 $smtp->quit;
1231 $maildomain = $domain if valid_fqdn($domain);
1233 last if $maildomain;
1237 return $maildomain;
1240 sub maildomain {
1241 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1244 sub smtp_host_string {
1245 if (defined $smtp_server_port) {
1246 return "$smtp_server:$smtp_server_port";
1247 } else {
1248 return $smtp_server;
1252 # Returns 1 if authentication succeeded or was not necessary
1253 # (smtp_user was not specified), and 0 otherwise.
1255 sub smtp_auth_maybe {
1256 if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1257 return 1;
1260 # Workaround AUTH PLAIN/LOGIN interaction defect
1261 # with Authen::SASL::Cyrus
1262 eval {
1263 require Authen::SASL;
1264 Authen::SASL->import(qw(Perl));
1267 # Check mechanism naming as defined in:
1268 # https://tools.ietf.org/html/rfc4422#page-8
1269 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1270 die "invalid smtp auth: '${smtp_auth}'";
1273 # TODO: Authentication may fail not because credentials were
1274 # invalid but due to other reasons, in which we should not
1275 # reject credentials.
1276 $auth = Git::credential({
1277 'protocol' => 'smtp',
1278 'host' => smtp_host_string(),
1279 'username' => $smtp_authuser,
1280 # if there's no password, "git credential fill" will
1281 # give us one, otherwise it'll just pass this one.
1282 'password' => $smtp_authpass
1283 }, sub {
1284 my $cred = shift;
1286 if ($smtp_auth) {
1287 my $sasl = Authen::SASL->new(
1288 mechanism => $smtp_auth,
1289 callback => {
1290 user => $cred->{'username'},
1291 pass => $cred->{'password'},
1292 authname => $cred->{'username'},
1296 return !!$smtp->auth($sasl);
1299 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1302 return $auth;
1305 sub ssl_verify_params {
1306 eval {
1307 require IO::Socket::SSL;
1308 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1310 if ($@) {
1311 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1312 return;
1315 if (!defined $smtp_ssl_cert_path) {
1316 # use the OpenSSL defaults
1317 return (SSL_verify_mode => SSL_VERIFY_PEER());
1320 if ($smtp_ssl_cert_path eq "") {
1321 return (SSL_verify_mode => SSL_VERIFY_NONE());
1322 } elsif (-d $smtp_ssl_cert_path) {
1323 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1324 SSL_ca_path => $smtp_ssl_cert_path);
1325 } elsif (-f $smtp_ssl_cert_path) {
1326 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1327 SSL_ca_file => $smtp_ssl_cert_path);
1328 } else {
1329 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1333 sub file_name_is_absolute {
1334 my ($path) = @_;
1336 # msys does not grok DOS drive-prefixes
1337 if ($^O eq 'msys') {
1338 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1341 require File::Spec::Functions;
1342 return File::Spec::Functions::file_name_is_absolute($path);
1345 # Prepares the email, then asks the user what to do.
1347 # If the user chooses to send the email, it's sent and 1 is returned.
1348 # If the user chooses not to send the email, 0 is returned.
1349 # If the user decides they want to make further edits, -1 is returned and the
1350 # caller is expected to call send_message again after the edits are performed.
1352 # If an error occurs sending the email, this just dies.
1354 sub send_message {
1355 my @recipients = unique_email_list(@to);
1356 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1357 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1359 @cc);
1360 my $to = join (",\n\t", @recipients);
1361 @recipients = unique_email_list(@recipients,@cc,@bcclist);
1362 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1363 my $date = format_2822_time($time++);
1364 my $gitversion = '@@GIT_VERSION@@';
1365 if ($gitversion =~ m/..GIT_VERSION../) {
1366 $gitversion = Git::version();
1369 my $cc = join(",\n\t", unique_email_list(@cc));
1370 my $ccline = "";
1371 if ($cc ne '') {
1372 $ccline = "\nCc: $cc";
1374 make_message_id() unless defined($message_id);
1376 my $header = "From: $sender
1377 To: $to${ccline}
1378 Subject: $subject
1379 Date: $date
1380 Message-Id: $message_id
1382 if ($use_xmailer) {
1383 $header .= "X-Mailer: git-send-email $gitversion\n";
1385 if ($in_reply_to) {
1387 $header .= "In-Reply-To: $in_reply_to\n";
1388 $header .= "References: $references\n";
1390 if ($reply_to) {
1391 $header .= "Reply-To: $reply_to\n";
1393 if (@xh) {
1394 $header .= join("\n", @xh) . "\n";
1397 my @sendmail_parameters = ('-i', @recipients);
1398 my $raw_from = $sender;
1399 if (defined $envelope_sender && $envelope_sender ne "auto") {
1400 $raw_from = $envelope_sender;
1402 $raw_from = extract_valid_address($raw_from);
1403 unshift (@sendmail_parameters,
1404 '-f', $raw_from) if(defined $envelope_sender);
1406 if ($needs_confirm && !$dry_run) {
1407 print "\n$header\n";
1408 if ($needs_confirm eq "inform") {
1409 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1410 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1411 print __ <<EOF ;
1412 The Cc list above has been expanded by additional
1413 addresses found in the patch commit message. By default
1414 send-email prompts before sending whenever this occurs.
1415 This behavior is controlled by the sendemail.confirm
1416 configuration setting.
1418 For additional information, run 'git send-email --help'.
1419 To retain the current behavior, but squelch this message,
1420 run 'git config --global sendemail.confirm auto'.
1424 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1425 # translation. The program will only accept English input
1426 # at this point.
1427 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1428 valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1429 default => $ask_default);
1430 die __("Send this email reply required") unless defined $_;
1431 if (/^n/i) {
1432 return 0;
1433 } elsif (/^e/i) {
1434 return -1;
1435 } elsif (/^q/i) {
1436 cleanup_compose_files();
1437 exit(0);
1438 } elsif (/^a/i) {
1439 $confirm = 'never';
1443 unshift (@sendmail_parameters, @smtp_server_options);
1445 if ($dry_run) {
1446 # We don't want to send the email.
1447 } elsif (file_name_is_absolute($smtp_server)) {
1448 my $pid = open my $sm, '|-';
1449 defined $pid or die $!;
1450 if (!$pid) {
1451 exec($smtp_server, @sendmail_parameters) or die $!;
1453 print $sm "$header\n$message";
1454 close $sm or die $!;
1455 } else {
1457 if (!defined $smtp_server) {
1458 die __("The required SMTP server is not properly defined.")
1461 require Net::SMTP;
1462 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1463 $smtp_domain ||= maildomain();
1465 if ($smtp_encryption eq 'ssl') {
1466 $smtp_server_port ||= 465; # ssmtp
1467 require IO::Socket::SSL;
1469 # Suppress "variable accessed once" warning.
1471 no warnings 'once';
1472 $IO::Socket::SSL::DEBUG = 1;
1475 # Net::SMTP::SSL->new() does not forward any SSL options
1476 IO::Socket::SSL::set_client_defaults(
1477 ssl_verify_params());
1479 if ($use_net_smtp_ssl) {
1480 require Net::SMTP::SSL;
1481 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1482 Hello => $smtp_domain,
1483 Port => $smtp_server_port,
1484 Debug => $debug_net_smtp);
1486 else {
1487 $smtp ||= Net::SMTP->new($smtp_server,
1488 Hello => $smtp_domain,
1489 Port => $smtp_server_port,
1490 Debug => $debug_net_smtp,
1491 SSL => 1);
1494 elsif (!$smtp) {
1495 $smtp_server_port ||= 25;
1496 $smtp ||= Net::SMTP->new($smtp_server,
1497 Hello => $smtp_domain,
1498 Debug => $debug_net_smtp,
1499 Port => $smtp_server_port);
1500 if ($smtp_encryption eq 'tls' && $smtp) {
1501 if ($use_net_smtp_ssl) {
1502 $smtp->command('STARTTLS');
1503 $smtp->response();
1504 if ($smtp->code != 220) {
1505 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1507 require Net::SMTP::SSL;
1508 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1509 ssl_verify_params())
1510 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1512 else {
1513 $smtp->starttls(ssl_verify_params())
1514 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1516 # Send EHLO again to receive fresh
1517 # supported commands
1518 $smtp->hello($smtp_domain);
1522 if (!$smtp) {
1523 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1524 " VALUES: server=$smtp_server ",
1525 "encryption=$smtp_encryption ",
1526 "hello=$smtp_domain",
1527 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1530 smtp_auth_maybe or die $smtp->message;
1532 $smtp->mail( $raw_from ) or die $smtp->message;
1533 $smtp->to( @recipients ) or die $smtp->message;
1534 $smtp->data or die $smtp->message;
1535 $smtp->datasend("$header\n") or die $smtp->message;
1536 my @lines = split /^/, $message;
1537 foreach my $line (@lines) {
1538 $smtp->datasend("$line") or die $smtp->message;
1540 $smtp->dataend() or die $smtp->message;
1541 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1543 if ($quiet) {
1544 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1545 } else {
1546 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1547 if (!file_name_is_absolute($smtp_server)) {
1548 print "Server: $smtp_server\n";
1549 print "MAIL FROM:<$raw_from>\n";
1550 foreach my $entry (@recipients) {
1551 print "RCPT TO:<$entry>\n";
1553 } else {
1554 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1556 print $header, "\n";
1557 if ($smtp) {
1558 print __("Result: "), $smtp->code, ' ',
1559 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1560 } else {
1561 print __("Result: OK\n");
1565 return 1;
1568 $in_reply_to = $initial_in_reply_to;
1569 $references = $initial_in_reply_to || '';
1570 $subject = $initial_subject;
1571 $message_num = 0;
1573 # Prepares the email, prompts the user, sends it out
1574 # Returns 0 if an edit was done and the function should be called again, or 1
1575 # otherwise.
1576 sub process_file {
1577 my ($t) = @_;
1579 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1581 my $author = undef;
1582 my $sauthor = undef;
1583 my $author_encoding;
1584 my $has_content_type;
1585 my $body_encoding;
1586 my $xfer_encoding;
1587 my $has_mime_version;
1588 @to = ();
1589 @cc = ();
1590 @xh = ();
1591 my $input_format = undef;
1592 my @header = ();
1593 $message = "";
1594 $message_num++;
1595 # First unfold multiline header fields
1596 while(<$fh>) {
1597 last if /^\s*$/;
1598 if (/^\s+\S/ and @header) {
1599 chomp($header[$#header]);
1600 s/^\s+/ /;
1601 $header[$#header] .= $_;
1602 } else {
1603 push(@header, $_);
1606 # Now parse the header
1607 foreach(@header) {
1608 if (/^From /) {
1609 $input_format = 'mbox';
1610 next;
1612 chomp;
1613 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1614 $input_format = 'mbox';
1617 if (defined $input_format && $input_format eq 'mbox') {
1618 if (/^Subject:\s+(.*)$/i) {
1619 $subject = $1;
1621 elsif (/^From:\s+(.*)$/i) {
1622 ($author, $author_encoding) = unquote_rfc2047($1);
1623 $sauthor = sanitize_address($author);
1624 next if $suppress_cc{'author'};
1625 next if $suppress_cc{'self'} and $sauthor eq $sender;
1626 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1627 $1, $_) unless $quiet;
1628 push @cc, $1;
1630 elsif (/^To:\s+(.*)$/i) {
1631 foreach my $addr (parse_address_line($1)) {
1632 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1633 $addr, $_) unless $quiet;
1634 push @to, $addr;
1637 elsif (/^Cc:\s+(.*)$/i) {
1638 foreach my $addr (parse_address_line($1)) {
1639 my $qaddr = unquote_rfc2047($addr);
1640 my $saddr = sanitize_address($qaddr);
1641 if ($saddr eq $sender) {
1642 next if ($suppress_cc{'self'});
1643 } else {
1644 next if ($suppress_cc{'cc'});
1646 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1647 $addr, $_) unless $quiet;
1648 push @cc, $addr;
1651 elsif (/^Content-type:/i) {
1652 $has_content_type = 1;
1653 if (/charset="?([^ "]+)/) {
1654 $body_encoding = $1;
1656 push @xh, $_;
1658 elsif (/^MIME-Version/i) {
1659 $has_mime_version = 1;
1660 push @xh, $_;
1662 elsif (/^Message-Id: (.*)/i) {
1663 $message_id = $1;
1665 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1666 $xfer_encoding = $1 if not defined $xfer_encoding;
1668 elsif (/^In-Reply-To: (.*)/i) {
1669 $in_reply_to = $1;
1671 elsif (/^References: (.*)/i) {
1672 $references = $1;
1674 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1675 push @xh, $_;
1677 } else {
1678 # In the traditional
1679 # "send lots of email" format,
1680 # line 1 = cc
1681 # line 2 = subject
1682 # So let's support that, too.
1683 $input_format = 'lots';
1684 if (@cc == 0 && !$suppress_cc{'cc'}) {
1685 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1686 $_, $_) unless $quiet;
1687 push @cc, $_;
1688 } elsif (!defined $subject) {
1689 $subject = $_;
1693 # Now parse the message body
1694 while(<$fh>) {
1695 $message .= $_;
1696 if (/^([a-z-]*-by|Cc): (.*)/i) {
1697 chomp;
1698 my ($what, $c) = ($1, $2);
1699 # strip garbage for the address we'll use:
1700 $c = strip_garbage_one_address($c);
1701 # sanitize a bit more to decide whether to suppress the address:
1702 my $sc = sanitize_address($c);
1703 if ($sc eq $sender) {
1704 next if ($suppress_cc{'self'});
1705 } else {
1706 if ($what =~ /^Signed-off-by$/i) {
1707 next if $suppress_cc{'sob'};
1708 } elsif ($what =~ /-by$/i) {
1709 next if $suppress_cc{'misc-by'};
1710 } elsif ($what =~ /Cc/i) {
1711 next if $suppress_cc{'bodycc'};
1714 if ($c !~ /.+@.+|<.+>/) {
1715 printf("(body) Ignoring %s from line '%s'\n",
1716 $what, $_) unless $quiet;
1717 next;
1719 push @cc, $c;
1720 printf(__("(body) Adding cc: %s from line '%s'\n"),
1721 $c, $_) unless $quiet;
1724 close $fh;
1726 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1727 if defined $to_cmd;
1728 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1729 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1731 if ($broken_encoding{$t} && !$has_content_type) {
1732 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1733 $has_content_type = 1;
1734 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1735 $body_encoding = $auto_8bit_encoding;
1738 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1739 $subject = quote_subject($subject, $auto_8bit_encoding);
1742 if (defined $sauthor and $sauthor ne $sender) {
1743 $message = "From: $author\n\n$message";
1744 if (defined $author_encoding) {
1745 if ($has_content_type) {
1746 if ($body_encoding eq $author_encoding) {
1747 # ok, we already have the right encoding
1749 else {
1750 # uh oh, we should re-encode
1753 else {
1754 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1755 $has_content_type = 1;
1756 push @xh,
1757 "Content-Type: text/plain; charset=$author_encoding";
1761 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1762 ($message, $xfer_encoding) = apply_transfer_encoding(
1763 $message, $xfer_encoding, $target_xfer_encoding);
1764 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1765 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1767 $needs_confirm = (
1768 $confirm eq "always" or
1769 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1770 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1771 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1773 @to = process_address_list(@to);
1774 @cc = process_address_list(@cc);
1776 @to = (@initial_to, @to);
1777 @cc = (@initial_cc, @cc);
1779 if ($message_num == 1) {
1780 if (defined $cover_cc and $cover_cc) {
1781 @initial_cc = @cc;
1783 if (defined $cover_to and $cover_to) {
1784 @initial_to = @to;
1788 my $message_was_sent = send_message();
1789 if ($message_was_sent == -1) {
1790 do_edit($t);
1791 return 0;
1794 # set up for the next message
1795 if ($thread && $message_was_sent &&
1796 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1797 $message_num == 1)) {
1798 $in_reply_to = $message_id;
1799 if (length $references > 0) {
1800 $references .= "\n $message_id";
1801 } else {
1802 $references = "$message_id";
1805 $message_id = undef;
1806 $num_sent++;
1807 if (defined $batch_size && $num_sent == $batch_size) {
1808 $num_sent = 0;
1809 $smtp->quit if defined $smtp;
1810 undef $smtp;
1811 undef $auth;
1812 sleep($relogin_delay) if defined $relogin_delay;
1815 return 1;
1818 foreach my $t (@files) {
1819 while (!process_file($t)) {
1820 # user edited the file
1824 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1825 # and return a results array
1826 sub recipients_cmd {
1827 my ($prefix, $what, $cmd, $file) = @_;
1829 my @addresses = ();
1830 open my $fh, "-|", "$cmd \Q$file\E"
1831 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1832 while (my $address = <$fh>) {
1833 $address =~ s/^\s*//g;
1834 $address =~ s/\s*$//g;
1835 $address = sanitize_address($address);
1836 next if ($address eq $sender and $suppress_cc{'self'});
1837 push @addresses, $address;
1838 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1839 $prefix, $what, $address, $cmd) unless $quiet;
1841 close $fh
1842 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1843 return @addresses;
1846 cleanup_compose_files();
1848 sub cleanup_compose_files {
1849 unlink($compose_filename, $compose_filename . ".final") if $compose;
1852 $smtp->quit if $smtp;
1854 sub apply_transfer_encoding {
1855 my $message = shift;
1856 my $from = shift;
1857 my $to = shift;
1859 return ($message, $to) if ($from eq $to and $from ne '7bit');
1861 require MIME::QuotedPrint;
1862 require MIME::Base64;
1864 $message = MIME::QuotedPrint::decode($message)
1865 if ($from eq 'quoted-printable');
1866 $message = MIME::Base64::decode($message)
1867 if ($from eq 'base64');
1869 $to = ($message =~ /.{999,}/) ? 'quoted-printable' : '8bit'
1870 if $to eq 'auto';
1872 die __("cannot send message as 7bit")
1873 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1874 return ($message, $to)
1875 if ($to eq '7bit' or $to eq '8bit');
1876 return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
1877 if ($to eq 'quoted-printable');
1878 return (MIME::Base64::encode($message, "\n"), $to)
1879 if ($to eq 'base64');
1880 die __("invalid transfer encoding");
1883 sub unique_email_list {
1884 my %seen;
1885 my @emails;
1887 foreach my $entry (@_) {
1888 my $clean = extract_valid_address_or_die($entry);
1889 $seen{$clean} ||= 0;
1890 next if $seen{$clean}++;
1891 push @emails, $entry;
1893 return @emails;
1896 sub validate_patch {
1897 my ($fn, $xfer_encoding) = @_;
1899 if ($repo) {
1900 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1901 'sendemail-validate');
1902 my $hook_error;
1903 if (-x $validate_hook) {
1904 my $target = abs_path($fn);
1905 # The hook needs a correct cwd and GIT_DIR.
1906 my $cwd_save = cwd();
1907 chdir($repo->wc_path() or $repo->repo_path())
1908 or die("chdir: $!");
1909 local $ENV{"GIT_DIR"} = $repo->repo_path();
1910 $hook_error = "rejected by sendemail-validate hook"
1911 if system($validate_hook, $target);
1912 chdir($cwd_save) or die("chdir: $!");
1914 return $hook_error if $hook_error;
1917 # Any long lines will be automatically fixed if we use a suitable transfer
1918 # encoding.
1919 unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
1920 open(my $fh, '<', $fn)
1921 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1922 while (my $line = <$fh>) {
1923 if (length($line) > 998) {
1924 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1928 return;
1931 sub handle_backup {
1932 my ($last, $lastlen, $file, $known_suffix) = @_;
1933 my ($suffix, $skip);
1935 $skip = 0;
1936 if (defined $last &&
1937 ($lastlen < length($file)) &&
1938 (substr($file, 0, $lastlen) eq $last) &&
1939 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1940 if (defined $known_suffix && $suffix eq $known_suffix) {
1941 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1942 $skip = 1;
1943 } else {
1944 # TRANSLATORS: please keep "[y|N]" as is.
1945 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1946 valid_re => qr/^(?:y|n)/i,
1947 default => 'n');
1948 $skip = ($answer ne 'y');
1949 if ($skip) {
1950 $known_suffix = $suffix;
1954 return ($skip, $known_suffix);
1957 sub handle_backup_files {
1958 my @file = @_;
1959 my ($last, $lastlen, $known_suffix, $skip, @result);
1960 for my $file (@file) {
1961 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1962 $file, $known_suffix);
1963 push @result, $file unless $skip;
1964 $last = $file;
1965 $lastlen = length($file);
1967 return @result;
1970 sub file_has_nonascii {
1971 my $fn = shift;
1972 open(my $fh, '<', $fn)
1973 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1974 while (my $line = <$fh>) {
1975 return 1 if $line =~ /[^[:ascii:]]/;
1977 return 0;
1980 sub body_or_subject_has_nonascii {
1981 my $fn = shift;
1982 open(my $fh, '<', $fn)
1983 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1984 while (my $line = <$fh>) {
1985 last if $line =~ /^$/;
1986 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1988 while (my $line = <$fh>) {
1989 return 1 if $line =~ /[^[:ascii:]]/;
1991 return 0;