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