Merge tag 'v2.14.1'
[git/raj.git] / git-send-email.perl
blobfa6526986ed40143a12ffcd6563fd52b49d209e7
1 #!/usr/bin/perl
3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
6 # GPL v2 (See COPYING)
8 # Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
10 # Sends a collection of emails to the given email addresses, disturbingly fast.
12 # Supports two formats:
13 # 1. mbox format files (ignoring most headers and MIME formatting - this is designed for sending patches)
14 # 2. The original format support by Greg's script:
15 # first line of the message is who to CC,
16 # and second line is the subject of the message.
19 use 5.008;
20 use strict;
21 use warnings;
22 use POSIX qw/strftime/;
23 use Term::ReadLine;
24 use Getopt::Long;
25 use Text::ParseWords;
26 use Term::ANSIColor;
27 use File::Temp qw/ tempdir tempfile /;
28 use File::Spec::Functions qw(catdir catfile);
29 use Error qw(:try);
30 use Cwd qw(abs_path cwd);
31 use Git;
32 use Git::I18N;
34 Getopt::Long::Configure qw/ pass_through /;
36 package FakeTerm;
37 sub new {
38 my ($class, $reason) = @_;
39 return bless \$reason, shift;
41 sub readline {
42 my $self = shift;
43 die "Cannot use readline on FakeTerm: $$self";
45 package main;
48 sub usage {
49 print <<EOT;
50 git send-email [options] <file | directory | rev-list options >
51 git send-email --dump-aliases
53 Composing:
54 --from <str> * Email From:
55 --[no-]to <str> * Email To:
56 --[no-]cc <str> * Email Cc:
57 --[no-]bcc <str> * Email Bcc:
58 --subject <str> * Email "Subject:"
59 --in-reply-to <str> * Email "In-Reply-To:"
60 --[no-]xmailer * Add "X-Mailer:" header (default).
61 --[no-]annotate * Review each patch that will be sent in an editor.
62 --compose * Open an editor for introduction.
63 --compose-encoding <str> * Encoding to assume for introduction.
64 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
65 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
67 Sending:
68 --envelope-sender <str> * Email envelope sender.
69 --smtp-server <str:int> * Outgoing SMTP server to use. The port
70 is optional. Default 'localhost'.
71 --smtp-server-option <str> * Outgoing SMTP server option to use.
72 --smtp-server-port <int> * Outgoing SMTP server port.
73 --smtp-user <str> * Username for SMTP-AUTH.
74 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
75 --smtp-encryption <str> * tls or ssl; anything else disables.
76 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
77 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
78 Pass an empty string to disable certificate
79 verification.
80 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
81 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms.
82 This setting forces to use one of the listed mechanisms.
83 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
85 --batch-size <int> * send max <int> message per connection.
86 --relogin-delay <int> * delay <int> seconds between two successive login.
87 This option can only be used with --batch-size
89 Automating:
90 --identity <str> * Use the sendemail.<id> options.
91 --to-cmd <str> * Email To: via `<str> \$patch_path`
92 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
93 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, all.
94 --[no-]cc-cover * Email Cc: addresses in the cover letter.
95 --[no-]to-cover * Email To: addresses in the cover letter.
96 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
97 --[no-]suppress-from * Send to self. Default off.
98 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
99 --[no-]thread * Use In-Reply-To: field. Default on.
101 Administering:
102 --confirm <str> * Confirm recipients before sending;
103 auto, cc, compose, always, or never.
104 --quiet * Output one line of info per email.
105 --dry-run * Don't actually send the emails.
106 --[no-]validate * Perform patch sanity checks. Default on.
107 --[no-]format-patch * understand any non optional arguments as
108 `git format-patch` ones.
109 --force * Send even if safety checks would prevent it.
111 Information:
112 --dump-aliases * Dump configured aliases and exit.
115 exit(1);
118 # most mail servers generate the Date: header, but not all...
119 sub format_2822_time {
120 my ($time) = @_;
121 my @localtm = localtime($time);
122 my @gmttm = gmtime($time);
123 my $localmin = $localtm[1] + $localtm[2] * 60;
124 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
125 if ($localtm[0] != $gmttm[0]) {
126 die __("local zone differs from GMT by a non-minute interval\n");
128 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
129 $localmin += 1440;
130 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
131 $localmin -= 1440;
132 } elsif ($gmttm[6] != $localtm[6]) {
133 die __("local time offset greater than or equal to 24 hours\n");
135 my $offset = $localmin - $gmtmin;
136 my $offhour = $offset / 60;
137 my $offmin = abs($offset % 60);
138 if (abs($offhour) >= 24) {
139 die __("local time offset greater than or equal to 24 hours\n");
142 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
143 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
144 $localtm[3],
145 qw(Jan Feb Mar Apr May Jun
146 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
147 $localtm[5]+1900,
148 $localtm[2],
149 $localtm[1],
150 $localtm[0],
151 ($offset >= 0) ? '+' : '-',
152 abs($offhour),
153 $offmin,
157 my $have_email_valid = eval { require Email::Valid; 1 };
158 my $have_mail_address = eval { require Mail::Address; 1 };
159 my $smtp;
160 my $auth;
161 my $num_sent = 0;
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)\?=/;
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);
173 my $envelope_sender;
175 # Example reply to:
176 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
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';
185 if ($@) {
186 $term = new FakeTerm "$@: going non-interactive";
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;
196 # Handle interactive edition of files.
197 my $multiedit;
198 my $editor;
200 sub do_edit {
201 if (!defined($editor)) {
202 $editor = Git::command_oneline('var', 'GIT_EDITOR');
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"));
210 } @_;
211 } else {
212 system('sh', '-c', $editor.' "$@"', $editor, @_);
213 if (($? & 127) || ($? >> 8)) {
214 die(__("the editor exited uncleanly, aborting everything"));
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);
233 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
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]
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,
274 my %config_path_settings = (
275 "aliasesfile" => \@alias_files,
276 "smtpsslcertpath" => \$smtp_ssl_cert_path,
279 # Handle Uncouth Termination
280 sub signal_handler {
282 # Make text normal
283 print color("reset"), "\n";
285 # SMTP password masked
286 system "stty echo";
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;
295 if (-e ($compose_filename . ".final")) {
296 printf __("'%s.final' contains the composed email.\n"),
297 $compose_filename;
301 exit;
304 $SIG{TERM} = \&signal_handler;
305 $SIG{INT} = \&signal_handler;
307 # Begin by accumulating all the variables (defined above), that we will end up
308 # needing, first, from the command line:
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,
374 usage() if $help;
375 unless ($rc) {
376 usage();
379 die __("Cannot run git format-patch from outside a repository\n")
380 if $format_patch and not $repo;
382 # Now, let's fill any that aren't set in with defaults:
384 sub read_config {
385 my ($prefix) = @_;
387 foreach my $setting (keys %config_bool_settings) {
388 my $target = $config_bool_settings{$setting}->[0];
389 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
392 foreach my $setting (keys %config_path_settings) {
393 my $target = $config_path_settings{$setting};
394 if (ref($target) eq "ARRAY") {
395 unless (@$target) {
396 my @values = Git::config_path(@repo, "$prefix.$setting");
397 @$target = @values if (@values && defined $values[0]);
400 else {
401 $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
405 foreach my $setting (keys %config_settings) {
406 my $target = $config_settings{$setting};
407 next if $setting eq "to" and defined $no_to;
408 next if $setting eq "cc" and defined $no_cc;
409 next if $setting eq "bcc" and defined $no_bcc;
410 if (ref($target) eq "ARRAY") {
411 unless (@$target) {
412 my @values = Git::config(@repo, "$prefix.$setting");
413 @$target = @values if (@values && defined $values[0]);
416 else {
417 $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
421 if (!defined $smtp_encryption) {
422 my $enc = Git::config(@repo, "$prefix.smtpencryption");
423 if (defined $enc) {
424 $smtp_encryption = $enc;
425 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
426 $smtp_encryption = 'ssl';
431 # read configuration from [sendemail "$identity"], fall back on [sendemail]
432 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
433 read_config("sendemail.$identity") if (defined $identity);
434 read_config("sendemail");
436 # fall back on builtin bool defaults
437 foreach my $setting (values %config_bool_settings) {
438 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
441 # 'default' encryption is none -- this only prevents a warning
442 $smtp_encryption = '' unless (defined $smtp_encryption);
444 # Set CC suppressions
445 my(%suppress_cc);
446 if (@suppress_cc) {
447 foreach my $entry (@suppress_cc) {
448 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
449 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
450 $suppress_cc{$entry} = 1;
454 if ($suppress_cc{'all'}) {
455 foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
456 $suppress_cc{$entry} = 1;
458 delete $suppress_cc{'all'};
461 # If explicit old-style ones are specified, they trump --suppress-cc.
462 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
463 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
465 if ($suppress_cc{'body'}) {
466 foreach my $entry (qw (sob bodycc)) {
467 $suppress_cc{$entry} = 1;
469 delete $suppress_cc{'body'};
472 # Set confirm's default value
473 my $confirm_unconfigured = !defined $confirm;
474 if ($confirm_unconfigured) {
475 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
477 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
478 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
480 # Debugging, print out the suppressions.
481 if (0) {
482 print "suppressions:\n";
483 foreach my $entry (keys %suppress_cc) {
484 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
488 my ($repoauthor, $repocommitter);
489 ($repoauthor) = Git::ident_person(@repo, 'author');
490 ($repocommitter) = Git::ident_person(@repo, 'committer');
492 sub parse_address_line {
493 if ($have_mail_address) {
494 return map { $_->format } Mail::Address->parse($_[0]);
495 } else {
496 return Git::parse_mailboxes($_[0]);
500 sub split_addrs {
501 return quotewords('\s*,\s*', 1, @_);
504 my %aliases;
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"), $_;
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 = $_;
532 $s =~ s/\\$//; # silently tolerate stray '\' on last line
533 parse_sendmail_alias($s) if $s;
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);
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) ];
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) ];
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 ];
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;
584 if ($dump_aliases) {
585 print "$_\n" for (sort keys %aliases);
586 exit(0);
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;
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...
603 * Saying "./%s" if you mean a file; or
604 * Giving --format-patch option if you mean a range.
606 } catch Git::Error::Command with {
607 # Not a valid revision. Treat it as a filename.
608 return 0;
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, $!);
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;
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);
639 @files = handle_backup_files(@files);
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);
651 if (@files) {
652 unless ($quiet) {
653 print $_,"\n" for (@files);
655 } else {
656 print STDERR __("\nNo patch files specified!\n\n");
657 usage();
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";
668 close $fh;
669 die sprintf(__("No subject line in %s?"), $fn);
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, $!);
682 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
683 my $tpl_subject = $initial_subject || '';
684 my $tpl_reply_to = $initial_reply_to || '';
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.
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
699 EOT3
700 for my $f (@files) {
701 print $c get_patch_subject($f);
703 close $c;
705 if ($annotate) {
706 do_edit($compose_filename, @files);
707 } else {
708 do_edit($compose_filename);
711 open my $c2, ">", $compose_filename . ".final"
712 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
714 open $c, "<", $compose_filename
715 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
717 my $need_8bit_cte = file_has_nonascii($compose_filename);
718 my $in_body = 0;
719 my $summary_empty = 1;
720 if (!defined $compose_encoding) {
721 $compose_encoding = "UTF-8";
723 while(<$c>) {
724 next if m/^GIT:/;
725 if ($in_body) {
726 $summary_empty = 0 unless (/^\n$/);
727 } elsif (/^\n$/) {
728 $in_body = 1;
729 if ($need_8bit_cte) {
730 print $c2 "MIME-Version: 1.0\n",
731 "Content-Type: text/plain; ",
732 "charset=$compose_encoding\n",
733 "Content-Transfer-Encoding: 8bit\n";
735 } elsif (/^MIME-Version:/i) {
736 $need_8bit_cte = 0;
737 } elsif (/^Subject:\s*(.+)\s*$/i) {
738 $initial_subject = $1;
739 my $subject = $initial_subject;
740 $_ = "Subject: " .
741 quote_subject($subject, $compose_encoding) .
742 "\n";
743 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
744 $initial_reply_to = $1;
745 next;
746 } elsif (/^From:\s*(.+)\s*$/i) {
747 $sender = $1;
748 next;
749 } elsif (/^(?:To|Cc|Bcc):/i) {
750 print __("To/Cc/Bcc fields are not interpreted yet, they have been ignored\n");
751 next;
753 print $c2 $_;
755 close $c;
756 close $c2;
758 if ($summary_empty) {
759 print __("Summary email is empty, skipping it\n");
760 $compose = -1;
762 } elsif ($annotate) {
763 do_edit(@files);
766 sub ask {
767 my ($prompt, %arg) = @_;
768 my $valid_re = $arg{valid_re};
769 my $default = $arg{default};
770 my $confirm_only = $arg{confirm_only};
771 my $resp;
772 my $i = 0;
773 return defined $default ? $default : undef
774 unless defined $term->IN and defined fileno($term->IN) and
775 defined $term->OUT and defined fileno($term->OUT);
776 while ($i++ < 10) {
777 $resp = $term->readline($prompt);
778 if (!defined $resp) { # EOF
779 print "\n";
780 return defined $default ? $default : undef;
782 if ($resp eq '' and defined $default) {
783 return $default;
785 if (!defined $valid_re or $resp =~ /$valid_re/) {
786 return $resp;
788 if ($confirm_only) {
789 my $yesno = $term->readline(
790 # TRANSLATORS: please keep [y/N] as is.
791 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
792 if (defined $yesno && $yesno =~ /y/i) {
793 return $resp;
797 return;
800 my %broken_encoding;
802 sub file_declares_8bit_cte {
803 my $fn = shift;
804 open (my $fh, '<', $fn);
805 while (my $line = <$fh>) {
806 last if ($line =~ /^$/);
807 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
809 close $fh;
810 return 0;
813 foreach my $f (@files) {
814 next unless (body_or_subject_has_nonascii($f)
815 && !file_declares_8bit_cte($f));
816 $broken_encoding{$f} = 1;
819 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
820 print __("The following files are 8bit, but do not declare " .
821 "a Content-Transfer-Encoding.\n");
822 foreach my $f (sort keys %broken_encoding) {
823 print " $f\n";
825 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
826 valid_re => qr/.{4}/, confirm_only => 1,
827 default => "UTF-8");
830 if (!$force) {
831 for my $f (@files) {
832 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
833 die sprintf(__("Refusing to send because the patch\n\t%s\n"
834 . "has the template subject '*** SUBJECT HERE ***'. "
835 . "Pass --force if you really want to send.\n"), $f);
840 if (defined $sender) {
841 $sender =~ s/^\s+|\s+$//g;
842 ($sender) = expand_aliases($sender);
843 } else {
844 $sender = $repoauthor || $repocommitter || '';
847 # $sender could be an already sanitized address
848 # (e.g. sendemail.from could be manually sanitized by user).
849 # But it's a no-op to run sanitize_address on an already sanitized address.
850 $sender = sanitize_address($sender);
852 my $to_whom = __("To whom should the emails be sent (if anyone)?");
853 my $prompting = 0;
854 if (!@initial_to && !defined $to_cmd) {
855 my $to = ask("$to_whom ",
856 default => "",
857 valid_re => qr/\@.*\./, confirm_only => 1);
858 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
859 $prompting++;
862 sub expand_aliases {
863 return map { expand_one_alias($_) } @_;
866 my %EXPANDED_ALIASES;
867 sub expand_one_alias {
868 my $alias = shift;
869 if ($EXPANDED_ALIASES{$alias}) {
870 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
872 local $EXPANDED_ALIASES{$alias} = 1;
873 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
876 @initial_to = process_address_list(@initial_to);
877 @initial_cc = process_address_list(@initial_cc);
878 @bcclist = process_address_list(@bcclist);
880 if ($thread && !defined $initial_reply_to && $prompting) {
881 $initial_reply_to = ask(
882 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
883 default => "",
884 valid_re => qr/\@.*\./, confirm_only => 1);
886 if (defined $initial_reply_to) {
887 $initial_reply_to =~ s/^\s*<?//;
888 $initial_reply_to =~ s/>?\s*$//;
889 $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
892 if (!defined $smtp_server) {
893 foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
894 if (-x $_) {
895 $smtp_server = $_;
896 last;
899 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
902 if ($compose && $compose > 0) {
903 @files = ($compose_filename . ".final", @files);
906 # Variables we set as part of the loop over files
907 our ($message_id, %mail, $subject, $reply_to, $references, $message,
908 $needs_confirm, $message_num, $ask_default);
910 sub extract_valid_address {
911 my $address = shift;
912 my $local_part_regexp = qr/[^<>"\s@]+/;
913 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
915 # check for a local address:
916 return $address if ($address =~ /^($local_part_regexp)$/);
918 $address =~ s/^\s*<(.*)>\s*$/$1/;
919 if ($have_email_valid) {
920 return scalar Email::Valid->address($address);
923 # less robust/correct than the monster regexp in Email::Valid,
924 # but still does a 99% job, and one less dependency
925 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
926 return;
929 sub extract_valid_address_or_die {
930 my $address = shift;
931 $address = extract_valid_address($address);
932 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
933 if !$address;
934 return $address;
937 sub validate_address {
938 my $address = shift;
939 while (!extract_valid_address($address)) {
940 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
941 # TRANSLATORS: Make sure to include [q] [d] [e] in your
942 # translation. The program will only accept English input
943 # at this point.
944 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
945 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
946 default => 'q');
947 if (/^d/i) {
948 return undef;
949 } elsif (/^q/i) {
950 cleanup_compose_files();
951 exit(0);
953 $address = ask("$to_whom ",
954 default => "",
955 valid_re => qr/\@.*\./, confirm_only => 1);
957 return $address;
960 sub validate_address_list {
961 return (grep { defined $_ }
962 map { validate_address($_) } @_);
965 # Usually don't need to change anything below here.
967 # we make a "fake" message id by taking the current number
968 # of seconds since the beginning of Unix time and tacking on
969 # a random number to the end, in case we are called quicker than
970 # 1 second since the last time we were called.
972 # We'll setup a template for the message id, using the "from" address:
974 my ($message_id_stamp, $message_id_serial);
975 sub make_message_id {
976 my $uniq;
977 if (!defined $message_id_stamp) {
978 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
979 $message_id_serial = 0;
981 $message_id_serial++;
982 $uniq = "$message_id_stamp-$message_id_serial";
984 my $du_part;
985 for ($sender, $repocommitter, $repoauthor) {
986 $du_part = extract_valid_address(sanitize_address($_));
987 last if (defined $du_part and $du_part ne '');
989 if (not defined $du_part or $du_part eq '') {
990 require Sys::Hostname;
991 $du_part = 'user@' . Sys::Hostname::hostname();
993 my $message_id_template = "<%s-%s>";
994 $message_id = sprintf($message_id_template, $uniq, $du_part);
995 #print "new message id = $message_id\n"; # Was useful for debugging
1000 $time = time - scalar $#files;
1002 sub unquote_rfc2047 {
1003 local ($_) = @_;
1004 my $charset;
1005 my $sep = qr/[ \t]+/;
1006 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1007 my @words = split $sep, $&;
1008 foreach (@words) {
1009 m/$re_encoded_word/;
1010 $charset = $1;
1011 my $encoding = $2;
1012 my $text = $3;
1013 if ($encoding eq 'q' || $encoding eq 'Q') {
1014 $_ = $text;
1015 s/_/ /g;
1016 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1017 } else {
1018 # other encodings not supported yet
1021 join '', @words;
1022 }eg;
1023 return wantarray ? ($_, $charset) : $_;
1026 sub quote_rfc2047 {
1027 local $_ = shift;
1028 my $encoding = shift || 'UTF-8';
1029 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1030 s/(.*)/=\?$encoding\?q\?$1\?=/;
1031 return $_;
1034 sub is_rfc2047_quoted {
1035 my $s = shift;
1036 length($s) <= 75 &&
1037 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1040 sub subject_needs_rfc2047_quoting {
1041 my $s = shift;
1043 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1046 sub quote_subject {
1047 local $subject = shift;
1048 my $encoding = shift || 'UTF-8';
1050 if (subject_needs_rfc2047_quoting($subject)) {
1051 return quote_rfc2047($subject, $encoding);
1053 return $subject;
1056 # use the simplest quoting being able to handle the recipient
1057 sub sanitize_address {
1058 my ($recipient) = @_;
1060 # remove garbage after email address
1061 $recipient =~ s/(.*>).*$/$1/;
1063 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1065 if (not $recipient_name) {
1066 return $recipient;
1069 # if recipient_name is already quoted, do nothing
1070 if (is_rfc2047_quoted($recipient_name)) {
1071 return $recipient;
1074 # remove non-escaped quotes
1075 $recipient_name =~ s/(^|[^\\])"/$1/g;
1077 # rfc2047 is needed if a non-ascii char is included
1078 if ($recipient_name =~ /[^[:ascii:]]/) {
1079 $recipient_name = quote_rfc2047($recipient_name);
1082 # double quotes are needed if specials or CTLs are included
1083 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1084 $recipient_name =~ s/([\\\r])/\\$1/g;
1085 $recipient_name = qq["$recipient_name"];
1088 return "$recipient_name $recipient_addr";
1092 sub sanitize_address_list {
1093 return (map { sanitize_address($_) } @_);
1096 sub process_address_list {
1097 my @addr_list = map { parse_address_line($_) } @_;
1098 @addr_list = expand_aliases(@addr_list);
1099 @addr_list = sanitize_address_list(@addr_list);
1100 @addr_list = validate_address_list(@addr_list);
1101 return @addr_list;
1104 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1106 # Tightly configured MTAa require that a caller sends a real DNS
1107 # domain name that corresponds the IP address in the HELO/EHLO
1108 # handshake. This is used to verify the connection and prevent
1109 # spammers from trying to hide their identity. If the DNS and IP don't
1110 # match, the receiveing MTA may deny the connection.
1112 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1114 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1115 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1117 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1118 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1120 sub valid_fqdn {
1121 my $domain = shift;
1122 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1125 sub maildomain_net {
1126 my $maildomain;
1128 if (eval { require Net::Domain; 1 }) {
1129 my $domain = Net::Domain::domainname();
1130 $maildomain = $domain if valid_fqdn($domain);
1133 return $maildomain;
1136 sub maildomain_mta {
1137 my $maildomain;
1139 if (eval { require Net::SMTP; 1 }) {
1140 for my $host (qw(mailhost localhost)) {
1141 my $smtp = Net::SMTP->new($host);
1142 if (defined $smtp) {
1143 my $domain = $smtp->domain;
1144 $smtp->quit;
1146 $maildomain = $domain if valid_fqdn($domain);
1148 last if $maildomain;
1153 return $maildomain;
1156 sub maildomain {
1157 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1160 sub smtp_host_string {
1161 if (defined $smtp_server_port) {
1162 return "$smtp_server:$smtp_server_port";
1163 } else {
1164 return $smtp_server;
1168 # Returns 1 if authentication succeeded or was not necessary
1169 # (smtp_user was not specified), and 0 otherwise.
1171 sub smtp_auth_maybe {
1172 if (!defined $smtp_authuser || $auth) {
1173 return 1;
1176 # Workaround AUTH PLAIN/LOGIN interaction defect
1177 # with Authen::SASL::Cyrus
1178 eval {
1179 require Authen::SASL;
1180 Authen::SASL->import(qw(Perl));
1183 # Check mechanism naming as defined in:
1184 # https://tools.ietf.org/html/rfc4422#page-8
1185 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1186 die "invalid smtp auth: '${smtp_auth}'";
1189 # TODO: Authentication may fail not because credentials were
1190 # invalid but due to other reasons, in which we should not
1191 # reject credentials.
1192 $auth = Git::credential({
1193 'protocol' => 'smtp',
1194 'host' => smtp_host_string(),
1195 'username' => $smtp_authuser,
1196 # if there's no password, "git credential fill" will
1197 # give us one, otherwise it'll just pass this one.
1198 'password' => $smtp_authpass
1199 }, sub {
1200 my $cred = shift;
1202 if ($smtp_auth) {
1203 my $sasl = Authen::SASL->new(
1204 mechanism => $smtp_auth,
1205 callback => {
1206 user => $cred->{'username'},
1207 pass => $cred->{'password'},
1208 authname => $cred->{'username'},
1212 return !!$smtp->auth($sasl);
1215 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1218 return $auth;
1221 sub ssl_verify_params {
1222 eval {
1223 require IO::Socket::SSL;
1224 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1226 if ($@) {
1227 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1228 return;
1231 if (!defined $smtp_ssl_cert_path) {
1232 # use the OpenSSL defaults
1233 return (SSL_verify_mode => SSL_VERIFY_PEER());
1236 if ($smtp_ssl_cert_path eq "") {
1237 return (SSL_verify_mode => SSL_VERIFY_NONE());
1238 } elsif (-d $smtp_ssl_cert_path) {
1239 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1240 SSL_ca_path => $smtp_ssl_cert_path);
1241 } elsif (-f $smtp_ssl_cert_path) {
1242 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1243 SSL_ca_file => $smtp_ssl_cert_path);
1244 } else {
1245 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1249 sub file_name_is_absolute {
1250 my ($path) = @_;
1252 # msys does not grok DOS drive-prefixes
1253 if ($^O eq 'msys') {
1254 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1257 require File::Spec::Functions;
1258 return File::Spec::Functions::file_name_is_absolute($path);
1261 # Returns 1 if the message was sent, and 0 otherwise.
1262 # In actuality, the whole program dies when there
1263 # is an error sending a message.
1265 sub send_message {
1266 my @recipients = unique_email_list(@to);
1267 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1268 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1270 @cc);
1271 my $to = join (",\n\t", @recipients);
1272 @recipients = unique_email_list(@recipients,@cc,@bcclist);
1273 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1274 my $date = format_2822_time($time++);
1275 my $gitversion = '@@GIT_VERSION@@';
1276 if ($gitversion =~ m/..GIT_VERSION../) {
1277 $gitversion = Git::version();
1280 my $cc = join(",\n\t", unique_email_list(@cc));
1281 my $ccline = "";
1282 if ($cc ne '') {
1283 $ccline = "\nCc: $cc";
1285 make_message_id() unless defined($message_id);
1287 my $header = "From: $sender
1288 To: $to${ccline}
1289 Subject: $subject
1290 Date: $date
1291 Message-Id: $message_id
1293 if ($use_xmailer) {
1294 $header .= "X-Mailer: git-send-email $gitversion\n";
1296 if ($reply_to) {
1298 $header .= "In-Reply-To: $reply_to\n";
1299 $header .= "References: $references\n";
1301 if (@xh) {
1302 $header .= join("\n", @xh) . "\n";
1305 my @sendmail_parameters = ('-i', @recipients);
1306 my $raw_from = $sender;
1307 if (defined $envelope_sender && $envelope_sender ne "auto") {
1308 $raw_from = $envelope_sender;
1310 $raw_from = extract_valid_address($raw_from);
1311 unshift (@sendmail_parameters,
1312 '-f', $raw_from) if(defined $envelope_sender);
1314 if ($needs_confirm && !$dry_run) {
1315 print "\n$header\n";
1316 if ($needs_confirm eq "inform") {
1317 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1318 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1319 print __ <<EOF ;
1320 The Cc list above has been expanded by additional
1321 addresses found in the patch commit message. By default
1322 send-email prompts before sending whenever this occurs.
1323 This behavior is controlled by the sendemail.confirm
1324 configuration setting.
1326 For additional information, run 'git send-email --help'.
1327 To retain the current behavior, but squelch this message,
1328 run 'git config --global sendemail.confirm auto'.
1332 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1333 # translation. The program will only accept English input
1334 # at this point.
1335 $_ = ask(__("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1336 valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1337 default => $ask_default);
1338 die __("Send this email reply required") unless defined $_;
1339 if (/^n/i) {
1340 return 0;
1341 } elsif (/^q/i) {
1342 cleanup_compose_files();
1343 exit(0);
1344 } elsif (/^a/i) {
1345 $confirm = 'never';
1349 unshift (@sendmail_parameters, @smtp_server_options);
1351 if ($dry_run) {
1352 # We don't want to send the email.
1353 } elsif (file_name_is_absolute($smtp_server)) {
1354 my $pid = open my $sm, '|-';
1355 defined $pid or die $!;
1356 if (!$pid) {
1357 exec($smtp_server, @sendmail_parameters) or die $!;
1359 print $sm "$header\n$message";
1360 close $sm or die $!;
1361 } else {
1363 if (!defined $smtp_server) {
1364 die __("The required SMTP server is not properly defined.")
1367 require Net::SMTP;
1368 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1369 $smtp_domain ||= maildomain();
1371 if ($smtp_encryption eq 'ssl') {
1372 $smtp_server_port ||= 465; # ssmtp
1373 require IO::Socket::SSL;
1375 # Suppress "variable accessed once" warning.
1377 no warnings 'once';
1378 $IO::Socket::SSL::DEBUG = 1;
1381 # Net::SMTP::SSL->new() does not forward any SSL options
1382 IO::Socket::SSL::set_client_defaults(
1383 ssl_verify_params());
1385 if ($use_net_smtp_ssl) {
1386 require Net::SMTP::SSL;
1387 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1388 Hello => $smtp_domain,
1389 Port => $smtp_server_port,
1390 Debug => $debug_net_smtp);
1392 else {
1393 $smtp ||= Net::SMTP->new($smtp_server,
1394 Hello => $smtp_domain,
1395 Port => $smtp_server_port,
1396 Debug => $debug_net_smtp,
1397 SSL => 1);
1400 else {
1401 $smtp_server_port ||= 25;
1402 $smtp ||= Net::SMTP->new($smtp_server,
1403 Hello => $smtp_domain,
1404 Debug => $debug_net_smtp,
1405 Port => $smtp_server_port);
1406 if ($smtp_encryption eq 'tls' && $smtp) {
1407 if ($use_net_smtp_ssl) {
1408 $smtp->command('STARTTLS');
1409 $smtp->response();
1410 if ($smtp->code != 220) {
1411 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1413 require Net::SMTP::SSL;
1414 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1415 ssl_verify_params())
1416 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1418 else {
1419 $smtp->starttls(ssl_verify_params())
1420 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1422 $smtp_encryption = '';
1423 # Send EHLO again to receive fresh
1424 # supported commands
1425 $smtp->hello($smtp_domain);
1429 if (!$smtp) {
1430 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1431 " VALUES: server=$smtp_server ",
1432 "encryption=$smtp_encryption ",
1433 "hello=$smtp_domain",
1434 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1437 smtp_auth_maybe or die $smtp->message;
1439 $smtp->mail( $raw_from ) or die $smtp->message;
1440 $smtp->to( @recipients ) or die $smtp->message;
1441 $smtp->data or die $smtp->message;
1442 $smtp->datasend("$header\n") or die $smtp->message;
1443 my @lines = split /^/, $message;
1444 foreach my $line (@lines) {
1445 $smtp->datasend("$line") or die $smtp->message;
1447 $smtp->dataend() or die $smtp->message;
1448 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1450 if ($quiet) {
1451 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1452 } else {
1453 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1454 if (!file_name_is_absolute($smtp_server)) {
1455 print "Server: $smtp_server\n";
1456 print "MAIL FROM:<$raw_from>\n";
1457 foreach my $entry (@recipients) {
1458 print "RCPT TO:<$entry>\n";
1460 } else {
1461 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1463 print $header, "\n";
1464 if ($smtp) {
1465 print __("Result: "), $smtp->code, ' ',
1466 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1467 } else {
1468 print __("Result: OK\n");
1472 return 1;
1475 $reply_to = $initial_reply_to;
1476 $references = $initial_reply_to || '';
1477 $subject = $initial_subject;
1478 $message_num = 0;
1480 foreach my $t (@files) {
1481 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1483 my $author = undef;
1484 my $sauthor = undef;
1485 my $author_encoding;
1486 my $has_content_type;
1487 my $body_encoding;
1488 my $xfer_encoding;
1489 my $has_mime_version;
1490 @to = ();
1491 @cc = ();
1492 @xh = ();
1493 my $input_format = undef;
1494 my @header = ();
1495 $message = "";
1496 $message_num++;
1497 # First unfold multiline header fields
1498 while(<$fh>) {
1499 last if /^\s*$/;
1500 if (/^\s+\S/ and @header) {
1501 chomp($header[$#header]);
1502 s/^\s+/ /;
1503 $header[$#header] .= $_;
1504 } else {
1505 push(@header, $_);
1508 # Now parse the header
1509 foreach(@header) {
1510 if (/^From /) {
1511 $input_format = 'mbox';
1512 next;
1514 chomp;
1515 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1516 $input_format = 'mbox';
1519 if (defined $input_format && $input_format eq 'mbox') {
1520 if (/^Subject:\s+(.*)$/i) {
1521 $subject = $1;
1523 elsif (/^From:\s+(.*)$/i) {
1524 ($author, $author_encoding) = unquote_rfc2047($1);
1525 $sauthor = sanitize_address($author);
1526 next if $suppress_cc{'author'};
1527 next if $suppress_cc{'self'} and $sauthor eq $sender;
1528 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1529 $1, $_) unless $quiet;
1530 push @cc, $1;
1532 elsif (/^To:\s+(.*)$/i) {
1533 foreach my $addr (parse_address_line($1)) {
1534 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1535 $addr, $_) unless $quiet;
1536 push @to, $addr;
1539 elsif (/^Cc:\s+(.*)$/i) {
1540 foreach my $addr (parse_address_line($1)) {
1541 my $qaddr = unquote_rfc2047($addr);
1542 my $saddr = sanitize_address($qaddr);
1543 if ($saddr eq $sender) {
1544 next if ($suppress_cc{'self'});
1545 } else {
1546 next if ($suppress_cc{'cc'});
1548 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1549 $addr, $_) unless $quiet;
1550 push @cc, $addr;
1553 elsif (/^Content-type:/i) {
1554 $has_content_type = 1;
1555 if (/charset="?([^ "]+)/) {
1556 $body_encoding = $1;
1558 push @xh, $_;
1560 elsif (/^MIME-Version/i) {
1561 $has_mime_version = 1;
1562 push @xh, $_;
1564 elsif (/^Message-Id: (.*)/i) {
1565 $message_id = $1;
1567 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1568 $xfer_encoding = $1 if not defined $xfer_encoding;
1570 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1571 push @xh, $_;
1574 } else {
1575 # In the traditional
1576 # "send lots of email" format,
1577 # line 1 = cc
1578 # line 2 = subject
1579 # So let's support that, too.
1580 $input_format = 'lots';
1581 if (@cc == 0 && !$suppress_cc{'cc'}) {
1582 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1583 $_, $_) unless $quiet;
1584 push @cc, $_;
1585 } elsif (!defined $subject) {
1586 $subject = $_;
1590 # Now parse the message body
1591 while(<$fh>) {
1592 $message .= $_;
1593 if (/^(Signed-off-by|Cc): ([^>]*>?)/i) {
1594 chomp;
1595 my ($what, $c) = ($1, $2);
1596 chomp $c;
1597 my $sc = sanitize_address($c);
1598 if ($sc eq $sender) {
1599 next if ($suppress_cc{'self'});
1600 } else {
1601 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1602 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1604 push @cc, $c;
1605 printf(__("(body) Adding cc: %s from line '%s'\n"),
1606 $c, $_) unless $quiet;
1609 close $fh;
1611 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1612 if defined $to_cmd;
1613 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1614 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1616 if ($broken_encoding{$t} && !$has_content_type) {
1617 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1618 $has_content_type = 1;
1619 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1620 $body_encoding = $auto_8bit_encoding;
1623 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1624 $subject = quote_subject($subject, $auto_8bit_encoding);
1627 if (defined $sauthor and $sauthor ne $sender) {
1628 $message = "From: $author\n\n$message";
1629 if (defined $author_encoding) {
1630 if ($has_content_type) {
1631 if ($body_encoding eq $author_encoding) {
1632 # ok, we already have the right encoding
1634 else {
1635 # uh oh, we should re-encode
1638 else {
1639 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1640 $has_content_type = 1;
1641 push @xh,
1642 "Content-Type: text/plain; charset=$author_encoding";
1646 if (defined $target_xfer_encoding) {
1647 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1648 $message = apply_transfer_encoding(
1649 $message, $xfer_encoding, $target_xfer_encoding);
1650 $xfer_encoding = $target_xfer_encoding;
1652 if (defined $xfer_encoding) {
1653 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1655 if (defined $xfer_encoding or $has_content_type) {
1656 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1659 $needs_confirm = (
1660 $confirm eq "always" or
1661 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1662 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1663 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1665 @to = process_address_list(@to);
1666 @cc = process_address_list(@cc);
1668 @to = (@initial_to, @to);
1669 @cc = (@initial_cc, @cc);
1671 if ($message_num == 1) {
1672 if (defined $cover_cc and $cover_cc) {
1673 @initial_cc = @cc;
1675 if (defined $cover_to and $cover_to) {
1676 @initial_to = @to;
1680 my $message_was_sent = send_message();
1682 # set up for the next message
1683 if ($thread && $message_was_sent &&
1684 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1685 $message_num == 1)) {
1686 $reply_to = $message_id;
1687 if (length $references > 0) {
1688 $references .= "\n $message_id";
1689 } else {
1690 $references = "$message_id";
1693 $message_id = undef;
1694 $num_sent++;
1695 if (defined $batch_size && $num_sent == $batch_size) {
1696 $num_sent = 0;
1697 $smtp->quit if defined $smtp;
1698 undef $smtp;
1699 undef $auth;
1700 sleep($relogin_delay) if defined $relogin_delay;
1704 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1705 # and return a results array
1706 sub recipients_cmd {
1707 my ($prefix, $what, $cmd, $file) = @_;
1709 my @addresses = ();
1710 open my $fh, "-|", "$cmd \Q$file\E"
1711 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1712 while (my $address = <$fh>) {
1713 $address =~ s/^\s*//g;
1714 $address =~ s/\s*$//g;
1715 $address = sanitize_address($address);
1716 next if ($address eq $sender and $suppress_cc{'self'});
1717 push @addresses, $address;
1718 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1719 $prefix, $what, $address, $cmd) unless $quiet;
1721 close $fh
1722 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1723 return @addresses;
1726 cleanup_compose_files();
1728 sub cleanup_compose_files {
1729 unlink($compose_filename, $compose_filename . ".final") if $compose;
1732 $smtp->quit if $smtp;
1734 sub apply_transfer_encoding {
1735 my $message = shift;
1736 my $from = shift;
1737 my $to = shift;
1739 return $message if ($from eq $to and $from ne '7bit');
1741 require MIME::QuotedPrint;
1742 require MIME::Base64;
1744 $message = MIME::QuotedPrint::decode($message)
1745 if ($from eq 'quoted-printable');
1746 $message = MIME::Base64::decode($message)
1747 if ($from eq 'base64');
1749 die __("cannot send message as 7bit")
1750 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1751 return $message
1752 if ($to eq '7bit' or $to eq '8bit');
1753 return MIME::QuotedPrint::encode($message, "\n", 0)
1754 if ($to eq 'quoted-printable');
1755 return MIME::Base64::encode($message, "\n")
1756 if ($to eq 'base64');
1757 die __("invalid transfer encoding");
1760 sub unique_email_list {
1761 my %seen;
1762 my @emails;
1764 foreach my $entry (@_) {
1765 my $clean = extract_valid_address_or_die($entry);
1766 $seen{$clean} ||= 0;
1767 next if $seen{$clean}++;
1768 push @emails, $entry;
1770 return @emails;
1773 sub validate_patch {
1774 my $fn = shift;
1776 if ($repo) {
1777 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1778 'sendemail-validate');
1779 my $hook_error;
1780 if (-x $validate_hook) {
1781 my $target = abs_path($fn);
1782 # The hook needs a correct cwd and GIT_DIR.
1783 my $cwd_save = cwd();
1784 chdir($repo->wc_path() or $repo->repo_path())
1785 or die("chdir: $!");
1786 local $ENV{"GIT_DIR"} = $repo->repo_path();
1787 $hook_error = "rejected by sendemail-validate hook"
1788 if system($validate_hook, $target);
1789 chdir($cwd_save) or die("chdir: $!");
1791 return $hook_error if $hook_error;
1794 open(my $fh, '<', $fn)
1795 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1796 while (my $line = <$fh>) {
1797 if (length($line) > 998) {
1798 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1801 return;
1804 sub handle_backup {
1805 my ($last, $lastlen, $file, $known_suffix) = @_;
1806 my ($suffix, $skip);
1808 $skip = 0;
1809 if (defined $last &&
1810 ($lastlen < length($file)) &&
1811 (substr($file, 0, $lastlen) eq $last) &&
1812 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1813 if (defined $known_suffix && $suffix eq $known_suffix) {
1814 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1815 $skip = 1;
1816 } else {
1817 # TRANSLATORS: please keep "[y|N]" as is.
1818 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1819 valid_re => qr/^(?:y|n)/i,
1820 default => 'n');
1821 $skip = ($answer ne 'y');
1822 if ($skip) {
1823 $known_suffix = $suffix;
1827 return ($skip, $known_suffix);
1830 sub handle_backup_files {
1831 my @file = @_;
1832 my ($last, $lastlen, $known_suffix, $skip, @result);
1833 for my $file (@file) {
1834 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1835 $file, $known_suffix);
1836 push @result, $file unless $skip;
1837 $last = $file;
1838 $lastlen = length($file);
1840 return @result;
1843 sub file_has_nonascii {
1844 my $fn = shift;
1845 open(my $fh, '<', $fn)
1846 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1847 while (my $line = <$fh>) {
1848 return 1 if $line =~ /[^[:ascii:]]/;
1850 return 0;
1853 sub body_or_subject_has_nonascii {
1854 my $fn = shift;
1855 open(my $fh, '<', $fn)
1856 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1857 while (my $line = <$fh>) {
1858 last if $line =~ /^$/;
1859 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1861 while (my $line = <$fh>) {
1862 return 1 if $line =~ /[^[:ascii:]]/;
1864 return 0;