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