Merge branch 'ag/rebase-p'
[git.git] / git-send-email.perl
blob8ec70e58ed5c4caace7701549038b63f9a3e9aad
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.
86 This setting forces to use one of the listed mechanisms.
87 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
89 --batch-size <int> * send max <int> message per connection.
90 --relogin-delay <int> * delay <int> seconds between two successive login.
91 This option can only be used with --batch-size
93 Automating:
94 --identity <str> * Use the sendemail.<id> options.
95 --to-cmd <str> * Email To: via `<str> \$patch_path`
96 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
97 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, all.
98 --[no-]cc-cover * Email Cc: addresses in the cover letter.
99 --[no-]to-cover * Email To: addresses in the cover letter.
100 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
101 --[no-]suppress-from * Send to self. Default off.
102 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
103 --[no-]thread * Use In-Reply-To: field. Default on.
105 Administering:
106 --confirm <str> * Confirm recipients before sending;
107 auto, cc, compose, always, or never.
108 --quiet * Output one line of info per email.
109 --dry-run * Don't actually send the emails.
110 --[no-]validate * Perform patch sanity checks. Default on.
111 --[no-]format-patch * understand any non optional arguments as
112 `git format-patch` ones.
113 --force * Send even if safety checks would prevent it.
115 Information:
116 --dump-aliases * Dump configured aliases and exit.
119 exit(1);
122 # most mail servers generate the Date: header, but not all...
123 sub format_2822_time {
124 my ($time) = @_;
125 my @localtm = localtime($time);
126 my @gmttm = gmtime($time);
127 my $localmin = $localtm[1] + $localtm[2] * 60;
128 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
129 if ($localtm[0] != $gmttm[0]) {
130 die __("local zone differs from GMT by a non-minute interval\n");
132 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
133 $localmin += 1440;
134 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
135 $localmin -= 1440;
136 } elsif ($gmttm[6] != $localtm[6]) {
137 die __("local time offset greater than or equal to 24 hours\n");
139 my $offset = $localmin - $gmtmin;
140 my $offhour = $offset / 60;
141 my $offmin = abs($offset % 60);
142 if (abs($offhour) >= 24) {
143 die __("local time offset greater than or equal to 24 hours\n");
146 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
147 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
148 $localtm[3],
149 qw(Jan Feb Mar Apr May Jun
150 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
151 $localtm[5]+1900,
152 $localtm[2],
153 $localtm[1],
154 $localtm[0],
155 ($offset >= 0) ? '+' : '-',
156 abs($offhour),
157 $offmin,
161 my $have_email_valid = eval { require Email::Valid; 1 };
162 my $smtp;
163 my $auth;
164 my $num_sent = 0;
166 # Regexes for RFC 2047 productions.
167 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
168 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
169 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
171 # Variables we fill in automatically, or via prompting:
172 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
173 $initial_in_reply_to,$reply_to,$initial_subject,@files,
174 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
176 my $envelope_sender;
178 # Example reply to:
179 #$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
181 my $repo = eval { Git->repository() };
182 my @repo = $repo ? ($repo) : ();
183 my $term = eval {
184 $ENV{"GIT_SEND_EMAIL_NOTTY"}
185 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
186 : new Term::ReadLine 'git-send-email';
188 if ($@) {
189 $term = new FakeTerm "$@: going non-interactive";
192 # Behavior modification variables
193 my ($quiet, $dry_run) = (0, 0);
194 my $format_patch;
195 my $compose_filename;
196 my $force = 0;
197 my $dump_aliases = 0;
199 # Handle interactive edition of files.
200 my $multiedit;
201 my $editor;
203 sub do_edit {
204 if (!defined($editor)) {
205 $editor = Git::command_oneline('var', 'GIT_EDITOR');
207 if (defined($multiedit) && !$multiedit) {
208 map {
209 system('sh', '-c', $editor.' "$@"', $editor, $_);
210 if (($? & 127) || ($? >> 8)) {
211 die(__("the editor exited uncleanly, aborting everything"));
213 } @_;
214 } else {
215 system('sh', '-c', $editor.' "$@"', $editor, @_);
216 if (($? & 127) || ($? >> 8)) {
217 die(__("the editor exited uncleanly, aborting everything"));
222 # Variables with corresponding config settings
223 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
224 my ($cover_cc, $cover_to);
225 my ($to_cmd, $cc_cmd);
226 my ($smtp_server, $smtp_server_port, @smtp_server_options);
227 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
228 my ($batch_size, $relogin_delay);
229 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
230 my ($validate, $confirm);
231 my (@suppress_cc);
232 my ($auto_8bit_encoding);
233 my ($compose_encoding);
234 my ($target_xfer_encoding);
236 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
238 my %config_bool_settings = (
239 "thread" => [\$thread, 1],
240 "chainreplyto" => [\$chain_reply_to, 0],
241 "suppressfrom" => [\$suppress_from, undef],
242 "signedoffbycc" => [\$signed_off_by_cc, undef],
243 "cccover" => [\$cover_cc, undef],
244 "tocover" => [\$cover_to, undef],
245 "signedoffcc" => [\$signed_off_by_cc, undef], # Deprecated
246 "validate" => [\$validate, 1],
247 "multiedit" => [\$multiedit, undef],
248 "annotate" => [\$annotate, undef],
249 "xmailer" => [\$use_xmailer, 1]
252 my %config_settings = (
253 "smtpserver" => \$smtp_server,
254 "smtpserverport" => \$smtp_server_port,
255 "smtpserveroption" => \@smtp_server_options,
256 "smtpuser" => \$smtp_authuser,
257 "smtppass" => \$smtp_authpass,
258 "smtpdomain" => \$smtp_domain,
259 "smtpauth" => \$smtp_auth,
260 "smtpbatchsize" => \$batch_size,
261 "smtprelogindelay" => \$relogin_delay,
262 "to" => \@initial_to,
263 "tocmd" => \$to_cmd,
264 "cc" => \@initial_cc,
265 "cccmd" => \$cc_cmd,
266 "aliasfiletype" => \$aliasfiletype,
267 "bcc" => \@bcclist,
268 "suppresscc" => \@suppress_cc,
269 "envelopesender" => \$envelope_sender,
270 "confirm" => \$confirm,
271 "from" => \$sender,
272 "assume8bitencoding" => \$auto_8bit_encoding,
273 "composeencoding" => \$compose_encoding,
274 "transferencoding" => \$target_xfer_encoding,
277 my %config_path_settings = (
278 "aliasesfile" => \@alias_files,
279 "smtpsslcertpath" => \$smtp_ssl_cert_path,
282 # Handle Uncouth Termination
283 sub signal_handler {
285 # Make text normal
286 print color("reset"), "\n";
288 # SMTP password masked
289 system "stty echo";
291 # tmp files from --compose
292 if (defined $compose_filename) {
293 if (-e $compose_filename) {
294 printf __("'%s' contains an intermediate version ".
295 "of the email you were composing.\n"),
296 $compose_filename;
298 if (-e ($compose_filename . ".final")) {
299 printf __("'%s.final' contains the composed email.\n"),
300 $compose_filename;
304 exit;
307 $SIG{TERM} = \&signal_handler;
308 $SIG{INT} = \&signal_handler;
310 # Begin by accumulating all the variables (defined above), that we will end up
311 # needing, first, from the command line:
313 my $help;
314 my $rc = GetOptions("h" => \$help,
315 "dump-aliases" => \$dump_aliases);
316 usage() unless $rc;
317 die __("--dump-aliases incompatible with other options\n")
318 if !$help and $dump_aliases and @ARGV;
319 $rc = GetOptions(
320 "sender|from=s" => \$sender,
321 "in-reply-to=s" => \$initial_in_reply_to,
322 "reply-to=s" => \$reply_to,
323 "subject=s" => \$initial_subject,
324 "to=s" => \@initial_to,
325 "to-cmd=s" => \$to_cmd,
326 "no-to" => \$no_to,
327 "cc=s" => \@initial_cc,
328 "no-cc" => \$no_cc,
329 "bcc=s" => \@bcclist,
330 "no-bcc" => \$no_bcc,
331 "chain-reply-to!" => \$chain_reply_to,
332 "no-chain-reply-to" => sub {$chain_reply_to = 0},
333 "smtp-server=s" => \$smtp_server,
334 "smtp-server-option=s" => \@smtp_server_options,
335 "smtp-server-port=s" => \$smtp_server_port,
336 "smtp-user=s" => \$smtp_authuser,
337 "smtp-pass:s" => \$smtp_authpass,
338 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
339 "smtp-encryption=s" => \$smtp_encryption,
340 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
341 "smtp-debug:i" => \$debug_net_smtp,
342 "smtp-domain:s" => \$smtp_domain,
343 "smtp-auth=s" => \$smtp_auth,
344 "identity=s" => \$identity,
345 "annotate!" => \$annotate,
346 "no-annotate" => sub {$annotate = 0},
347 "compose" => \$compose,
348 "quiet" => \$quiet,
349 "cc-cmd=s" => \$cc_cmd,
350 "suppress-from!" => \$suppress_from,
351 "no-suppress-from" => sub {$suppress_from = 0},
352 "suppress-cc=s" => \@suppress_cc,
353 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
354 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
355 "cc-cover|cc-cover!" => \$cover_cc,
356 "no-cc-cover" => sub {$cover_cc = 0},
357 "to-cover|to-cover!" => \$cover_to,
358 "no-to-cover" => sub {$cover_to = 0},
359 "confirm=s" => \$confirm,
360 "dry-run" => \$dry_run,
361 "envelope-sender=s" => \$envelope_sender,
362 "thread!" => \$thread,
363 "no-thread" => sub {$thread = 0},
364 "validate!" => \$validate,
365 "no-validate" => sub {$validate = 0},
366 "transfer-encoding=s" => \$target_xfer_encoding,
367 "format-patch!" => \$format_patch,
368 "no-format-patch" => sub {$format_patch = 0},
369 "8bit-encoding=s" => \$auto_8bit_encoding,
370 "compose-encoding=s" => \$compose_encoding,
371 "force" => \$force,
372 "xmailer!" => \$use_xmailer,
373 "no-xmailer" => sub {$use_xmailer = 0},
374 "batch-size=i" => \$batch_size,
375 "relogin-delay=i" => \$relogin_delay,
378 usage() if $help;
379 unless ($rc) {
380 usage();
383 die __("Cannot run git format-patch from outside a repository\n")
384 if $format_patch and not $repo;
386 die __("`batch-size` and `relogin` must be specified together " .
387 "(via command-line or configuration option)\n")
388 if defined $relogin_delay and not defined $batch_size;
390 # Now, let's fill any that aren't set in with defaults:
392 sub read_config {
393 my ($prefix) = @_;
395 foreach my $setting (keys %config_bool_settings) {
396 my $target = $config_bool_settings{$setting}->[0];
397 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
400 foreach my $setting (keys %config_path_settings) {
401 my $target = $config_path_settings{$setting};
402 if (ref($target) eq "ARRAY") {
403 unless (@$target) {
404 my @values = Git::config_path(@repo, "$prefix.$setting");
405 @$target = @values if (@values && defined $values[0]);
408 else {
409 $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
413 foreach my $setting (keys %config_settings) {
414 my $target = $config_settings{$setting};
415 next if $setting eq "to" and defined $no_to;
416 next if $setting eq "cc" and defined $no_cc;
417 next if $setting eq "bcc" and defined $no_bcc;
418 if (ref($target) eq "ARRAY") {
419 unless (@$target) {
420 my @values = Git::config(@repo, "$prefix.$setting");
421 @$target = @values if (@values && defined $values[0]);
424 else {
425 $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
429 if (!defined $smtp_encryption) {
430 my $enc = Git::config(@repo, "$prefix.smtpencryption");
431 if (defined $enc) {
432 $smtp_encryption = $enc;
433 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
434 $smtp_encryption = 'ssl';
439 # read configuration from [sendemail "$identity"], fall back on [sendemail]
440 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
441 read_config("sendemail.$identity") if (defined $identity);
442 read_config("sendemail");
444 # fall back on builtin bool defaults
445 foreach my $setting (values %config_bool_settings) {
446 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
449 # 'default' encryption is none -- this only prevents a warning
450 $smtp_encryption = '' unless (defined $smtp_encryption);
452 # Set CC suppressions
453 my(%suppress_cc);
454 if (@suppress_cc) {
455 foreach my $entry (@suppress_cc) {
456 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
457 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
458 $suppress_cc{$entry} = 1;
462 if ($suppress_cc{'all'}) {
463 foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
464 $suppress_cc{$entry} = 1;
466 delete $suppress_cc{'all'};
469 # If explicit old-style ones are specified, they trump --suppress-cc.
470 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
471 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
473 if ($suppress_cc{'body'}) {
474 foreach my $entry (qw (sob bodycc)) {
475 $suppress_cc{$entry} = 1;
477 delete $suppress_cc{'body'};
480 # Set confirm's default value
481 my $confirm_unconfigured = !defined $confirm;
482 if ($confirm_unconfigured) {
483 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
485 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
486 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
488 # Debugging, print out the suppressions.
489 if (0) {
490 print "suppressions:\n";
491 foreach my $entry (keys %suppress_cc) {
492 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
496 my ($repoauthor, $repocommitter);
497 ($repoauthor) = Git::ident_person(@repo, 'author');
498 ($repocommitter) = Git::ident_person(@repo, 'committer');
500 sub parse_address_line {
501 return map { $_->format } Mail::Address->parse($_[0]);
504 sub split_addrs {
505 return quotewords('\s*,\s*', 1, @_);
508 my %aliases;
510 sub parse_sendmail_alias {
511 local $_ = shift;
512 if (/"/) {
513 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
514 } elsif (/:include:/) {
515 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
516 } elsif (/[\/|]/) {
517 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
518 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
519 my ($alias, $addr) = ($1, $2);
520 $aliases{$alias} = [ split_addrs($addr) ];
521 } else {
522 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
526 sub parse_sendmail_aliases {
527 my $fh = shift;
528 my $s = '';
529 while (<$fh>) {
530 chomp;
531 next if /^\s*$/ || /^\s*#/;
532 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
533 parse_sendmail_alias($s) if $s;
534 $s = $_;
536 $s =~ s/\\$//; # silently tolerate stray '\' on last line
537 parse_sendmail_alias($s) if $s;
540 my %parse_alias = (
541 # multiline formats can be supported in the future
542 mutt => sub { my $fh = shift; while (<$fh>) {
543 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
544 my ($alias, $addr) = ($1, $2);
545 $addr =~ s/#.*$//; # mutt allows # comments
546 # commas delimit multiple addresses
547 my @addr = split_addrs($addr);
549 # quotes may be escaped in the file,
550 # unescape them so we do not double-escape them later.
551 s/\\"/"/g foreach @addr;
552 $aliases{$alias} = \@addr
553 }}},
554 mailrc => sub { my $fh = shift; while (<$fh>) {
555 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
556 # spaces delimit multiple addresses
557 $aliases{$1} = [ quotewords('\s+', 0, $2) ];
558 }}},
559 pine => sub { my $fh = shift; my $f='\t[^\t]*';
560 for (my $x = ''; defined($x); $x = $_) {
561 chomp $x;
562 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
563 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
564 $aliases{$1} = [ split_addrs($2) ];
566 elm => sub { my $fh = shift;
567 while (<$fh>) {
568 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
569 my ($alias, $addr) = ($1, $2);
570 $aliases{$alias} = [ split_addrs($addr) ];
572 } },
573 sendmail => \&parse_sendmail_aliases,
574 gnus => sub { my $fh = shift; while (<$fh>) {
575 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
576 $aliases{$1} = [ $2 ];
580 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
581 foreach my $file (@alias_files) {
582 open my $fh, '<', $file or die "opening $file: $!\n";
583 $parse_alias{$aliasfiletype}->($fh);
584 close $fh;
588 if ($dump_aliases) {
589 print "$_\n" for (sort keys %aliases);
590 exit(0);
593 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
594 # $f is a revision list specification to be passed to format-patch.
595 sub is_format_patch_arg {
596 return unless $repo;
597 my $f = shift;
598 try {
599 $repo->command('rev-parse', '--verify', '--quiet', $f);
600 if (defined($format_patch)) {
601 return $format_patch;
603 die sprintf(__ <<EOF, $f, $f);
604 File '%s' exists but it could also be the range of commits
605 to produce patches for. Please disambiguate by...
607 * Saying "./%s" if you mean a file; or
608 * Giving --format-patch option if you mean a range.
610 } catch Git::Error::Command with {
611 # Not a valid revision. Treat it as a filename.
612 return 0;
616 # Now that all the defaults are set, process the rest of the command line
617 # arguments and collect up the files that need to be processed.
618 my @rev_list_opts;
619 while (defined(my $f = shift @ARGV)) {
620 if ($f eq "--") {
621 push @rev_list_opts, "--", @ARGV;
622 @ARGV = ();
623 } elsif (-d $f and !is_format_patch_arg($f)) {
624 opendir my $dh, $f
625 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
627 push @files, grep { -f $_ } map { catfile($f, $_) }
628 sort readdir $dh;
629 closedir $dh;
630 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
631 push @files, $f;
632 } else {
633 push @rev_list_opts, $f;
637 if (@rev_list_opts) {
638 die __("Cannot run git format-patch from outside a repository\n")
639 unless $repo;
640 push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
643 @files = handle_backup_files(@files);
645 if ($validate) {
646 foreach my $f (@files) {
647 unless (-p $f) {
648 my $error = validate_patch($f);
649 $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
650 $f, $error);
655 if (@files) {
656 unless ($quiet) {
657 print $_,"\n" for (@files);
659 } else {
660 print STDERR __("\nNo patch files specified!\n\n");
661 usage();
664 sub get_patch_subject {
665 my $fn = shift;
666 open (my $fh, '<', $fn);
667 while (my $line = <$fh>) {
668 next unless ($line =~ /^Subject: (.*)$/);
669 close $fh;
670 return "GIT: $1\n";
672 close $fh;
673 die sprintf(__("No subject line in %s?"), $fn);
676 if ($compose) {
677 # Note that this does not need to be secure, but we will make a small
678 # effort to have it be unique
679 $compose_filename = ($repo ?
680 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
681 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
682 open my $c, ">", $compose_filename
683 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
686 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
687 my $tpl_subject = $initial_subject || '';
688 my $tpl_in_reply_to = $initial_in_reply_to || '';
689 my $tpl_reply_to = $reply_to || '';
691 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
692 From $tpl_sender # This line is ignored.
693 EOT1
694 Lines beginning in "GIT:" will be removed.
695 Consider including an overall diffstat or table of contents
696 for the patch you are writing.
698 Clear the body content if you don't wish to send a summary.
699 EOT2
700 From: $tpl_sender
701 Reply-To: $tpl_reply_to
702 Subject: $tpl_subject
703 In-Reply-To: $tpl_in_reply_to
705 EOT3
706 for my $f (@files) {
707 print $c get_patch_subject($f);
709 close $c;
711 if ($annotate) {
712 do_edit($compose_filename, @files);
713 } else {
714 do_edit($compose_filename);
717 open $c, "<", $compose_filename
718 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
720 if (!defined $compose_encoding) {
721 $compose_encoding = "UTF-8";
724 my %parsed_email;
725 while (my $line = <$c>) {
726 next if $line =~ m/^GIT:/;
727 parse_header_line($line, \%parsed_email);
728 if ($line =~ /^$/) {
729 $parsed_email{'body'} = filter_body($c);
732 close $c;
734 open my $c2, ">", $compose_filename . ".final"
735 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
738 if ($parsed_email{'From'}) {
739 $sender = delete($parsed_email{'From'});
741 if ($parsed_email{'In-Reply-To'}) {
742 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
744 if ($parsed_email{'Reply-To'}) {
745 $reply_to = delete($parsed_email{'Reply-To'});
747 if ($parsed_email{'Subject'}) {
748 $initial_subject = delete($parsed_email{'Subject'});
749 print $c2 "Subject: " .
750 quote_subject($initial_subject, $compose_encoding) .
751 "\n";
754 if ($parsed_email{'MIME-Version'}) {
755 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
756 "Content-Type: $parsed_email{'Content-Type'};\n",
757 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
758 delete($parsed_email{'MIME-Version'});
759 delete($parsed_email{'Content-Type'});
760 delete($parsed_email{'Content-Transfer-Encoding'});
761 } elsif (file_has_nonascii($compose_filename)) {
762 my $content_type = (delete($parsed_email{'Content-Type'}) or
763 "text/plain; charset=$compose_encoding");
764 print $c2 "MIME-Version: 1.0\n",
765 "Content-Type: $content_type\n",
766 "Content-Transfer-Encoding: 8bit\n";
768 # Preserve unknown headers
769 foreach my $key (keys %parsed_email) {
770 next if $key eq 'body';
771 print $c2 "$key: $parsed_email{$key}";
774 if ($parsed_email{'body'}) {
775 print $c2 "\n$parsed_email{'body'}\n";
776 delete($parsed_email{'body'});
777 } else {
778 print __("Summary email is empty, skipping it\n");
779 $compose = -1;
782 close $c2;
784 } elsif ($annotate) {
785 do_edit(@files);
788 sub ask {
789 my ($prompt, %arg) = @_;
790 my $valid_re = $arg{valid_re};
791 my $default = $arg{default};
792 my $confirm_only = $arg{confirm_only};
793 my $resp;
794 my $i = 0;
795 return defined $default ? $default : undef
796 unless defined $term->IN and defined fileno($term->IN) and
797 defined $term->OUT and defined fileno($term->OUT);
798 while ($i++ < 10) {
799 $resp = $term->readline($prompt);
800 if (!defined $resp) { # EOF
801 print "\n";
802 return defined $default ? $default : undef;
804 if ($resp eq '' and defined $default) {
805 return $default;
807 if (!defined $valid_re or $resp =~ /$valid_re/) {
808 return $resp;
810 if ($confirm_only) {
811 my $yesno = $term->readline(
812 # TRANSLATORS: please keep [y/N] as is.
813 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
814 if (defined $yesno && $yesno =~ /y/i) {
815 return $resp;
819 return;
822 sub parse_header_line {
823 my $lines = shift;
824 my $parsed_line = shift;
825 my $addr_pat = join "|", qw(To Cc Bcc);
827 foreach (split(/\n/, $lines)) {
828 if (/^($addr_pat):\s*(.+)$/i) {
829 $parsed_line->{$1} = [ parse_address_line($2) ];
830 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
831 $parsed_line->{$1} = $2;
836 sub filter_body {
837 my $c = shift;
838 my $body = "";
839 while (my $body_line = <$c>) {
840 if ($body_line !~ m/^GIT:/) {
841 $body .= $body_line;
844 return $body;
848 my %broken_encoding;
850 sub file_declares_8bit_cte {
851 my $fn = shift;
852 open (my $fh, '<', $fn);
853 while (my $line = <$fh>) {
854 last if ($line =~ /^$/);
855 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
857 close $fh;
858 return 0;
861 foreach my $f (@files) {
862 next unless (body_or_subject_has_nonascii($f)
863 && !file_declares_8bit_cte($f));
864 $broken_encoding{$f} = 1;
867 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
868 print __("The following files are 8bit, but do not declare " .
869 "a Content-Transfer-Encoding.\n");
870 foreach my $f (sort keys %broken_encoding) {
871 print " $f\n";
873 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
874 valid_re => qr/.{4}/, confirm_only => 1,
875 default => "UTF-8");
878 if (!$force) {
879 for my $f (@files) {
880 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
881 die sprintf(__("Refusing to send because the patch\n\t%s\n"
882 . "has the template subject '*** SUBJECT HERE ***'. "
883 . "Pass --force if you really want to send.\n"), $f);
888 if (defined $sender) {
889 $sender =~ s/^\s+|\s+$//g;
890 ($sender) = expand_aliases($sender);
891 } else {
892 $sender = $repoauthor || $repocommitter || '';
895 # $sender could be an already sanitized address
896 # (e.g. sendemail.from could be manually sanitized by user).
897 # But it's a no-op to run sanitize_address on an already sanitized address.
898 $sender = sanitize_address($sender);
900 my $to_whom = __("To whom should the emails be sent (if anyone)?");
901 my $prompting = 0;
902 if (!@initial_to && !defined $to_cmd) {
903 my $to = ask("$to_whom ",
904 default => "",
905 valid_re => qr/\@.*\./, confirm_only => 1);
906 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
907 $prompting++;
910 sub expand_aliases {
911 return map { expand_one_alias($_) } @_;
914 my %EXPANDED_ALIASES;
915 sub expand_one_alias {
916 my $alias = shift;
917 if ($EXPANDED_ALIASES{$alias}) {
918 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
920 local $EXPANDED_ALIASES{$alias} = 1;
921 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
924 @initial_to = process_address_list(@initial_to);
925 @initial_cc = process_address_list(@initial_cc);
926 @bcclist = process_address_list(@bcclist);
928 if ($thread && !defined $initial_in_reply_to && $prompting) {
929 $initial_in_reply_to = ask(
930 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
931 default => "",
932 valid_re => qr/\@.*\./, confirm_only => 1);
934 if (defined $initial_in_reply_to) {
935 $initial_in_reply_to =~ s/^\s*<?//;
936 $initial_in_reply_to =~ s/>?\s*$//;
937 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
940 if (defined $reply_to) {
941 $reply_to =~ s/^\s+|\s+$//g;
942 ($reply_to) = expand_aliases($reply_to);
943 $reply_to = sanitize_address($reply_to);
946 if (!defined $smtp_server) {
947 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
948 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
949 foreach (@sendmail_paths) {
950 if (-x $_) {
951 $smtp_server = $_;
952 last;
955 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
958 if ($compose && $compose > 0) {
959 @files = ($compose_filename . ".final", @files);
962 # Variables we set as part of the loop over files
963 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
964 $needs_confirm, $message_num, $ask_default);
966 sub extract_valid_address {
967 my $address = shift;
968 my $local_part_regexp = qr/[^<>"\s@]+/;
969 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
971 # check for a local address:
972 return $address if ($address =~ /^($local_part_regexp)$/);
974 $address =~ s/^\s*<(.*)>\s*$/$1/;
975 if ($have_email_valid) {
976 return scalar Email::Valid->address($address);
979 # less robust/correct than the monster regexp in Email::Valid,
980 # but still does a 99% job, and one less dependency
981 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
982 return;
985 sub extract_valid_address_or_die {
986 my $address = shift;
987 $address = extract_valid_address($address);
988 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
989 if !$address;
990 return $address;
993 sub validate_address {
994 my $address = shift;
995 while (!extract_valid_address($address)) {
996 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
997 # TRANSLATORS: Make sure to include [q] [d] [e] in your
998 # translation. The program will only accept English input
999 # at this point.
1000 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1001 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1002 default => 'q');
1003 if (/^d/i) {
1004 return undef;
1005 } elsif (/^q/i) {
1006 cleanup_compose_files();
1007 exit(0);
1009 $address = ask("$to_whom ",
1010 default => "",
1011 valid_re => qr/\@.*\./, confirm_only => 1);
1013 return $address;
1016 sub validate_address_list {
1017 return (grep { defined $_ }
1018 map { validate_address($_) } @_);
1021 # Usually don't need to change anything below here.
1023 # we make a "fake" message id by taking the current number
1024 # of seconds since the beginning of Unix time and tacking on
1025 # a random number to the end, in case we are called quicker than
1026 # 1 second since the last time we were called.
1028 # We'll setup a template for the message id, using the "from" address:
1030 my ($message_id_stamp, $message_id_serial);
1031 sub make_message_id {
1032 my $uniq;
1033 if (!defined $message_id_stamp) {
1034 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1035 $message_id_serial = 0;
1037 $message_id_serial++;
1038 $uniq = "$message_id_stamp-$message_id_serial";
1040 my $du_part;
1041 for ($sender, $repocommitter, $repoauthor) {
1042 $du_part = extract_valid_address(sanitize_address($_));
1043 last if (defined $du_part and $du_part ne '');
1045 if (not defined $du_part or $du_part eq '') {
1046 require Sys::Hostname;
1047 $du_part = 'user@' . Sys::Hostname::hostname();
1049 my $message_id_template = "<%s-%s>";
1050 $message_id = sprintf($message_id_template, $uniq, $du_part);
1051 #print "new message id = $message_id\n"; # Was useful for debugging
1056 $time = time - scalar $#files;
1058 sub unquote_rfc2047 {
1059 local ($_) = @_;
1060 my $charset;
1061 my $sep = qr/[ \t]+/;
1062 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1063 my @words = split $sep, $&;
1064 foreach (@words) {
1065 m/$re_encoded_word/;
1066 $charset = $1;
1067 my $encoding = $2;
1068 my $text = $3;
1069 if ($encoding eq 'q' || $encoding eq 'Q') {
1070 $_ = $text;
1071 s/_/ /g;
1072 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1073 } else {
1074 # other encodings not supported yet
1077 join '', @words;
1078 }eg;
1079 return wantarray ? ($_, $charset) : $_;
1082 sub quote_rfc2047 {
1083 local $_ = shift;
1084 my $encoding = shift || 'UTF-8';
1085 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1086 s/(.*)/=\?$encoding\?q\?$1\?=/;
1087 return $_;
1090 sub is_rfc2047_quoted {
1091 my $s = shift;
1092 length($s) <= 75 &&
1093 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1096 sub subject_needs_rfc2047_quoting {
1097 my $s = shift;
1099 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1102 sub quote_subject {
1103 local $subject = shift;
1104 my $encoding = shift || 'UTF-8';
1106 if (subject_needs_rfc2047_quoting($subject)) {
1107 return quote_rfc2047($subject, $encoding);
1109 return $subject;
1112 # use the simplest quoting being able to handle the recipient
1113 sub sanitize_address {
1114 my ($recipient) = @_;
1116 # remove garbage after email address
1117 $recipient =~ s/(.*>).*$/$1/;
1119 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1121 if (not $recipient_name) {
1122 return $recipient;
1125 # if recipient_name is already quoted, do nothing
1126 if (is_rfc2047_quoted($recipient_name)) {
1127 return $recipient;
1130 # remove non-escaped quotes
1131 $recipient_name =~ s/(^|[^\\])"/$1/g;
1133 # rfc2047 is needed if a non-ascii char is included
1134 if ($recipient_name =~ /[^[:ascii:]]/) {
1135 $recipient_name = quote_rfc2047($recipient_name);
1138 # double quotes are needed if specials or CTLs are included
1139 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1140 $recipient_name =~ s/([\\\r])/\\$1/g;
1141 $recipient_name = qq["$recipient_name"];
1144 return "$recipient_name $recipient_addr";
1148 sub strip_garbage_one_address {
1149 my ($addr) = @_;
1150 chomp $addr;
1151 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1152 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1153 # Foo Bar <foobar@example.com> [possibly garbage here]
1154 return $1;
1156 if ($addr =~ /^(<[^>]*>).*/) {
1157 # <foo@example.com> [possibly garbage here]
1158 # if garbage contains other addresses, they are ignored.
1159 return $1;
1161 if ($addr =~ /^([^"#,\s]*)/) {
1162 # address without quoting: remove anything after the address
1163 return $1;
1165 return $addr;
1168 sub sanitize_address_list {
1169 return (map { sanitize_address($_) } @_);
1172 sub process_address_list {
1173 my @addr_list = map { parse_address_line($_) } @_;
1174 @addr_list = expand_aliases(@addr_list);
1175 @addr_list = sanitize_address_list(@addr_list);
1176 @addr_list = validate_address_list(@addr_list);
1177 return @addr_list;
1180 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1182 # Tightly configured MTAa require that a caller sends a real DNS
1183 # domain name that corresponds the IP address in the HELO/EHLO
1184 # handshake. This is used to verify the connection and prevent
1185 # spammers from trying to hide their identity. If the DNS and IP don't
1186 # match, the receiveing MTA may deny the connection.
1188 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1190 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1191 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1193 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1194 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1196 sub valid_fqdn {
1197 my $domain = shift;
1198 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1201 sub maildomain_net {
1202 my $maildomain;
1204 my $domain = Net::Domain::domainname();
1205 $maildomain = $domain if valid_fqdn($domain);
1207 return $maildomain;
1210 sub maildomain_mta {
1211 my $maildomain;
1213 for my $host (qw(mailhost localhost)) {
1214 my $smtp = Net::SMTP->new($host);
1215 if (defined $smtp) {
1216 my $domain = $smtp->domain;
1217 $smtp->quit;
1219 $maildomain = $domain if valid_fqdn($domain);
1221 last if $maildomain;
1225 return $maildomain;
1228 sub maildomain {
1229 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1232 sub smtp_host_string {
1233 if (defined $smtp_server_port) {
1234 return "$smtp_server:$smtp_server_port";
1235 } else {
1236 return $smtp_server;
1240 # Returns 1 if authentication succeeded or was not necessary
1241 # (smtp_user was not specified), and 0 otherwise.
1243 sub smtp_auth_maybe {
1244 if (!defined $smtp_authuser || $auth) {
1245 return 1;
1248 # Workaround AUTH PLAIN/LOGIN interaction defect
1249 # with Authen::SASL::Cyrus
1250 eval {
1251 require Authen::SASL;
1252 Authen::SASL->import(qw(Perl));
1255 # Check mechanism naming as defined in:
1256 # https://tools.ietf.org/html/rfc4422#page-8
1257 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1258 die "invalid smtp auth: '${smtp_auth}'";
1261 # TODO: Authentication may fail not because credentials were
1262 # invalid but due to other reasons, in which we should not
1263 # reject credentials.
1264 $auth = Git::credential({
1265 'protocol' => 'smtp',
1266 'host' => smtp_host_string(),
1267 'username' => $smtp_authuser,
1268 # if there's no password, "git credential fill" will
1269 # give us one, otherwise it'll just pass this one.
1270 'password' => $smtp_authpass
1271 }, sub {
1272 my $cred = shift;
1274 if ($smtp_auth) {
1275 my $sasl = Authen::SASL->new(
1276 mechanism => $smtp_auth,
1277 callback => {
1278 user => $cred->{'username'},
1279 pass => $cred->{'password'},
1280 authname => $cred->{'username'},
1284 return !!$smtp->auth($sasl);
1287 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1290 return $auth;
1293 sub ssl_verify_params {
1294 eval {
1295 require IO::Socket::SSL;
1296 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1298 if ($@) {
1299 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1300 return;
1303 if (!defined $smtp_ssl_cert_path) {
1304 # use the OpenSSL defaults
1305 return (SSL_verify_mode => SSL_VERIFY_PEER());
1308 if ($smtp_ssl_cert_path eq "") {
1309 return (SSL_verify_mode => SSL_VERIFY_NONE());
1310 } elsif (-d $smtp_ssl_cert_path) {
1311 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1312 SSL_ca_path => $smtp_ssl_cert_path);
1313 } elsif (-f $smtp_ssl_cert_path) {
1314 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1315 SSL_ca_file => $smtp_ssl_cert_path);
1316 } else {
1317 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1321 sub file_name_is_absolute {
1322 my ($path) = @_;
1324 # msys does not grok DOS drive-prefixes
1325 if ($^O eq 'msys') {
1326 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1329 require File::Spec::Functions;
1330 return File::Spec::Functions::file_name_is_absolute($path);
1333 # Prepares the email, then asks the user what to do.
1335 # If the user chooses to send the email, it's sent and 1 is returned.
1336 # If the user chooses not to send the email, 0 is returned.
1337 # If the user decides they want to make further edits, -1 is returned and the
1338 # caller is expected to call send_message again after the edits are performed.
1340 # If an error occurs sending the email, this just dies.
1342 sub send_message {
1343 my @recipients = unique_email_list(@to);
1344 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1345 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1347 @cc);
1348 my $to = join (",\n\t", @recipients);
1349 @recipients = unique_email_list(@recipients,@cc,@bcclist);
1350 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1351 my $date = format_2822_time($time++);
1352 my $gitversion = '@@GIT_VERSION@@';
1353 if ($gitversion =~ m/..GIT_VERSION../) {
1354 $gitversion = Git::version();
1357 my $cc = join(",\n\t", unique_email_list(@cc));
1358 my $ccline = "";
1359 if ($cc ne '') {
1360 $ccline = "\nCc: $cc";
1362 make_message_id() unless defined($message_id);
1364 my $header = "From: $sender
1365 To: $to${ccline}
1366 Subject: $subject
1367 Date: $date
1368 Message-Id: $message_id
1370 if ($use_xmailer) {
1371 $header .= "X-Mailer: git-send-email $gitversion\n";
1373 if ($in_reply_to) {
1375 $header .= "In-Reply-To: $in_reply_to\n";
1376 $header .= "References: $references\n";
1378 if ($reply_to) {
1379 $header .= "Reply-To: $reply_to\n";
1381 if (@xh) {
1382 $header .= join("\n", @xh) . "\n";
1385 my @sendmail_parameters = ('-i', @recipients);
1386 my $raw_from = $sender;
1387 if (defined $envelope_sender && $envelope_sender ne "auto") {
1388 $raw_from = $envelope_sender;
1390 $raw_from = extract_valid_address($raw_from);
1391 unshift (@sendmail_parameters,
1392 '-f', $raw_from) if(defined $envelope_sender);
1394 if ($needs_confirm && !$dry_run) {
1395 print "\n$header\n";
1396 if ($needs_confirm eq "inform") {
1397 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1398 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1399 print __ <<EOF ;
1400 The Cc list above has been expanded by additional
1401 addresses found in the patch commit message. By default
1402 send-email prompts before sending whenever this occurs.
1403 This behavior is controlled by the sendemail.confirm
1404 configuration setting.
1406 For additional information, run 'git send-email --help'.
1407 To retain the current behavior, but squelch this message,
1408 run 'git config --global sendemail.confirm auto'.
1412 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1413 # translation. The program will only accept English input
1414 # at this point.
1415 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1416 valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1417 default => $ask_default);
1418 die __("Send this email reply required") unless defined $_;
1419 if (/^n/i) {
1420 return 0;
1421 } elsif (/^e/i) {
1422 return -1;
1423 } elsif (/^q/i) {
1424 cleanup_compose_files();
1425 exit(0);
1426 } elsif (/^a/i) {
1427 $confirm = 'never';
1431 unshift (@sendmail_parameters, @smtp_server_options);
1433 if ($dry_run) {
1434 # We don't want to send the email.
1435 } elsif (file_name_is_absolute($smtp_server)) {
1436 my $pid = open my $sm, '|-';
1437 defined $pid or die $!;
1438 if (!$pid) {
1439 exec($smtp_server, @sendmail_parameters) or die $!;
1441 print $sm "$header\n$message";
1442 close $sm or die $!;
1443 } else {
1445 if (!defined $smtp_server) {
1446 die __("The required SMTP server is not properly defined.")
1449 require Net::SMTP;
1450 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1451 $smtp_domain ||= maildomain();
1453 if ($smtp_encryption eq 'ssl') {
1454 $smtp_server_port ||= 465; # ssmtp
1455 require IO::Socket::SSL;
1457 # Suppress "variable accessed once" warning.
1459 no warnings 'once';
1460 $IO::Socket::SSL::DEBUG = 1;
1463 # Net::SMTP::SSL->new() does not forward any SSL options
1464 IO::Socket::SSL::set_client_defaults(
1465 ssl_verify_params());
1467 if ($use_net_smtp_ssl) {
1468 require Net::SMTP::SSL;
1469 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1470 Hello => $smtp_domain,
1471 Port => $smtp_server_port,
1472 Debug => $debug_net_smtp);
1474 else {
1475 $smtp ||= Net::SMTP->new($smtp_server,
1476 Hello => $smtp_domain,
1477 Port => $smtp_server_port,
1478 Debug => $debug_net_smtp,
1479 SSL => 1);
1482 else {
1483 $smtp_server_port ||= 25;
1484 $smtp ||= Net::SMTP->new($smtp_server,
1485 Hello => $smtp_domain,
1486 Debug => $debug_net_smtp,
1487 Port => $smtp_server_port);
1488 if ($smtp_encryption eq 'tls' && $smtp) {
1489 if ($use_net_smtp_ssl) {
1490 $smtp->command('STARTTLS');
1491 $smtp->response();
1492 if ($smtp->code != 220) {
1493 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1495 require Net::SMTP::SSL;
1496 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1497 ssl_verify_params())
1498 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1500 else {
1501 $smtp->starttls(ssl_verify_params())
1502 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1504 $smtp_encryption = '';
1505 # Send EHLO again to receive fresh
1506 # supported commands
1507 $smtp->hello($smtp_domain);
1511 if (!$smtp) {
1512 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1513 " VALUES: server=$smtp_server ",
1514 "encryption=$smtp_encryption ",
1515 "hello=$smtp_domain",
1516 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1519 smtp_auth_maybe or die $smtp->message;
1521 $smtp->mail( $raw_from ) or die $smtp->message;
1522 $smtp->to( @recipients ) or die $smtp->message;
1523 $smtp->data or die $smtp->message;
1524 $smtp->datasend("$header\n") or die $smtp->message;
1525 my @lines = split /^/, $message;
1526 foreach my $line (@lines) {
1527 $smtp->datasend("$line") or die $smtp->message;
1529 $smtp->dataend() or die $smtp->message;
1530 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1532 if ($quiet) {
1533 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1534 } else {
1535 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1536 if (!file_name_is_absolute($smtp_server)) {
1537 print "Server: $smtp_server\n";
1538 print "MAIL FROM:<$raw_from>\n";
1539 foreach my $entry (@recipients) {
1540 print "RCPT TO:<$entry>\n";
1542 } else {
1543 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1545 print $header, "\n";
1546 if ($smtp) {
1547 print __("Result: "), $smtp->code, ' ',
1548 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1549 } else {
1550 print __("Result: OK\n");
1554 return 1;
1557 $in_reply_to = $initial_in_reply_to;
1558 $references = $initial_in_reply_to || '';
1559 $subject = $initial_subject;
1560 $message_num = 0;
1562 # Prepares the email, prompts the user, sends it out
1563 # Returns 0 if an edit was done and the function should be called again, or 1
1564 # otherwise.
1565 sub process_file {
1566 my ($t) = @_;
1568 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1570 my $author = undef;
1571 my $sauthor = undef;
1572 my $author_encoding;
1573 my $has_content_type;
1574 my $body_encoding;
1575 my $xfer_encoding;
1576 my $has_mime_version;
1577 @to = ();
1578 @cc = ();
1579 @xh = ();
1580 my $input_format = undef;
1581 my @header = ();
1582 $message = "";
1583 $message_num++;
1584 # First unfold multiline header fields
1585 while(<$fh>) {
1586 last if /^\s*$/;
1587 if (/^\s+\S/ and @header) {
1588 chomp($header[$#header]);
1589 s/^\s+/ /;
1590 $header[$#header] .= $_;
1591 } else {
1592 push(@header, $_);
1595 # Now parse the header
1596 foreach(@header) {
1597 if (/^From /) {
1598 $input_format = 'mbox';
1599 next;
1601 chomp;
1602 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1603 $input_format = 'mbox';
1606 if (defined $input_format && $input_format eq 'mbox') {
1607 if (/^Subject:\s+(.*)$/i) {
1608 $subject = $1;
1610 elsif (/^From:\s+(.*)$/i) {
1611 ($author, $author_encoding) = unquote_rfc2047($1);
1612 $sauthor = sanitize_address($author);
1613 next if $suppress_cc{'author'};
1614 next if $suppress_cc{'self'} and $sauthor eq $sender;
1615 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1616 $1, $_) unless $quiet;
1617 push @cc, $1;
1619 elsif (/^To:\s+(.*)$/i) {
1620 foreach my $addr (parse_address_line($1)) {
1621 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1622 $addr, $_) unless $quiet;
1623 push @to, $addr;
1626 elsif (/^Cc:\s+(.*)$/i) {
1627 foreach my $addr (parse_address_line($1)) {
1628 my $qaddr = unquote_rfc2047($addr);
1629 my $saddr = sanitize_address($qaddr);
1630 if ($saddr eq $sender) {
1631 next if ($suppress_cc{'self'});
1632 } else {
1633 next if ($suppress_cc{'cc'});
1635 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1636 $addr, $_) unless $quiet;
1637 push @cc, $addr;
1640 elsif (/^Content-type:/i) {
1641 $has_content_type = 1;
1642 if (/charset="?([^ "]+)/) {
1643 $body_encoding = $1;
1645 push @xh, $_;
1647 elsif (/^MIME-Version/i) {
1648 $has_mime_version = 1;
1649 push @xh, $_;
1651 elsif (/^Message-Id: (.*)/i) {
1652 $message_id = $1;
1654 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1655 $xfer_encoding = $1 if not defined $xfer_encoding;
1657 elsif (/^In-Reply-To: (.*)/i) {
1658 $in_reply_to = $1;
1660 elsif (/^References: (.*)/i) {
1661 $references = $1;
1663 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1664 push @xh, $_;
1666 } else {
1667 # In the traditional
1668 # "send lots of email" format,
1669 # line 1 = cc
1670 # line 2 = subject
1671 # So let's support that, too.
1672 $input_format = 'lots';
1673 if (@cc == 0 && !$suppress_cc{'cc'}) {
1674 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1675 $_, $_) unless $quiet;
1676 push @cc, $_;
1677 } elsif (!defined $subject) {
1678 $subject = $_;
1682 # Now parse the message body
1683 while(<$fh>) {
1684 $message .= $_;
1685 if (/^(Signed-off-by|Cc): (.*)/i) {
1686 chomp;
1687 my ($what, $c) = ($1, $2);
1688 # strip garbage for the address we'll use:
1689 $c = strip_garbage_one_address($c);
1690 # sanitize a bit more to decide whether to suppress the address:
1691 my $sc = sanitize_address($c);
1692 if ($sc eq $sender) {
1693 next if ($suppress_cc{'self'});
1694 } else {
1695 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1696 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1698 push @cc, $c;
1699 printf(__("(body) Adding cc: %s from line '%s'\n"),
1700 $c, $_) unless $quiet;
1703 close $fh;
1705 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1706 if defined $to_cmd;
1707 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1708 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1710 if ($broken_encoding{$t} && !$has_content_type) {
1711 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1712 $has_content_type = 1;
1713 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1714 $body_encoding = $auto_8bit_encoding;
1717 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1718 $subject = quote_subject($subject, $auto_8bit_encoding);
1721 if (defined $sauthor and $sauthor ne $sender) {
1722 $message = "From: $author\n\n$message";
1723 if (defined $author_encoding) {
1724 if ($has_content_type) {
1725 if ($body_encoding eq $author_encoding) {
1726 # ok, we already have the right encoding
1728 else {
1729 # uh oh, we should re-encode
1732 else {
1733 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1734 $has_content_type = 1;
1735 push @xh,
1736 "Content-Type: text/plain; charset=$author_encoding";
1740 if (defined $target_xfer_encoding) {
1741 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1742 $message = apply_transfer_encoding(
1743 $message, $xfer_encoding, $target_xfer_encoding);
1744 $xfer_encoding = $target_xfer_encoding;
1746 if (defined $xfer_encoding) {
1747 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1749 if (defined $xfer_encoding or $has_content_type) {
1750 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1753 $needs_confirm = (
1754 $confirm eq "always" or
1755 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1756 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1757 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1759 @to = process_address_list(@to);
1760 @cc = process_address_list(@cc);
1762 @to = (@initial_to, @to);
1763 @cc = (@initial_cc, @cc);
1765 if ($message_num == 1) {
1766 if (defined $cover_cc and $cover_cc) {
1767 @initial_cc = @cc;
1769 if (defined $cover_to and $cover_to) {
1770 @initial_to = @to;
1774 my $message_was_sent = send_message();
1775 if ($message_was_sent == -1) {
1776 do_edit($t);
1777 return 0;
1780 # set up for the next message
1781 if ($thread && $message_was_sent &&
1782 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1783 $message_num == 1)) {
1784 $in_reply_to = $message_id;
1785 if (length $references > 0) {
1786 $references .= "\n $message_id";
1787 } else {
1788 $references = "$message_id";
1791 $message_id = undef;
1792 $num_sent++;
1793 if (defined $batch_size && $num_sent == $batch_size) {
1794 $num_sent = 0;
1795 $smtp->quit if defined $smtp;
1796 undef $smtp;
1797 undef $auth;
1798 sleep($relogin_delay) if defined $relogin_delay;
1801 return 1;
1804 foreach my $t (@files) {
1805 while (!process_file($t)) {
1806 # user edited the file
1810 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1811 # and return a results array
1812 sub recipients_cmd {
1813 my ($prefix, $what, $cmd, $file) = @_;
1815 my @addresses = ();
1816 open my $fh, "-|", "$cmd \Q$file\E"
1817 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1818 while (my $address = <$fh>) {
1819 $address =~ s/^\s*//g;
1820 $address =~ s/\s*$//g;
1821 $address = sanitize_address($address);
1822 next if ($address eq $sender and $suppress_cc{'self'});
1823 push @addresses, $address;
1824 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1825 $prefix, $what, $address, $cmd) unless $quiet;
1827 close $fh
1828 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1829 return @addresses;
1832 cleanup_compose_files();
1834 sub cleanup_compose_files {
1835 unlink($compose_filename, $compose_filename . ".final") if $compose;
1838 $smtp->quit if $smtp;
1840 sub apply_transfer_encoding {
1841 my $message = shift;
1842 my $from = shift;
1843 my $to = shift;
1845 return $message if ($from eq $to and $from ne '7bit');
1847 require MIME::QuotedPrint;
1848 require MIME::Base64;
1850 $message = MIME::QuotedPrint::decode($message)
1851 if ($from eq 'quoted-printable');
1852 $message = MIME::Base64::decode($message)
1853 if ($from eq 'base64');
1855 die __("cannot send message as 7bit")
1856 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1857 return $message
1858 if ($to eq '7bit' or $to eq '8bit');
1859 return MIME::QuotedPrint::encode($message, "\n", 0)
1860 if ($to eq 'quoted-printable');
1861 return MIME::Base64::encode($message, "\n")
1862 if ($to eq 'base64');
1863 die __("invalid transfer encoding");
1866 sub unique_email_list {
1867 my %seen;
1868 my @emails;
1870 foreach my $entry (@_) {
1871 my $clean = extract_valid_address_or_die($entry);
1872 $seen{$clean} ||= 0;
1873 next if $seen{$clean}++;
1874 push @emails, $entry;
1876 return @emails;
1879 sub validate_patch {
1880 my $fn = shift;
1882 if ($repo) {
1883 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1884 'sendemail-validate');
1885 my $hook_error;
1886 if (-x $validate_hook) {
1887 my $target = abs_path($fn);
1888 # The hook needs a correct cwd and GIT_DIR.
1889 my $cwd_save = cwd();
1890 chdir($repo->wc_path() or $repo->repo_path())
1891 or die("chdir: $!");
1892 local $ENV{"GIT_DIR"} = $repo->repo_path();
1893 $hook_error = "rejected by sendemail-validate hook"
1894 if system($validate_hook, $target);
1895 chdir($cwd_save) or die("chdir: $!");
1897 return $hook_error if $hook_error;
1900 open(my $fh, '<', $fn)
1901 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1902 while (my $line = <$fh>) {
1903 if (length($line) > 998) {
1904 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1907 return;
1910 sub handle_backup {
1911 my ($last, $lastlen, $file, $known_suffix) = @_;
1912 my ($suffix, $skip);
1914 $skip = 0;
1915 if (defined $last &&
1916 ($lastlen < length($file)) &&
1917 (substr($file, 0, $lastlen) eq $last) &&
1918 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1919 if (defined $known_suffix && $suffix eq $known_suffix) {
1920 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1921 $skip = 1;
1922 } else {
1923 # TRANSLATORS: please keep "[y|N]" as is.
1924 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1925 valid_re => qr/^(?:y|n)/i,
1926 default => 'n');
1927 $skip = ($answer ne 'y');
1928 if ($skip) {
1929 $known_suffix = $suffix;
1933 return ($skip, $known_suffix);
1936 sub handle_backup_files {
1937 my @file = @_;
1938 my ($last, $lastlen, $known_suffix, $skip, @result);
1939 for my $file (@file) {
1940 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1941 $file, $known_suffix);
1942 push @result, $file unless $skip;
1943 $last = $file;
1944 $lastlen = length($file);
1946 return @result;
1949 sub file_has_nonascii {
1950 my $fn = shift;
1951 open(my $fh, '<', $fn)
1952 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1953 while (my $line = <$fh>) {
1954 return 1 if $line =~ /[^[:ascii:]]/;
1956 return 0;
1959 sub body_or_subject_has_nonascii {
1960 my $fn = shift;
1961 open(my $fh, '<', $fn)
1962 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1963 while (my $line = <$fh>) {
1964 last if $line =~ /^$/;
1965 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1967 while (my $line = <$fh>) {
1968 return 1 if $line =~ /[^[:ascii:]]/;
1970 return 0;