Git 2.22-rc2
[git/debian.git] / git-send-email.perl
blob24859a7bc37b05909cf16554c102cadc842c13ff
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 # Please update $__git_send_email_suppresscc_options
469 # in git-completion.bash when you add new options.
470 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
471 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc|misc-by)$/;
472 $suppress_cc{$entry} = 1;
476 if ($suppress_cc{'all'}) {
477 foreach my $entry (qw (cccmd cc author self sob body bodycc misc-by)) {
478 $suppress_cc{$entry} = 1;
480 delete $suppress_cc{'all'};
483 # If explicit old-style ones are specified, they trump --suppress-cc.
484 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
485 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
487 if ($suppress_cc{'body'}) {
488 foreach my $entry (qw (sob bodycc misc-by)) {
489 $suppress_cc{$entry} = 1;
491 delete $suppress_cc{'body'};
494 # Set confirm's default value
495 my $confirm_unconfigured = !defined $confirm;
496 if ($confirm_unconfigured) {
497 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
499 # Please update $__git_send_email_confirm_options in
500 # git-completion.bash when you add new options.
501 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
502 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
504 # Debugging, print out the suppressions.
505 if (0) {
506 print "suppressions:\n";
507 foreach my $entry (keys %suppress_cc) {
508 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
512 my ($repoauthor, $repocommitter);
513 ($repoauthor) = Git::ident_person(@repo, 'author');
514 ($repocommitter) = Git::ident_person(@repo, 'committer');
516 sub parse_address_line {
517 return map { $_->format } Mail::Address->parse($_[0]);
520 sub split_addrs {
521 return quotewords('\s*,\s*', 1, @_);
524 my %aliases;
526 sub parse_sendmail_alias {
527 local $_ = shift;
528 if (/"/) {
529 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
530 } elsif (/:include:/) {
531 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
532 } elsif (/[\/|]/) {
533 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
534 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
535 my ($alias, $addr) = ($1, $2);
536 $aliases{$alias} = [ split_addrs($addr) ];
537 } else {
538 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
542 sub parse_sendmail_aliases {
543 my $fh = shift;
544 my $s = '';
545 while (<$fh>) {
546 chomp;
547 next if /^\s*$/ || /^\s*#/;
548 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
549 parse_sendmail_alias($s) if $s;
550 $s = $_;
552 $s =~ s/\\$//; # silently tolerate stray '\' on last line
553 parse_sendmail_alias($s) if $s;
556 my %parse_alias = (
557 # multiline formats can be supported in the future
558 mutt => sub { my $fh = shift; while (<$fh>) {
559 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
560 my ($alias, $addr) = ($1, $2);
561 $addr =~ s/#.*$//; # mutt allows # comments
562 # commas delimit multiple addresses
563 my @addr = split_addrs($addr);
565 # quotes may be escaped in the file,
566 # unescape them so we do not double-escape them later.
567 s/\\"/"/g foreach @addr;
568 $aliases{$alias} = \@addr
569 }}},
570 mailrc => sub { my $fh = shift; while (<$fh>) {
571 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
572 # spaces delimit multiple addresses
573 $aliases{$1} = [ quotewords('\s+', 0, $2) ];
574 }}},
575 pine => sub { my $fh = shift; my $f='\t[^\t]*';
576 for (my $x = ''; defined($x); $x = $_) {
577 chomp $x;
578 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
579 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
580 $aliases{$1} = [ split_addrs($2) ];
582 elm => sub { my $fh = shift;
583 while (<$fh>) {
584 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
585 my ($alias, $addr) = ($1, $2);
586 $aliases{$alias} = [ split_addrs($addr) ];
588 } },
589 sendmail => \&parse_sendmail_aliases,
590 gnus => sub { my $fh = shift; while (<$fh>) {
591 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
592 $aliases{$1} = [ $2 ];
594 # Please update _git_config() in git-completion.bash when you
595 # add new MUAs.
598 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
599 foreach my $file (@alias_files) {
600 open my $fh, '<', $file or die "opening $file: $!\n";
601 $parse_alias{$aliasfiletype}->($fh);
602 close $fh;
606 if ($dump_aliases) {
607 print "$_\n" for (sort keys %aliases);
608 exit(0);
611 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
612 # $f is a revision list specification to be passed to format-patch.
613 sub is_format_patch_arg {
614 return unless $repo;
615 my $f = shift;
616 try {
617 $repo->command('rev-parse', '--verify', '--quiet', $f);
618 if (defined($format_patch)) {
619 return $format_patch;
621 die sprintf(__ <<EOF, $f, $f);
622 File '%s' exists but it could also be the range of commits
623 to produce patches for. Please disambiguate by...
625 * Saying "./%s" if you mean a file; or
626 * Giving --format-patch option if you mean a range.
628 } catch Git::Error::Command with {
629 # Not a valid revision. Treat it as a filename.
630 return 0;
634 # Now that all the defaults are set, process the rest of the command line
635 # arguments and collect up the files that need to be processed.
636 my @rev_list_opts;
637 while (defined(my $f = shift @ARGV)) {
638 if ($f eq "--") {
639 push @rev_list_opts, "--", @ARGV;
640 @ARGV = ();
641 } elsif (-d $f and !is_format_patch_arg($f)) {
642 opendir my $dh, $f
643 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
645 push @files, grep { -f $_ } map { catfile($f, $_) }
646 sort readdir $dh;
647 closedir $dh;
648 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
649 push @files, $f;
650 } else {
651 push @rev_list_opts, $f;
655 if (@rev_list_opts) {
656 die __("Cannot run git format-patch from outside a repository\n")
657 unless $repo;
658 push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
661 @files = handle_backup_files(@files);
663 if ($validate) {
664 foreach my $f (@files) {
665 unless (-p $f) {
666 my $error = validate_patch($f, $target_xfer_encoding);
667 $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
668 $f, $error);
673 if (@files) {
674 unless ($quiet) {
675 print $_,"\n" for (@files);
677 } else {
678 print STDERR __("\nNo patch files specified!\n\n");
679 usage();
682 sub get_patch_subject {
683 my $fn = shift;
684 open (my $fh, '<', $fn);
685 while (my $line = <$fh>) {
686 next unless ($line =~ /^Subject: (.*)$/);
687 close $fh;
688 return "GIT: $1\n";
690 close $fh;
691 die sprintf(__("No subject line in %s?"), $fn);
694 if ($compose) {
695 # Note that this does not need to be secure, but we will make a small
696 # effort to have it be unique
697 $compose_filename = ($repo ?
698 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
699 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
700 open my $c, ">", $compose_filename
701 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
704 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
705 my $tpl_subject = $initial_subject || '';
706 my $tpl_in_reply_to = $initial_in_reply_to || '';
707 my $tpl_reply_to = $reply_to || '';
709 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
710 From $tpl_sender # This line is ignored.
711 EOT1
712 Lines beginning in "GIT:" will be removed.
713 Consider including an overall diffstat or table of contents
714 for the patch you are writing.
716 Clear the body content if you don't wish to send a summary.
717 EOT2
718 From: $tpl_sender
719 Reply-To: $tpl_reply_to
720 Subject: $tpl_subject
721 In-Reply-To: $tpl_in_reply_to
723 EOT3
724 for my $f (@files) {
725 print $c get_patch_subject($f);
727 close $c;
729 if ($annotate) {
730 do_edit($compose_filename, @files);
731 } else {
732 do_edit($compose_filename);
735 open $c, "<", $compose_filename
736 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
738 if (!defined $compose_encoding) {
739 $compose_encoding = "UTF-8";
742 my %parsed_email;
743 while (my $line = <$c>) {
744 next if $line =~ m/^GIT:/;
745 parse_header_line($line, \%parsed_email);
746 if ($line =~ /^$/) {
747 $parsed_email{'body'} = filter_body($c);
750 close $c;
752 open my $c2, ">", $compose_filename . ".final"
753 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
756 if ($parsed_email{'From'}) {
757 $sender = delete($parsed_email{'From'});
759 if ($parsed_email{'In-Reply-To'}) {
760 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
762 if ($parsed_email{'Reply-To'}) {
763 $reply_to = delete($parsed_email{'Reply-To'});
765 if ($parsed_email{'Subject'}) {
766 $initial_subject = delete($parsed_email{'Subject'});
767 print $c2 "Subject: " .
768 quote_subject($initial_subject, $compose_encoding) .
769 "\n";
772 if ($parsed_email{'MIME-Version'}) {
773 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
774 "Content-Type: $parsed_email{'Content-Type'};\n",
775 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
776 delete($parsed_email{'MIME-Version'});
777 delete($parsed_email{'Content-Type'});
778 delete($parsed_email{'Content-Transfer-Encoding'});
779 } elsif (file_has_nonascii($compose_filename)) {
780 my $content_type = (delete($parsed_email{'Content-Type'}) or
781 "text/plain; charset=$compose_encoding");
782 print $c2 "MIME-Version: 1.0\n",
783 "Content-Type: $content_type\n",
784 "Content-Transfer-Encoding: 8bit\n";
786 # Preserve unknown headers
787 foreach my $key (keys %parsed_email) {
788 next if $key eq 'body';
789 print $c2 "$key: $parsed_email{$key}";
792 if ($parsed_email{'body'}) {
793 print $c2 "\n$parsed_email{'body'}\n";
794 delete($parsed_email{'body'});
795 } else {
796 print __("Summary email is empty, skipping it\n");
797 $compose = -1;
800 close $c2;
802 } elsif ($annotate) {
803 do_edit(@files);
806 sub ask {
807 my ($prompt, %arg) = @_;
808 my $valid_re = $arg{valid_re};
809 my $default = $arg{default};
810 my $confirm_only = $arg{confirm_only};
811 my $resp;
812 my $i = 0;
813 return defined $default ? $default : undef
814 unless defined $term->IN and defined fileno($term->IN) and
815 defined $term->OUT and defined fileno($term->OUT);
816 while ($i++ < 10) {
817 $resp = $term->readline($prompt);
818 if (!defined $resp) { # EOF
819 print "\n";
820 return defined $default ? $default : undef;
822 if ($resp eq '' and defined $default) {
823 return $default;
825 if (!defined $valid_re or $resp =~ /$valid_re/) {
826 return $resp;
828 if ($confirm_only) {
829 my $yesno = $term->readline(
830 # TRANSLATORS: please keep [y/N] as is.
831 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
832 if (defined $yesno && $yesno =~ /y/i) {
833 return $resp;
837 return;
840 sub parse_header_line {
841 my $lines = shift;
842 my $parsed_line = shift;
843 my $addr_pat = join "|", qw(To Cc Bcc);
845 foreach (split(/\n/, $lines)) {
846 if (/^($addr_pat):\s*(.+)$/i) {
847 $parsed_line->{$1} = [ parse_address_line($2) ];
848 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
849 $parsed_line->{$1} = $2;
854 sub filter_body {
855 my $c = shift;
856 my $body = "";
857 while (my $body_line = <$c>) {
858 if ($body_line !~ m/^GIT:/) {
859 $body .= $body_line;
862 return $body;
866 my %broken_encoding;
868 sub file_declares_8bit_cte {
869 my $fn = shift;
870 open (my $fh, '<', $fn);
871 while (my $line = <$fh>) {
872 last if ($line =~ /^$/);
873 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
875 close $fh;
876 return 0;
879 foreach my $f (@files) {
880 next unless (body_or_subject_has_nonascii($f)
881 && !file_declares_8bit_cte($f));
882 $broken_encoding{$f} = 1;
885 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
886 print __("The following files are 8bit, but do not declare " .
887 "a Content-Transfer-Encoding.\n");
888 foreach my $f (sort keys %broken_encoding) {
889 print " $f\n";
891 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
892 valid_re => qr/.{4}/, confirm_only => 1,
893 default => "UTF-8");
896 if (!$force) {
897 for my $f (@files) {
898 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
899 die sprintf(__("Refusing to send because the patch\n\t%s\n"
900 . "has the template subject '*** SUBJECT HERE ***'. "
901 . "Pass --force if you really want to send.\n"), $f);
906 if (defined $sender) {
907 $sender =~ s/^\s+|\s+$//g;
908 ($sender) = expand_aliases($sender);
909 } else {
910 $sender = $repoauthor || $repocommitter || '';
913 # $sender could be an already sanitized address
914 # (e.g. sendemail.from could be manually sanitized by user).
915 # But it's a no-op to run sanitize_address on an already sanitized address.
916 $sender = sanitize_address($sender);
918 my $to_whom = __("To whom should the emails be sent (if anyone)?");
919 my $prompting = 0;
920 if (!@initial_to && !defined $to_cmd) {
921 my $to = ask("$to_whom ",
922 default => "",
923 valid_re => qr/\@.*\./, confirm_only => 1);
924 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
925 $prompting++;
928 sub expand_aliases {
929 return map { expand_one_alias($_) } @_;
932 my %EXPANDED_ALIASES;
933 sub expand_one_alias {
934 my $alias = shift;
935 if ($EXPANDED_ALIASES{$alias}) {
936 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
938 local $EXPANDED_ALIASES{$alias} = 1;
939 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
942 @initial_to = process_address_list(@initial_to);
943 @initial_cc = process_address_list(@initial_cc);
944 @bcclist = process_address_list(@bcclist);
946 if ($thread && !defined $initial_in_reply_to && $prompting) {
947 $initial_in_reply_to = ask(
948 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
949 default => "",
950 valid_re => qr/\@.*\./, confirm_only => 1);
952 if (defined $initial_in_reply_to) {
953 $initial_in_reply_to =~ s/^\s*<?//;
954 $initial_in_reply_to =~ s/>?\s*$//;
955 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
958 if (defined $reply_to) {
959 $reply_to =~ s/^\s+|\s+$//g;
960 ($reply_to) = expand_aliases($reply_to);
961 $reply_to = sanitize_address($reply_to);
964 if (!defined $smtp_server) {
965 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
966 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
967 foreach (@sendmail_paths) {
968 if (-x $_) {
969 $smtp_server = $_;
970 last;
973 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
976 if ($compose && $compose > 0) {
977 @files = ($compose_filename . ".final", @files);
980 # Variables we set as part of the loop over files
981 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
982 $needs_confirm, $message_num, $ask_default);
984 sub extract_valid_address {
985 my $address = shift;
986 my $local_part_regexp = qr/[^<>"\s@]+/;
987 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
989 # check for a local address:
990 return $address if ($address =~ /^($local_part_regexp)$/);
992 $address =~ s/^\s*<(.*)>\s*$/$1/;
993 if ($have_email_valid) {
994 return scalar Email::Valid->address($address);
997 # less robust/correct than the monster regexp in Email::Valid,
998 # but still does a 99% job, and one less dependency
999 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1000 return;
1003 sub extract_valid_address_or_die {
1004 my $address = shift;
1005 $address = extract_valid_address($address);
1006 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1007 if !$address;
1008 return $address;
1011 sub validate_address {
1012 my $address = shift;
1013 while (!extract_valid_address($address)) {
1014 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1015 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1016 # translation. The program will only accept English input
1017 # at this point.
1018 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1019 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1020 default => 'q');
1021 if (/^d/i) {
1022 return undef;
1023 } elsif (/^q/i) {
1024 cleanup_compose_files();
1025 exit(0);
1027 $address = ask("$to_whom ",
1028 default => "",
1029 valid_re => qr/\@.*\./, confirm_only => 1);
1031 return $address;
1034 sub validate_address_list {
1035 return (grep { defined $_ }
1036 map { validate_address($_) } @_);
1039 # Usually don't need to change anything below here.
1041 # we make a "fake" message id by taking the current number
1042 # of seconds since the beginning of Unix time and tacking on
1043 # a random number to the end, in case we are called quicker than
1044 # 1 second since the last time we were called.
1046 # We'll setup a template for the message id, using the "from" address:
1048 my ($message_id_stamp, $message_id_serial);
1049 sub make_message_id {
1050 my $uniq;
1051 if (!defined $message_id_stamp) {
1052 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1053 $message_id_serial = 0;
1055 $message_id_serial++;
1056 $uniq = "$message_id_stamp-$message_id_serial";
1058 my $du_part;
1059 for ($sender, $repocommitter, $repoauthor) {
1060 $du_part = extract_valid_address(sanitize_address($_));
1061 last if (defined $du_part and $du_part ne '');
1063 if (not defined $du_part or $du_part eq '') {
1064 require Sys::Hostname;
1065 $du_part = 'user@' . Sys::Hostname::hostname();
1067 my $message_id_template = "<%s-%s>";
1068 $message_id = sprintf($message_id_template, $uniq, $du_part);
1069 #print "new message id = $message_id\n"; # Was useful for debugging
1074 $time = time - scalar $#files;
1076 sub unquote_rfc2047 {
1077 local ($_) = @_;
1078 my $charset;
1079 my $sep = qr/[ \t]+/;
1080 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1081 my @words = split $sep, $&;
1082 foreach (@words) {
1083 m/$re_encoded_word/;
1084 $charset = $1;
1085 my $encoding = $2;
1086 my $text = $3;
1087 if ($encoding eq 'q' || $encoding eq 'Q') {
1088 $_ = $text;
1089 s/_/ /g;
1090 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1091 } else {
1092 # other encodings not supported yet
1095 join '', @words;
1096 }eg;
1097 return wantarray ? ($_, $charset) : $_;
1100 sub quote_rfc2047 {
1101 local $_ = shift;
1102 my $encoding = shift || 'UTF-8';
1103 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1104 s/(.*)/=\?$encoding\?q\?$1\?=/;
1105 return $_;
1108 sub is_rfc2047_quoted {
1109 my $s = shift;
1110 length($s) <= 75 &&
1111 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1114 sub subject_needs_rfc2047_quoting {
1115 my $s = shift;
1117 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1120 sub quote_subject {
1121 local $subject = shift;
1122 my $encoding = shift || 'UTF-8';
1124 if (subject_needs_rfc2047_quoting($subject)) {
1125 return quote_rfc2047($subject, $encoding);
1127 return $subject;
1130 # use the simplest quoting being able to handle the recipient
1131 sub sanitize_address {
1132 my ($recipient) = @_;
1134 # remove garbage after email address
1135 $recipient =~ s/(.*>).*$/$1/;
1137 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1139 if (not $recipient_name) {
1140 return $recipient;
1143 # if recipient_name is already quoted, do nothing
1144 if (is_rfc2047_quoted($recipient_name)) {
1145 return $recipient;
1148 # remove non-escaped quotes
1149 $recipient_name =~ s/(^|[^\\])"/$1/g;
1151 # rfc2047 is needed if a non-ascii char is included
1152 if ($recipient_name =~ /[^[:ascii:]]/) {
1153 $recipient_name = quote_rfc2047($recipient_name);
1156 # double quotes are needed if specials or CTLs are included
1157 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1158 $recipient_name =~ s/([\\\r])/\\$1/g;
1159 $recipient_name = qq["$recipient_name"];
1162 return "$recipient_name $recipient_addr";
1166 sub strip_garbage_one_address {
1167 my ($addr) = @_;
1168 chomp $addr;
1169 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1170 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1171 # Foo Bar <foobar@example.com> [possibly garbage here]
1172 return $1;
1174 if ($addr =~ /^(<[^>]*>).*/) {
1175 # <foo@example.com> [possibly garbage here]
1176 # if garbage contains other addresses, they are ignored.
1177 return $1;
1179 if ($addr =~ /^([^"#,\s]*)/) {
1180 # address without quoting: remove anything after the address
1181 return $1;
1183 return $addr;
1186 sub sanitize_address_list {
1187 return (map { sanitize_address($_) } @_);
1190 sub process_address_list {
1191 my @addr_list = map { parse_address_line($_) } @_;
1192 @addr_list = expand_aliases(@addr_list);
1193 @addr_list = sanitize_address_list(@addr_list);
1194 @addr_list = validate_address_list(@addr_list);
1195 return @addr_list;
1198 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1200 # Tightly configured MTAa require that a caller sends a real DNS
1201 # domain name that corresponds the IP address in the HELO/EHLO
1202 # handshake. This is used to verify the connection and prevent
1203 # spammers from trying to hide their identity. If the DNS and IP don't
1204 # match, the receiveing MTA may deny the connection.
1206 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1208 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1209 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1211 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1212 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1214 sub valid_fqdn {
1215 my $domain = shift;
1216 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1219 sub maildomain_net {
1220 my $maildomain;
1222 my $domain = Net::Domain::domainname();
1223 $maildomain = $domain if valid_fqdn($domain);
1225 return $maildomain;
1228 sub maildomain_mta {
1229 my $maildomain;
1231 for my $host (qw(mailhost localhost)) {
1232 my $smtp = Net::SMTP->new($host);
1233 if (defined $smtp) {
1234 my $domain = $smtp->domain;
1235 $smtp->quit;
1237 $maildomain = $domain if valid_fqdn($domain);
1239 last if $maildomain;
1243 return $maildomain;
1246 sub maildomain {
1247 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1250 sub smtp_host_string {
1251 if (defined $smtp_server_port) {
1252 return "$smtp_server:$smtp_server_port";
1253 } else {
1254 return $smtp_server;
1258 # Returns 1 if authentication succeeded or was not necessary
1259 # (smtp_user was not specified), and 0 otherwise.
1261 sub smtp_auth_maybe {
1262 if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1263 return 1;
1266 # Workaround AUTH PLAIN/LOGIN interaction defect
1267 # with Authen::SASL::Cyrus
1268 eval {
1269 require Authen::SASL;
1270 Authen::SASL->import(qw(Perl));
1273 # Check mechanism naming as defined in:
1274 # https://tools.ietf.org/html/rfc4422#page-8
1275 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1276 die "invalid smtp auth: '${smtp_auth}'";
1279 # TODO: Authentication may fail not because credentials were
1280 # invalid but due to other reasons, in which we should not
1281 # reject credentials.
1282 $auth = Git::credential({
1283 'protocol' => 'smtp',
1284 'host' => smtp_host_string(),
1285 'username' => $smtp_authuser,
1286 # if there's no password, "git credential fill" will
1287 # give us one, otherwise it'll just pass this one.
1288 'password' => $smtp_authpass
1289 }, sub {
1290 my $cred = shift;
1292 if ($smtp_auth) {
1293 my $sasl = Authen::SASL->new(
1294 mechanism => $smtp_auth,
1295 callback => {
1296 user => $cred->{'username'},
1297 pass => $cred->{'password'},
1298 authname => $cred->{'username'},
1302 return !!$smtp->auth($sasl);
1305 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1308 return $auth;
1311 sub ssl_verify_params {
1312 eval {
1313 require IO::Socket::SSL;
1314 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1316 if ($@) {
1317 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1318 return;
1321 if (!defined $smtp_ssl_cert_path) {
1322 # use the OpenSSL defaults
1323 return (SSL_verify_mode => SSL_VERIFY_PEER());
1326 if ($smtp_ssl_cert_path eq "") {
1327 return (SSL_verify_mode => SSL_VERIFY_NONE());
1328 } elsif (-d $smtp_ssl_cert_path) {
1329 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1330 SSL_ca_path => $smtp_ssl_cert_path);
1331 } elsif (-f $smtp_ssl_cert_path) {
1332 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1333 SSL_ca_file => $smtp_ssl_cert_path);
1334 } else {
1335 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1339 sub file_name_is_absolute {
1340 my ($path) = @_;
1342 # msys does not grok DOS drive-prefixes
1343 if ($^O eq 'msys') {
1344 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1347 require File::Spec::Functions;
1348 return File::Spec::Functions::file_name_is_absolute($path);
1351 # Prepares the email, then asks the user what to do.
1353 # If the user chooses to send the email, it's sent and 1 is returned.
1354 # If the user chooses not to send the email, 0 is returned.
1355 # If the user decides they want to make further edits, -1 is returned and the
1356 # caller is expected to call send_message again after the edits are performed.
1358 # If an error occurs sending the email, this just dies.
1360 sub send_message {
1361 my @recipients = unique_email_list(@to);
1362 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1363 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1365 @cc);
1366 my $to = join (",\n\t", @recipients);
1367 @recipients = unique_email_list(@recipients,@cc,@bcclist);
1368 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1369 my $date = format_2822_time($time++);
1370 my $gitversion = '@@GIT_VERSION@@';
1371 if ($gitversion =~ m/..GIT_VERSION../) {
1372 $gitversion = Git::version();
1375 my $cc = join(",\n\t", unique_email_list(@cc));
1376 my $ccline = "";
1377 if ($cc ne '') {
1378 $ccline = "\nCc: $cc";
1380 make_message_id() unless defined($message_id);
1382 my $header = "From: $sender
1383 To: $to${ccline}
1384 Subject: $subject
1385 Date: $date
1386 Message-Id: $message_id
1388 if ($use_xmailer) {
1389 $header .= "X-Mailer: git-send-email $gitversion\n";
1391 if ($in_reply_to) {
1393 $header .= "In-Reply-To: $in_reply_to\n";
1394 $header .= "References: $references\n";
1396 if ($reply_to) {
1397 $header .= "Reply-To: $reply_to\n";
1399 if (@xh) {
1400 $header .= join("\n", @xh) . "\n";
1403 my @sendmail_parameters = ('-i', @recipients);
1404 my $raw_from = $sender;
1405 if (defined $envelope_sender && $envelope_sender ne "auto") {
1406 $raw_from = $envelope_sender;
1408 $raw_from = extract_valid_address($raw_from);
1409 unshift (@sendmail_parameters,
1410 '-f', $raw_from) if(defined $envelope_sender);
1412 if ($needs_confirm && !$dry_run) {
1413 print "\n$header\n";
1414 if ($needs_confirm eq "inform") {
1415 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1416 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1417 print __ <<EOF ;
1418 The Cc list above has been expanded by additional
1419 addresses found in the patch commit message. By default
1420 send-email prompts before sending whenever this occurs.
1421 This behavior is controlled by the sendemail.confirm
1422 configuration setting.
1424 For additional information, run 'git send-email --help'.
1425 To retain the current behavior, but squelch this message,
1426 run 'git config --global sendemail.confirm auto'.
1430 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1431 # translation. The program will only accept English input
1432 # at this point.
1433 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1434 valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1435 default => $ask_default);
1436 die __("Send this email reply required") unless defined $_;
1437 if (/^n/i) {
1438 return 0;
1439 } elsif (/^e/i) {
1440 return -1;
1441 } elsif (/^q/i) {
1442 cleanup_compose_files();
1443 exit(0);
1444 } elsif (/^a/i) {
1445 $confirm = 'never';
1449 unshift (@sendmail_parameters, @smtp_server_options);
1451 if ($dry_run) {
1452 # We don't want to send the email.
1453 } elsif (file_name_is_absolute($smtp_server)) {
1454 my $pid = open my $sm, '|-';
1455 defined $pid or die $!;
1456 if (!$pid) {
1457 exec($smtp_server, @sendmail_parameters) or die $!;
1459 print $sm "$header\n$message";
1460 close $sm or die $!;
1461 } else {
1463 if (!defined $smtp_server) {
1464 die __("The required SMTP server is not properly defined.")
1467 require Net::SMTP;
1468 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1469 $smtp_domain ||= maildomain();
1471 if ($smtp_encryption eq 'ssl') {
1472 $smtp_server_port ||= 465; # ssmtp
1473 require IO::Socket::SSL;
1475 # Suppress "variable accessed once" warning.
1477 no warnings 'once';
1478 $IO::Socket::SSL::DEBUG = 1;
1481 # Net::SMTP::SSL->new() does not forward any SSL options
1482 IO::Socket::SSL::set_client_defaults(
1483 ssl_verify_params());
1485 if ($use_net_smtp_ssl) {
1486 require Net::SMTP::SSL;
1487 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1488 Hello => $smtp_domain,
1489 Port => $smtp_server_port,
1490 Debug => $debug_net_smtp);
1492 else {
1493 $smtp ||= Net::SMTP->new($smtp_server,
1494 Hello => $smtp_domain,
1495 Port => $smtp_server_port,
1496 Debug => $debug_net_smtp,
1497 SSL => 1);
1500 elsif (!$smtp) {
1501 $smtp_server_port ||= 25;
1502 $smtp ||= Net::SMTP->new($smtp_server,
1503 Hello => $smtp_domain,
1504 Debug => $debug_net_smtp,
1505 Port => $smtp_server_port);
1506 if ($smtp_encryption eq 'tls' && $smtp) {
1507 if ($use_net_smtp_ssl) {
1508 $smtp->command('STARTTLS');
1509 $smtp->response();
1510 if ($smtp->code != 220) {
1511 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1513 require Net::SMTP::SSL;
1514 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1515 ssl_verify_params())
1516 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1518 else {
1519 $smtp->starttls(ssl_verify_params())
1520 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1522 # Send EHLO again to receive fresh
1523 # supported commands
1524 $smtp->hello($smtp_domain);
1528 if (!$smtp) {
1529 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1530 " VALUES: server=$smtp_server ",
1531 "encryption=$smtp_encryption ",
1532 "hello=$smtp_domain",
1533 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1536 smtp_auth_maybe or die $smtp->message;
1538 $smtp->mail( $raw_from ) or die $smtp->message;
1539 $smtp->to( @recipients ) or die $smtp->message;
1540 $smtp->data or die $smtp->message;
1541 $smtp->datasend("$header\n") or die $smtp->message;
1542 my @lines = split /^/, $message;
1543 foreach my $line (@lines) {
1544 $smtp->datasend("$line") or die $smtp->message;
1546 $smtp->dataend() or die $smtp->message;
1547 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1549 if ($quiet) {
1550 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1551 } else {
1552 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1553 if (!file_name_is_absolute($smtp_server)) {
1554 print "Server: $smtp_server\n";
1555 print "MAIL FROM:<$raw_from>\n";
1556 foreach my $entry (@recipients) {
1557 print "RCPT TO:<$entry>\n";
1559 } else {
1560 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1562 print $header, "\n";
1563 if ($smtp) {
1564 print __("Result: "), $smtp->code, ' ',
1565 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1566 } else {
1567 print __("Result: OK\n");
1571 return 1;
1574 $in_reply_to = $initial_in_reply_to;
1575 $references = $initial_in_reply_to || '';
1576 $subject = $initial_subject;
1577 $message_num = 0;
1579 # Prepares the email, prompts the user, sends it out
1580 # Returns 0 if an edit was done and the function should be called again, or 1
1581 # otherwise.
1582 sub process_file {
1583 my ($t) = @_;
1585 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1587 my $author = undef;
1588 my $sauthor = undef;
1589 my $author_encoding;
1590 my $has_content_type;
1591 my $body_encoding;
1592 my $xfer_encoding;
1593 my $has_mime_version;
1594 @to = ();
1595 @cc = ();
1596 @xh = ();
1597 my $input_format = undef;
1598 my @header = ();
1599 $message = "";
1600 $message_num++;
1601 # First unfold multiline header fields
1602 while(<$fh>) {
1603 last if /^\s*$/;
1604 if (/^\s+\S/ and @header) {
1605 chomp($header[$#header]);
1606 s/^\s+/ /;
1607 $header[$#header] .= $_;
1608 } else {
1609 push(@header, $_);
1612 # Now parse the header
1613 foreach(@header) {
1614 if (/^From /) {
1615 $input_format = 'mbox';
1616 next;
1618 chomp;
1619 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1620 $input_format = 'mbox';
1623 if (defined $input_format && $input_format eq 'mbox') {
1624 if (/^Subject:\s+(.*)$/i) {
1625 $subject = $1;
1627 elsif (/^From:\s+(.*)$/i) {
1628 ($author, $author_encoding) = unquote_rfc2047($1);
1629 $sauthor = sanitize_address($author);
1630 next if $suppress_cc{'author'};
1631 next if $suppress_cc{'self'} and $sauthor eq $sender;
1632 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1633 $1, $_) unless $quiet;
1634 push @cc, $1;
1636 elsif (/^To:\s+(.*)$/i) {
1637 foreach my $addr (parse_address_line($1)) {
1638 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1639 $addr, $_) unless $quiet;
1640 push @to, $addr;
1643 elsif (/^Cc:\s+(.*)$/i) {
1644 foreach my $addr (parse_address_line($1)) {
1645 my $qaddr = unquote_rfc2047($addr);
1646 my $saddr = sanitize_address($qaddr);
1647 if ($saddr eq $sender) {
1648 next if ($suppress_cc{'self'});
1649 } else {
1650 next if ($suppress_cc{'cc'});
1652 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1653 $addr, $_) unless $quiet;
1654 push @cc, $addr;
1657 elsif (/^Content-type:/i) {
1658 $has_content_type = 1;
1659 if (/charset="?([^ "]+)/) {
1660 $body_encoding = $1;
1662 push @xh, $_;
1664 elsif (/^MIME-Version/i) {
1665 $has_mime_version = 1;
1666 push @xh, $_;
1668 elsif (/^Message-Id: (.*)/i) {
1669 $message_id = $1;
1671 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1672 $xfer_encoding = $1 if not defined $xfer_encoding;
1674 elsif (/^In-Reply-To: (.*)/i) {
1675 $in_reply_to = $1;
1677 elsif (/^References: (.*)/i) {
1678 $references = $1;
1680 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1681 push @xh, $_;
1683 } else {
1684 # In the traditional
1685 # "send lots of email" format,
1686 # line 1 = cc
1687 # line 2 = subject
1688 # So let's support that, too.
1689 $input_format = 'lots';
1690 if (@cc == 0 && !$suppress_cc{'cc'}) {
1691 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1692 $_, $_) unless $quiet;
1693 push @cc, $_;
1694 } elsif (!defined $subject) {
1695 $subject = $_;
1699 # Now parse the message body
1700 while(<$fh>) {
1701 $message .= $_;
1702 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1703 chomp;
1704 my ($what, $c) = ($1, $2);
1705 # strip garbage for the address we'll use:
1706 $c = strip_garbage_one_address($c);
1707 # sanitize a bit more to decide whether to suppress the address:
1708 my $sc = sanitize_address($c);
1709 if ($sc eq $sender) {
1710 next if ($suppress_cc{'self'});
1711 } else {
1712 if ($what =~ /^Signed-off-by$/i) {
1713 next if $suppress_cc{'sob'};
1714 } elsif ($what =~ /-by$/i) {
1715 next if $suppress_cc{'misc-by'};
1716 } elsif ($what =~ /Cc/i) {
1717 next if $suppress_cc{'bodycc'};
1720 if ($c !~ /.+@.+|<.+>/) {
1721 printf("(body) Ignoring %s from line '%s'\n",
1722 $what, $_) unless $quiet;
1723 next;
1725 push @cc, $c;
1726 printf(__("(body) Adding cc: %s from line '%s'\n"),
1727 $c, $_) unless $quiet;
1730 close $fh;
1732 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1733 if defined $to_cmd;
1734 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1735 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1737 if ($broken_encoding{$t} && !$has_content_type) {
1738 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1739 $has_content_type = 1;
1740 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1741 $body_encoding = $auto_8bit_encoding;
1744 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1745 $subject = quote_subject($subject, $auto_8bit_encoding);
1748 if (defined $sauthor and $sauthor ne $sender) {
1749 $message = "From: $author\n\n$message";
1750 if (defined $author_encoding) {
1751 if ($has_content_type) {
1752 if ($body_encoding eq $author_encoding) {
1753 # ok, we already have the right encoding
1755 else {
1756 # uh oh, we should re-encode
1759 else {
1760 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1761 $has_content_type = 1;
1762 push @xh,
1763 "Content-Type: text/plain; charset=$author_encoding";
1767 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1768 ($message, $xfer_encoding) = apply_transfer_encoding(
1769 $message, $xfer_encoding, $target_xfer_encoding);
1770 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1771 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1773 $needs_confirm = (
1774 $confirm eq "always" or
1775 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1776 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1777 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1779 @to = process_address_list(@to);
1780 @cc = process_address_list(@cc);
1782 @to = (@initial_to, @to);
1783 @cc = (@initial_cc, @cc);
1785 if ($message_num == 1) {
1786 if (defined $cover_cc and $cover_cc) {
1787 @initial_cc = @cc;
1789 if (defined $cover_to and $cover_to) {
1790 @initial_to = @to;
1794 my $message_was_sent = send_message();
1795 if ($message_was_sent == -1) {
1796 do_edit($t);
1797 return 0;
1800 # set up for the next message
1801 if ($thread && $message_was_sent &&
1802 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1803 $message_num == 1)) {
1804 $in_reply_to = $message_id;
1805 if (length $references > 0) {
1806 $references .= "\n $message_id";
1807 } else {
1808 $references = "$message_id";
1811 $message_id = undef;
1812 $num_sent++;
1813 if (defined $batch_size && $num_sent == $batch_size) {
1814 $num_sent = 0;
1815 $smtp->quit if defined $smtp;
1816 undef $smtp;
1817 undef $auth;
1818 sleep($relogin_delay) if defined $relogin_delay;
1821 return 1;
1824 foreach my $t (@files) {
1825 while (!process_file($t)) {
1826 # user edited the file
1830 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1831 # and return a results array
1832 sub recipients_cmd {
1833 my ($prefix, $what, $cmd, $file) = @_;
1835 my @addresses = ();
1836 open my $fh, "-|", "$cmd \Q$file\E"
1837 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1838 while (my $address = <$fh>) {
1839 $address =~ s/^\s*//g;
1840 $address =~ s/\s*$//g;
1841 $address = sanitize_address($address);
1842 next if ($address eq $sender and $suppress_cc{'self'});
1843 push @addresses, $address;
1844 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1845 $prefix, $what, $address, $cmd) unless $quiet;
1847 close $fh
1848 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1849 return @addresses;
1852 cleanup_compose_files();
1854 sub cleanup_compose_files {
1855 unlink($compose_filename, $compose_filename . ".final") if $compose;
1858 $smtp->quit if $smtp;
1860 sub apply_transfer_encoding {
1861 my $message = shift;
1862 my $from = shift;
1863 my $to = shift;
1865 return ($message, $to) if ($from eq $to and $from ne '7bit');
1867 require MIME::QuotedPrint;
1868 require MIME::Base64;
1870 $message = MIME::QuotedPrint::decode($message)
1871 if ($from eq 'quoted-printable');
1872 $message = MIME::Base64::decode($message)
1873 if ($from eq 'base64');
1875 $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
1876 if $to eq 'auto';
1878 die __("cannot send message as 7bit")
1879 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1880 return ($message, $to)
1881 if ($to eq '7bit' or $to eq '8bit');
1882 return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
1883 if ($to eq 'quoted-printable');
1884 return (MIME::Base64::encode($message, "\n"), $to)
1885 if ($to eq 'base64');
1886 die __("invalid transfer encoding");
1889 sub unique_email_list {
1890 my %seen;
1891 my @emails;
1893 foreach my $entry (@_) {
1894 my $clean = extract_valid_address_or_die($entry);
1895 $seen{$clean} ||= 0;
1896 next if $seen{$clean}++;
1897 push @emails, $entry;
1899 return @emails;
1902 sub validate_patch {
1903 my ($fn, $xfer_encoding) = @_;
1905 if ($repo) {
1906 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1907 'sendemail-validate');
1908 my $hook_error;
1909 if (-x $validate_hook) {
1910 my $target = abs_path($fn);
1911 # The hook needs a correct cwd and GIT_DIR.
1912 my $cwd_save = cwd();
1913 chdir($repo->wc_path() or $repo->repo_path())
1914 or die("chdir: $!");
1915 local $ENV{"GIT_DIR"} = $repo->repo_path();
1916 $hook_error = "rejected by sendemail-validate hook"
1917 if system($validate_hook, $target);
1918 chdir($cwd_save) or die("chdir: $!");
1920 return $hook_error if $hook_error;
1923 # Any long lines will be automatically fixed if we use a suitable transfer
1924 # encoding.
1925 unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
1926 open(my $fh, '<', $fn)
1927 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1928 while (my $line = <$fh>) {
1929 if (length($line) > 998) {
1930 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1934 return;
1937 sub handle_backup {
1938 my ($last, $lastlen, $file, $known_suffix) = @_;
1939 my ($suffix, $skip);
1941 $skip = 0;
1942 if (defined $last &&
1943 ($lastlen < length($file)) &&
1944 (substr($file, 0, $lastlen) eq $last) &&
1945 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1946 if (defined $known_suffix && $suffix eq $known_suffix) {
1947 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1948 $skip = 1;
1949 } else {
1950 # TRANSLATORS: please keep "[y|N]" as is.
1951 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1952 valid_re => qr/^(?:y|n)/i,
1953 default => 'n');
1954 $skip = ($answer ne 'y');
1955 if ($skip) {
1956 $known_suffix = $suffix;
1960 return ($skip, $known_suffix);
1963 sub handle_backup_files {
1964 my @file = @_;
1965 my ($last, $lastlen, $known_suffix, $skip, @result);
1966 for my $file (@file) {
1967 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1968 $file, $known_suffix);
1969 push @result, $file unless $skip;
1970 $last = $file;
1971 $lastlen = length($file);
1973 return @result;
1976 sub file_has_nonascii {
1977 my $fn = shift;
1978 open(my $fh, '<', $fn)
1979 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1980 while (my $line = <$fh>) {
1981 return 1 if $line =~ /[^[:ascii:]]/;
1983 return 0;
1986 sub body_or_subject_has_nonascii {
1987 my $fn = shift;
1988 open(my $fh, '<', $fn)
1989 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1990 while (my $line = <$fh>) {
1991 last if $line =~ /^$/;
1992 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1994 while (my $line = <$fh>) {
1995 return 1 if $line =~ /[^[:ascii:]]/;
1997 return 0;