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