gitworkflows: fix grammar in 'Merge upwards' rule
[git/debian.git] / git-send-email.perl
blob2208dcc2139be7130749fd3bae462320f17d3b21
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 $smtp;
159 my $auth;
160 my $num_sent = 0;
162 # Regexes for RFC 2047 productions.
163 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
164 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
165 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
167 # Variables we fill in automatically, or via prompting:
168 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
169 $initial_reply_to,$initial_subject,@files,
170 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
172 my $envelope_sender;
174 # Example reply to:
175 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
177 my $repo = eval { Git->repository() };
178 my @repo = $repo ? ($repo) : ();
179 my $term = eval {
180 $ENV{"GIT_SEND_EMAIL_NOTTY"}
181 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
182 : new Term::ReadLine 'git-send-email';
184 if ($@) {
185 $term = new FakeTerm "$@: going non-interactive";
188 # Behavior modification variables
189 my ($quiet, $dry_run) = (0, 0);
190 my $format_patch;
191 my $compose_filename;
192 my $force = 0;
193 my $dump_aliases = 0;
195 # Handle interactive edition of files.
196 my $multiedit;
197 my $editor;
199 sub do_edit {
200 if (!defined($editor)) {
201 $editor = Git::command_oneline('var', 'GIT_EDITOR');
203 if (defined($multiedit) && !$multiedit) {
204 map {
205 system('sh', '-c', $editor.' "$@"', $editor, $_);
206 if (($? & 127) || ($? >> 8)) {
207 die(__("the editor exited uncleanly, aborting everything"));
209 } @_;
210 } else {
211 system('sh', '-c', $editor.' "$@"', $editor, @_);
212 if (($? & 127) || ($? >> 8)) {
213 die(__("the editor exited uncleanly, aborting everything"));
218 # Variables with corresponding config settings
219 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
220 my ($cover_cc, $cover_to);
221 my ($to_cmd, $cc_cmd);
222 my ($smtp_server, $smtp_server_port, @smtp_server_options);
223 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
224 my ($batch_size, $relogin_delay);
225 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
226 my ($validate, $confirm);
227 my (@suppress_cc);
228 my ($auto_8bit_encoding);
229 my ($compose_encoding);
230 my ($target_xfer_encoding);
232 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
234 my %config_bool_settings = (
235 "thread" => [\$thread, 1],
236 "chainreplyto" => [\$chain_reply_to, 0],
237 "suppressfrom" => [\$suppress_from, undef],
238 "signedoffbycc" => [\$signed_off_by_cc, undef],
239 "cccover" => [\$cover_cc, undef],
240 "tocover" => [\$cover_to, undef],
241 "signedoffcc" => [\$signed_off_by_cc, undef], # Deprecated
242 "validate" => [\$validate, 1],
243 "multiedit" => [\$multiedit, undef],
244 "annotate" => [\$annotate, undef],
245 "xmailer" => [\$use_xmailer, 1]
248 my %config_settings = (
249 "smtpserver" => \$smtp_server,
250 "smtpserverport" => \$smtp_server_port,
251 "smtpserveroption" => \@smtp_server_options,
252 "smtpuser" => \$smtp_authuser,
253 "smtppass" => \$smtp_authpass,
254 "smtpdomain" => \$smtp_domain,
255 "smtpauth" => \$smtp_auth,
256 "smtpbatchsize" => \$batch_size,
257 "smtprelogindelay" => \$relogin_delay,
258 "to" => \@initial_to,
259 "tocmd" => \$to_cmd,
260 "cc" => \@initial_cc,
261 "cccmd" => \$cc_cmd,
262 "aliasfiletype" => \$aliasfiletype,
263 "bcc" => \@bcclist,
264 "suppresscc" => \@suppress_cc,
265 "envelopesender" => \$envelope_sender,
266 "confirm" => \$confirm,
267 "from" => \$sender,
268 "assume8bitencoding" => \$auto_8bit_encoding,
269 "composeencoding" => \$compose_encoding,
270 "transferencoding" => \$target_xfer_encoding,
273 my %config_path_settings = (
274 "aliasesfile" => \@alias_files,
275 "smtpsslcertpath" => \$smtp_ssl_cert_path,
278 # Handle Uncouth Termination
279 sub signal_handler {
281 # Make text normal
282 print color("reset"), "\n";
284 # SMTP password masked
285 system "stty echo";
287 # tmp files from --compose
288 if (defined $compose_filename) {
289 if (-e $compose_filename) {
290 printf __("'%s' contains an intermediate version ".
291 "of the email you were composing.\n"),
292 $compose_filename;
294 if (-e ($compose_filename . ".final")) {
295 printf __("'%s.final' contains the composed email.\n"),
296 $compose_filename;
300 exit;
303 $SIG{TERM} = \&signal_handler;
304 $SIG{INT} = \&signal_handler;
306 # Begin by accumulating all the variables (defined above), that we will end up
307 # needing, first, from the command line:
309 my $help;
310 my $rc = GetOptions("h" => \$help,
311 "dump-aliases" => \$dump_aliases);
312 usage() unless $rc;
313 die __("--dump-aliases incompatible with other options\n")
314 if !$help and $dump_aliases and @ARGV;
315 $rc = GetOptions(
316 "sender|from=s" => \$sender,
317 "in-reply-to=s" => \$initial_reply_to,
318 "subject=s" => \$initial_subject,
319 "to=s" => \@initial_to,
320 "to-cmd=s" => \$to_cmd,
321 "no-to" => \$no_to,
322 "cc=s" => \@initial_cc,
323 "no-cc" => \$no_cc,
324 "bcc=s" => \@bcclist,
325 "no-bcc" => \$no_bcc,
326 "chain-reply-to!" => \$chain_reply_to,
327 "no-chain-reply-to" => sub {$chain_reply_to = 0},
328 "smtp-server=s" => \$smtp_server,
329 "smtp-server-option=s" => \@smtp_server_options,
330 "smtp-server-port=s" => \$smtp_server_port,
331 "smtp-user=s" => \$smtp_authuser,
332 "smtp-pass:s" => \$smtp_authpass,
333 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
334 "smtp-encryption=s" => \$smtp_encryption,
335 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
336 "smtp-debug:i" => \$debug_net_smtp,
337 "smtp-domain:s" => \$smtp_domain,
338 "smtp-auth=s" => \$smtp_auth,
339 "identity=s" => \$identity,
340 "annotate!" => \$annotate,
341 "no-annotate" => sub {$annotate = 0},
342 "compose" => \$compose,
343 "quiet" => \$quiet,
344 "cc-cmd=s" => \$cc_cmd,
345 "suppress-from!" => \$suppress_from,
346 "no-suppress-from" => sub {$suppress_from = 0},
347 "suppress-cc=s" => \@suppress_cc,
348 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
349 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
350 "cc-cover|cc-cover!" => \$cover_cc,
351 "no-cc-cover" => sub {$cover_cc = 0},
352 "to-cover|to-cover!" => \$cover_to,
353 "no-to-cover" => sub {$cover_to = 0},
354 "confirm=s" => \$confirm,
355 "dry-run" => \$dry_run,
356 "envelope-sender=s" => \$envelope_sender,
357 "thread!" => \$thread,
358 "no-thread" => sub {$thread = 0},
359 "validate!" => \$validate,
360 "no-validate" => sub {$validate = 0},
361 "transfer-encoding=s" => \$target_xfer_encoding,
362 "format-patch!" => \$format_patch,
363 "no-format-patch" => sub {$format_patch = 0},
364 "8bit-encoding=s" => \$auto_8bit_encoding,
365 "compose-encoding=s" => \$compose_encoding,
366 "force" => \$force,
367 "xmailer!" => \$use_xmailer,
368 "no-xmailer" => sub {$use_xmailer = 0},
369 "batch-size=i" => \$batch_size,
370 "relogin-delay=i" => \$relogin_delay,
373 usage() if $help;
374 unless ($rc) {
375 usage();
378 die __("Cannot run git format-patch from outside a repository\n")
379 if $format_patch and not $repo;
381 # Now, let's fill any that aren't set in with defaults:
383 sub read_config {
384 my ($prefix) = @_;
386 foreach my $setting (keys %config_bool_settings) {
387 my $target = $config_bool_settings{$setting}->[0];
388 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
391 foreach my $setting (keys %config_path_settings) {
392 my $target = $config_path_settings{$setting};
393 if (ref($target) eq "ARRAY") {
394 unless (@$target) {
395 my @values = Git::config_path(@repo, "$prefix.$setting");
396 @$target = @values if (@values && defined $values[0]);
399 else {
400 $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
404 foreach my $setting (keys %config_settings) {
405 my $target = $config_settings{$setting};
406 next if $setting eq "to" and defined $no_to;
407 next if $setting eq "cc" and defined $no_cc;
408 next if $setting eq "bcc" and defined $no_bcc;
409 if (ref($target) eq "ARRAY") {
410 unless (@$target) {
411 my @values = Git::config(@repo, "$prefix.$setting");
412 @$target = @values if (@values && defined $values[0]);
415 else {
416 $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
420 if (!defined $smtp_encryption) {
421 my $enc = Git::config(@repo, "$prefix.smtpencryption");
422 if (defined $enc) {
423 $smtp_encryption = $enc;
424 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
425 $smtp_encryption = 'ssl';
430 # read configuration from [sendemail "$identity"], fall back on [sendemail]
431 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
432 read_config("sendemail.$identity") if (defined $identity);
433 read_config("sendemail");
435 # fall back on builtin bool defaults
436 foreach my $setting (values %config_bool_settings) {
437 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
440 # 'default' encryption is none -- this only prevents a warning
441 $smtp_encryption = '' unless (defined $smtp_encryption);
443 # Set CC suppressions
444 my(%suppress_cc);
445 if (@suppress_cc) {
446 foreach my $entry (@suppress_cc) {
447 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
448 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
449 $suppress_cc{$entry} = 1;
453 if ($suppress_cc{'all'}) {
454 foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
455 $suppress_cc{$entry} = 1;
457 delete $suppress_cc{'all'};
460 # If explicit old-style ones are specified, they trump --suppress-cc.
461 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
462 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
464 if ($suppress_cc{'body'}) {
465 foreach my $entry (qw (sob bodycc)) {
466 $suppress_cc{$entry} = 1;
468 delete $suppress_cc{'body'};
471 # Set confirm's default value
472 my $confirm_unconfigured = !defined $confirm;
473 if ($confirm_unconfigured) {
474 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
476 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
477 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
479 # Debugging, print out the suppressions.
480 if (0) {
481 print "suppressions:\n";
482 foreach my $entry (keys %suppress_cc) {
483 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
487 my ($repoauthor, $repocommitter);
488 ($repoauthor) = Git::ident_person(@repo, 'author');
489 ($repocommitter) = Git::ident_person(@repo, 'committer');
491 sub parse_address_line {
492 return Git::parse_mailboxes($_[0]);
495 sub split_addrs {
496 return quotewords('\s*,\s*', 1, @_);
499 my %aliases;
501 sub parse_sendmail_alias {
502 local $_ = shift;
503 if (/"/) {
504 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
505 } elsif (/:include:/) {
506 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
507 } elsif (/[\/|]/) {
508 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
509 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
510 my ($alias, $addr) = ($1, $2);
511 $aliases{$alias} = [ split_addrs($addr) ];
512 } else {
513 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
517 sub parse_sendmail_aliases {
518 my $fh = shift;
519 my $s = '';
520 while (<$fh>) {
521 chomp;
522 next if /^\s*$/ || /^\s*#/;
523 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
524 parse_sendmail_alias($s) if $s;
525 $s = $_;
527 $s =~ s/\\$//; # silently tolerate stray '\' on last line
528 parse_sendmail_alias($s) if $s;
531 my %parse_alias = (
532 # multiline formats can be supported in the future
533 mutt => sub { my $fh = shift; while (<$fh>) {
534 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
535 my ($alias, $addr) = ($1, $2);
536 $addr =~ s/#.*$//; # mutt allows # comments
537 # commas delimit multiple addresses
538 my @addr = split_addrs($addr);
540 # quotes may be escaped in the file,
541 # unescape them so we do not double-escape them later.
542 s/\\"/"/g foreach @addr;
543 $aliases{$alias} = \@addr
544 }}},
545 mailrc => sub { my $fh = shift; while (<$fh>) {
546 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
547 # spaces delimit multiple addresses
548 $aliases{$1} = [ quotewords('\s+', 0, $2) ];
549 }}},
550 pine => sub { my $fh = shift; my $f='\t[^\t]*';
551 for (my $x = ''; defined($x); $x = $_) {
552 chomp $x;
553 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
554 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
555 $aliases{$1} = [ split_addrs($2) ];
557 elm => sub { my $fh = shift;
558 while (<$fh>) {
559 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
560 my ($alias, $addr) = ($1, $2);
561 $aliases{$alias} = [ split_addrs($addr) ];
563 } },
564 sendmail => \&parse_sendmail_aliases,
565 gnus => sub { my $fh = shift; while (<$fh>) {
566 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
567 $aliases{$1} = [ $2 ];
571 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
572 foreach my $file (@alias_files) {
573 open my $fh, '<', $file or die "opening $file: $!\n";
574 $parse_alias{$aliasfiletype}->($fh);
575 close $fh;
579 if ($dump_aliases) {
580 print "$_\n" for (sort keys %aliases);
581 exit(0);
584 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
585 # $f is a revision list specification to be passed to format-patch.
586 sub is_format_patch_arg {
587 return unless $repo;
588 my $f = shift;
589 try {
590 $repo->command('rev-parse', '--verify', '--quiet', $f);
591 if (defined($format_patch)) {
592 return $format_patch;
594 die sprintf(__ <<EOF, $f, $f);
595 File '%s' exists but it could also be the range of commits
596 to produce patches for. Please disambiguate by...
598 * Saying "./%s" if you mean a file; or
599 * Giving --format-patch option if you mean a range.
601 } catch Git::Error::Command with {
602 # Not a valid revision. Treat it as a filename.
603 return 0;
607 # Now that all the defaults are set, process the rest of the command line
608 # arguments and collect up the files that need to be processed.
609 my @rev_list_opts;
610 while (defined(my $f = shift @ARGV)) {
611 if ($f eq "--") {
612 push @rev_list_opts, "--", @ARGV;
613 @ARGV = ();
614 } elsif (-d $f and !is_format_patch_arg($f)) {
615 opendir my $dh, $f
616 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
618 push @files, grep { -f $_ } map { catfile($f, $_) }
619 sort readdir $dh;
620 closedir $dh;
621 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
622 push @files, $f;
623 } else {
624 push @rev_list_opts, $f;
628 if (@rev_list_opts) {
629 die __("Cannot run git format-patch from outside a repository\n")
630 unless $repo;
631 push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
634 @files = handle_backup_files(@files);
636 if ($validate) {
637 foreach my $f (@files) {
638 unless (-p $f) {
639 my $error = validate_patch($f);
640 $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
641 $f, $error);
646 if (@files) {
647 unless ($quiet) {
648 print $_,"\n" for (@files);
650 } else {
651 print STDERR __("\nNo patch files specified!\n\n");
652 usage();
655 sub get_patch_subject {
656 my $fn = shift;
657 open (my $fh, '<', $fn);
658 while (my $line = <$fh>) {
659 next unless ($line =~ /^Subject: (.*)$/);
660 close $fh;
661 return "GIT: $1\n";
663 close $fh;
664 die sprintf(__("No subject line in %s?"), $fn);
667 if ($compose) {
668 # Note that this does not need to be secure, but we will make a small
669 # effort to have it be unique
670 $compose_filename = ($repo ?
671 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
672 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
673 open my $c, ">", $compose_filename
674 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
677 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
678 my $tpl_subject = $initial_subject || '';
679 my $tpl_reply_to = $initial_reply_to || '';
681 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
682 From $tpl_sender # This line is ignored.
683 EOT1
684 Lines beginning in "GIT:" will be removed.
685 Consider including an overall diffstat or table of contents
686 for the patch you are writing.
688 Clear the body content if you don't wish to send a summary.
689 EOT2
690 From: $tpl_sender
691 Subject: $tpl_subject
692 In-Reply-To: $tpl_reply_to
694 EOT3
695 for my $f (@files) {
696 print $c get_patch_subject($f);
698 close $c;
700 if ($annotate) {
701 do_edit($compose_filename, @files);
702 } else {
703 do_edit($compose_filename);
706 open my $c2, ">", $compose_filename . ".final"
707 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
709 open $c, "<", $compose_filename
710 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
712 my $need_8bit_cte = file_has_nonascii($compose_filename);
713 my $in_body = 0;
714 my $summary_empty = 1;
715 if (!defined $compose_encoding) {
716 $compose_encoding = "UTF-8";
718 while(<$c>) {
719 next if m/^GIT:/;
720 if ($in_body) {
721 $summary_empty = 0 unless (/^\n$/);
722 } elsif (/^\n$/) {
723 $in_body = 1;
724 if ($need_8bit_cte) {
725 print $c2 "MIME-Version: 1.0\n",
726 "Content-Type: text/plain; ",
727 "charset=$compose_encoding\n",
728 "Content-Transfer-Encoding: 8bit\n";
730 } elsif (/^MIME-Version:/i) {
731 $need_8bit_cte = 0;
732 } elsif (/^Subject:\s*(.+)\s*$/i) {
733 $initial_subject = $1;
734 my $subject = $initial_subject;
735 $_ = "Subject: " .
736 quote_subject($subject, $compose_encoding) .
737 "\n";
738 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
739 $initial_reply_to = $1;
740 next;
741 } elsif (/^From:\s*(.+)\s*$/i) {
742 $sender = $1;
743 next;
744 } elsif (/^(?:To|Cc|Bcc):/i) {
745 print __("To/Cc/Bcc fields are not interpreted yet, they have been ignored\n");
746 next;
748 print $c2 $_;
750 close $c;
751 close $c2;
753 if ($summary_empty) {
754 print __("Summary email is empty, skipping it\n");
755 $compose = -1;
757 } elsif ($annotate) {
758 do_edit(@files);
761 sub ask {
762 my ($prompt, %arg) = @_;
763 my $valid_re = $arg{valid_re};
764 my $default = $arg{default};
765 my $confirm_only = $arg{confirm_only};
766 my $resp;
767 my $i = 0;
768 return defined $default ? $default : undef
769 unless defined $term->IN and defined fileno($term->IN) and
770 defined $term->OUT and defined fileno($term->OUT);
771 while ($i++ < 10) {
772 $resp = $term->readline($prompt);
773 if (!defined $resp) { # EOF
774 print "\n";
775 return defined $default ? $default : undef;
777 if ($resp eq '' and defined $default) {
778 return $default;
780 if (!defined $valid_re or $resp =~ /$valid_re/) {
781 return $resp;
783 if ($confirm_only) {
784 my $yesno = $term->readline(
785 # TRANSLATORS: please keep [y/N] as is.
786 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
787 if (defined $yesno && $yesno =~ /y/i) {
788 return $resp;
792 return;
795 my %broken_encoding;
797 sub file_declares_8bit_cte {
798 my $fn = shift;
799 open (my $fh, '<', $fn);
800 while (my $line = <$fh>) {
801 last if ($line =~ /^$/);
802 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
804 close $fh;
805 return 0;
808 foreach my $f (@files) {
809 next unless (body_or_subject_has_nonascii($f)
810 && !file_declares_8bit_cte($f));
811 $broken_encoding{$f} = 1;
814 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
815 print __("The following files are 8bit, but do not declare " .
816 "a Content-Transfer-Encoding.\n");
817 foreach my $f (sort keys %broken_encoding) {
818 print " $f\n";
820 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
821 valid_re => qr/.{4}/, confirm_only => 1,
822 default => "UTF-8");
825 if (!$force) {
826 for my $f (@files) {
827 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
828 die sprintf(__("Refusing to send because the patch\n\t%s\n"
829 . "has the template subject '*** SUBJECT HERE ***'. "
830 . "Pass --force if you really want to send.\n"), $f);
835 if (defined $sender) {
836 $sender =~ s/^\s+|\s+$//g;
837 ($sender) = expand_aliases($sender);
838 } else {
839 $sender = $repoauthor || $repocommitter || '';
842 # $sender could be an already sanitized address
843 # (e.g. sendemail.from could be manually sanitized by user).
844 # But it's a no-op to run sanitize_address on an already sanitized address.
845 $sender = sanitize_address($sender);
847 my $to_whom = __("To whom should the emails be sent (if anyone)?");
848 my $prompting = 0;
849 if (!@initial_to && !defined $to_cmd) {
850 my $to = ask("$to_whom ",
851 default => "",
852 valid_re => qr/\@.*\./, confirm_only => 1);
853 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
854 $prompting++;
857 sub expand_aliases {
858 return map { expand_one_alias($_) } @_;
861 my %EXPANDED_ALIASES;
862 sub expand_one_alias {
863 my $alias = shift;
864 if ($EXPANDED_ALIASES{$alias}) {
865 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
867 local $EXPANDED_ALIASES{$alias} = 1;
868 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
871 @initial_to = process_address_list(@initial_to);
872 @initial_cc = process_address_list(@initial_cc);
873 @bcclist = process_address_list(@bcclist);
875 if ($thread && !defined $initial_reply_to && $prompting) {
876 $initial_reply_to = ask(
877 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
878 default => "",
879 valid_re => qr/\@.*\./, confirm_only => 1);
881 if (defined $initial_reply_to) {
882 $initial_reply_to =~ s/^\s*<?//;
883 $initial_reply_to =~ s/>?\s*$//;
884 $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
887 if (!defined $smtp_server) {
888 foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
889 if (-x $_) {
890 $smtp_server = $_;
891 last;
894 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
897 if ($compose && $compose > 0) {
898 @files = ($compose_filename . ".final", @files);
901 # Variables we set as part of the loop over files
902 our ($message_id, %mail, $subject, $reply_to, $references, $message,
903 $needs_confirm, $message_num, $ask_default);
905 sub extract_valid_address {
906 my $address = shift;
907 my $local_part_regexp = qr/[^<>"\s@]+/;
908 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
910 # check for a local address:
911 return $address if ($address =~ /^($local_part_regexp)$/);
913 $address =~ s/^\s*<(.*)>\s*$/$1/;
914 if ($have_email_valid) {
915 return scalar Email::Valid->address($address);
918 # less robust/correct than the monster regexp in Email::Valid,
919 # but still does a 99% job, and one less dependency
920 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
921 return;
924 sub extract_valid_address_or_die {
925 my $address = shift;
926 $address = extract_valid_address($address);
927 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
928 if !$address;
929 return $address;
932 sub validate_address {
933 my $address = shift;
934 while (!extract_valid_address($address)) {
935 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
936 # TRANSLATORS: Make sure to include [q] [d] [e] in your
937 # translation. The program will only accept English input
938 # at this point.
939 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
940 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
941 default => 'q');
942 if (/^d/i) {
943 return undef;
944 } elsif (/^q/i) {
945 cleanup_compose_files();
946 exit(0);
948 $address = ask("$to_whom ",
949 default => "",
950 valid_re => qr/\@.*\./, confirm_only => 1);
952 return $address;
955 sub validate_address_list {
956 return (grep { defined $_ }
957 map { validate_address($_) } @_);
960 # Usually don't need to change anything below here.
962 # we make a "fake" message id by taking the current number
963 # of seconds since the beginning of Unix time and tacking on
964 # a random number to the end, in case we are called quicker than
965 # 1 second since the last time we were called.
967 # We'll setup a template for the message id, using the "from" address:
969 my ($message_id_stamp, $message_id_serial);
970 sub make_message_id {
971 my $uniq;
972 if (!defined $message_id_stamp) {
973 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
974 $message_id_serial = 0;
976 $message_id_serial++;
977 $uniq = "$message_id_stamp-$message_id_serial";
979 my $du_part;
980 for ($sender, $repocommitter, $repoauthor) {
981 $du_part = extract_valid_address(sanitize_address($_));
982 last if (defined $du_part and $du_part ne '');
984 if (not defined $du_part or $du_part eq '') {
985 require Sys::Hostname;
986 $du_part = 'user@' . Sys::Hostname::hostname();
988 my $message_id_template = "<%s-%s>";
989 $message_id = sprintf($message_id_template, $uniq, $du_part);
990 #print "new message id = $message_id\n"; # Was useful for debugging
995 $time = time - scalar $#files;
997 sub unquote_rfc2047 {
998 local ($_) = @_;
999 my $charset;
1000 my $sep = qr/[ \t]+/;
1001 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1002 my @words = split $sep, $&;
1003 foreach (@words) {
1004 m/$re_encoded_word/;
1005 $charset = $1;
1006 my $encoding = $2;
1007 my $text = $3;
1008 if ($encoding eq 'q' || $encoding eq 'Q') {
1009 $_ = $text;
1010 s/_/ /g;
1011 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1012 } else {
1013 # other encodings not supported yet
1016 join '', @words;
1017 }eg;
1018 return wantarray ? ($_, $charset) : $_;
1021 sub quote_rfc2047 {
1022 local $_ = shift;
1023 my $encoding = shift || 'UTF-8';
1024 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1025 s/(.*)/=\?$encoding\?q\?$1\?=/;
1026 return $_;
1029 sub is_rfc2047_quoted {
1030 my $s = shift;
1031 length($s) <= 75 &&
1032 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1035 sub subject_needs_rfc2047_quoting {
1036 my $s = shift;
1038 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1041 sub quote_subject {
1042 local $subject = shift;
1043 my $encoding = shift || 'UTF-8';
1045 if (subject_needs_rfc2047_quoting($subject)) {
1046 return quote_rfc2047($subject, $encoding);
1048 return $subject;
1051 # use the simplest quoting being able to handle the recipient
1052 sub sanitize_address {
1053 my ($recipient) = @_;
1055 # remove garbage after email address
1056 $recipient =~ s/(.*>).*$/$1/;
1058 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1060 if (not $recipient_name) {
1061 return $recipient;
1064 # if recipient_name is already quoted, do nothing
1065 if (is_rfc2047_quoted($recipient_name)) {
1066 return $recipient;
1069 # remove non-escaped quotes
1070 $recipient_name =~ s/(^|[^\\])"/$1/g;
1072 # rfc2047 is needed if a non-ascii char is included
1073 if ($recipient_name =~ /[^[:ascii:]]/) {
1074 $recipient_name = quote_rfc2047($recipient_name);
1077 # double quotes are needed if specials or CTLs are included
1078 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1079 $recipient_name =~ s/([\\\r])/\\$1/g;
1080 $recipient_name = qq["$recipient_name"];
1083 return "$recipient_name $recipient_addr";
1087 sub strip_garbage_one_address {
1088 my ($addr) = @_;
1089 chomp $addr;
1090 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1091 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1092 # Foo Bar <foobar@example.com> [possibly garbage here]
1093 return $1;
1095 if ($addr =~ /^(<[^>]*>).*/) {
1096 # <foo@example.com> [possibly garbage here]
1097 # if garbage contains other addresses, they are ignored.
1098 return $1;
1100 if ($addr =~ /^([^"#,\s]*)/) {
1101 # address without quoting: remove anything after the address
1102 return $1;
1104 return $addr;
1107 sub sanitize_address_list {
1108 return (map { sanitize_address($_) } @_);
1111 sub process_address_list {
1112 my @addr_list = map { parse_address_line($_) } @_;
1113 @addr_list = expand_aliases(@addr_list);
1114 @addr_list = sanitize_address_list(@addr_list);
1115 @addr_list = validate_address_list(@addr_list);
1116 return @addr_list;
1119 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1121 # Tightly configured MTAa require that a caller sends a real DNS
1122 # domain name that corresponds the IP address in the HELO/EHLO
1123 # handshake. This is used to verify the connection and prevent
1124 # spammers from trying to hide their identity. If the DNS and IP don't
1125 # match, the receiveing MTA may deny the connection.
1127 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1129 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1130 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1132 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1133 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1135 sub valid_fqdn {
1136 my $domain = shift;
1137 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1140 sub maildomain_net {
1141 my $maildomain;
1143 if (eval { require Net::Domain; 1 }) {
1144 my $domain = Net::Domain::domainname();
1145 $maildomain = $domain if valid_fqdn($domain);
1148 return $maildomain;
1151 sub maildomain_mta {
1152 my $maildomain;
1154 if (eval { require Net::SMTP; 1 }) {
1155 for my $host (qw(mailhost localhost)) {
1156 my $smtp = Net::SMTP->new($host);
1157 if (defined $smtp) {
1158 my $domain = $smtp->domain;
1159 $smtp->quit;
1161 $maildomain = $domain if valid_fqdn($domain);
1163 last if $maildomain;
1168 return $maildomain;
1171 sub maildomain {
1172 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1175 sub smtp_host_string {
1176 if (defined $smtp_server_port) {
1177 return "$smtp_server:$smtp_server_port";
1178 } else {
1179 return $smtp_server;
1183 # Returns 1 if authentication succeeded or was not necessary
1184 # (smtp_user was not specified), and 0 otherwise.
1186 sub smtp_auth_maybe {
1187 if (!defined $smtp_authuser || $auth) {
1188 return 1;
1191 # Workaround AUTH PLAIN/LOGIN interaction defect
1192 # with Authen::SASL::Cyrus
1193 eval {
1194 require Authen::SASL;
1195 Authen::SASL->import(qw(Perl));
1198 # Check mechanism naming as defined in:
1199 # https://tools.ietf.org/html/rfc4422#page-8
1200 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1201 die "invalid smtp auth: '${smtp_auth}'";
1204 # TODO: Authentication may fail not because credentials were
1205 # invalid but due to other reasons, in which we should not
1206 # reject credentials.
1207 $auth = Git::credential({
1208 'protocol' => 'smtp',
1209 'host' => smtp_host_string(),
1210 'username' => $smtp_authuser,
1211 # if there's no password, "git credential fill" will
1212 # give us one, otherwise it'll just pass this one.
1213 'password' => $smtp_authpass
1214 }, sub {
1215 my $cred = shift;
1217 if ($smtp_auth) {
1218 my $sasl = Authen::SASL->new(
1219 mechanism => $smtp_auth,
1220 callback => {
1221 user => $cred->{'username'},
1222 pass => $cred->{'password'},
1223 authname => $cred->{'username'},
1227 return !!$smtp->auth($sasl);
1230 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1233 return $auth;
1236 sub ssl_verify_params {
1237 eval {
1238 require IO::Socket::SSL;
1239 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1241 if ($@) {
1242 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1243 return;
1246 if (!defined $smtp_ssl_cert_path) {
1247 # use the OpenSSL defaults
1248 return (SSL_verify_mode => SSL_VERIFY_PEER());
1251 if ($smtp_ssl_cert_path eq "") {
1252 return (SSL_verify_mode => SSL_VERIFY_NONE());
1253 } elsif (-d $smtp_ssl_cert_path) {
1254 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1255 SSL_ca_path => $smtp_ssl_cert_path);
1256 } elsif (-f $smtp_ssl_cert_path) {
1257 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1258 SSL_ca_file => $smtp_ssl_cert_path);
1259 } else {
1260 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1264 sub file_name_is_absolute {
1265 my ($path) = @_;
1267 # msys does not grok DOS drive-prefixes
1268 if ($^O eq 'msys') {
1269 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1272 require File::Spec::Functions;
1273 return File::Spec::Functions::file_name_is_absolute($path);
1276 # Returns 1 if the message was sent, and 0 otherwise.
1277 # In actuality, the whole program dies when there
1278 # is an error sending a message.
1280 sub send_message {
1281 my @recipients = unique_email_list(@to);
1282 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1283 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1285 @cc);
1286 my $to = join (",\n\t", @recipients);
1287 @recipients = unique_email_list(@recipients,@cc,@bcclist);
1288 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1289 my $date = format_2822_time($time++);
1290 my $gitversion = '@@GIT_VERSION@@';
1291 if ($gitversion =~ m/..GIT_VERSION../) {
1292 $gitversion = Git::version();
1295 my $cc = join(",\n\t", unique_email_list(@cc));
1296 my $ccline = "";
1297 if ($cc ne '') {
1298 $ccline = "\nCc: $cc";
1300 make_message_id() unless defined($message_id);
1302 my $header = "From: $sender
1303 To: $to${ccline}
1304 Subject: $subject
1305 Date: $date
1306 Message-Id: $message_id
1308 if ($use_xmailer) {
1309 $header .= "X-Mailer: git-send-email $gitversion\n";
1311 if ($reply_to) {
1313 $header .= "In-Reply-To: $reply_to\n";
1314 $header .= "References: $references\n";
1316 if (@xh) {
1317 $header .= join("\n", @xh) . "\n";
1320 my @sendmail_parameters = ('-i', @recipients);
1321 my $raw_from = $sender;
1322 if (defined $envelope_sender && $envelope_sender ne "auto") {
1323 $raw_from = $envelope_sender;
1325 $raw_from = extract_valid_address($raw_from);
1326 unshift (@sendmail_parameters,
1327 '-f', $raw_from) if(defined $envelope_sender);
1329 if ($needs_confirm && !$dry_run) {
1330 print "\n$header\n";
1331 if ($needs_confirm eq "inform") {
1332 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1333 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1334 print __ <<EOF ;
1335 The Cc list above has been expanded by additional
1336 addresses found in the patch commit message. By default
1337 send-email prompts before sending whenever this occurs.
1338 This behavior is controlled by the sendemail.confirm
1339 configuration setting.
1341 For additional information, run 'git send-email --help'.
1342 To retain the current behavior, but squelch this message,
1343 run 'git config --global sendemail.confirm auto'.
1347 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1348 # translation. The program will only accept English input
1349 # at this point.
1350 $_ = ask(__("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1351 valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1352 default => $ask_default);
1353 die __("Send this email reply required") unless defined $_;
1354 if (/^n/i) {
1355 return 0;
1356 } elsif (/^q/i) {
1357 cleanup_compose_files();
1358 exit(0);
1359 } elsif (/^a/i) {
1360 $confirm = 'never';
1364 unshift (@sendmail_parameters, @smtp_server_options);
1366 if ($dry_run) {
1367 # We don't want to send the email.
1368 } elsif (file_name_is_absolute($smtp_server)) {
1369 my $pid = open my $sm, '|-';
1370 defined $pid or die $!;
1371 if (!$pid) {
1372 exec($smtp_server, @sendmail_parameters) or die $!;
1374 print $sm "$header\n$message";
1375 close $sm or die $!;
1376 } else {
1378 if (!defined $smtp_server) {
1379 die __("The required SMTP server is not properly defined.")
1382 require Net::SMTP;
1383 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1384 $smtp_domain ||= maildomain();
1386 if ($smtp_encryption eq 'ssl') {
1387 $smtp_server_port ||= 465; # ssmtp
1388 require IO::Socket::SSL;
1390 # Suppress "variable accessed once" warning.
1392 no warnings 'once';
1393 $IO::Socket::SSL::DEBUG = 1;
1396 # Net::SMTP::SSL->new() does not forward any SSL options
1397 IO::Socket::SSL::set_client_defaults(
1398 ssl_verify_params());
1400 if ($use_net_smtp_ssl) {
1401 require Net::SMTP::SSL;
1402 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1403 Hello => $smtp_domain,
1404 Port => $smtp_server_port,
1405 Debug => $debug_net_smtp);
1407 else {
1408 $smtp ||= Net::SMTP->new($smtp_server,
1409 Hello => $smtp_domain,
1410 Port => $smtp_server_port,
1411 Debug => $debug_net_smtp,
1412 SSL => 1);
1415 else {
1416 $smtp_server_port ||= 25;
1417 $smtp ||= Net::SMTP->new($smtp_server,
1418 Hello => $smtp_domain,
1419 Debug => $debug_net_smtp,
1420 Port => $smtp_server_port);
1421 if ($smtp_encryption eq 'tls' && $smtp) {
1422 if ($use_net_smtp_ssl) {
1423 $smtp->command('STARTTLS');
1424 $smtp->response();
1425 if ($smtp->code != 220) {
1426 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1428 require Net::SMTP::SSL;
1429 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1430 ssl_verify_params())
1431 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1433 else {
1434 $smtp->starttls(ssl_verify_params())
1435 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1437 $smtp_encryption = '';
1438 # Send EHLO again to receive fresh
1439 # supported commands
1440 $smtp->hello($smtp_domain);
1444 if (!$smtp) {
1445 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1446 " VALUES: server=$smtp_server ",
1447 "encryption=$smtp_encryption ",
1448 "hello=$smtp_domain",
1449 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1452 smtp_auth_maybe or die $smtp->message;
1454 $smtp->mail( $raw_from ) or die $smtp->message;
1455 $smtp->to( @recipients ) or die $smtp->message;
1456 $smtp->data or die $smtp->message;
1457 $smtp->datasend("$header\n") or die $smtp->message;
1458 my @lines = split /^/, $message;
1459 foreach my $line (@lines) {
1460 $smtp->datasend("$line") or die $smtp->message;
1462 $smtp->dataend() or die $smtp->message;
1463 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1465 if ($quiet) {
1466 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1467 } else {
1468 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1469 if (!file_name_is_absolute($smtp_server)) {
1470 print "Server: $smtp_server\n";
1471 print "MAIL FROM:<$raw_from>\n";
1472 foreach my $entry (@recipients) {
1473 print "RCPT TO:<$entry>\n";
1475 } else {
1476 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1478 print $header, "\n";
1479 if ($smtp) {
1480 print __("Result: "), $smtp->code, ' ',
1481 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1482 } else {
1483 print __("Result: OK\n");
1487 return 1;
1490 $reply_to = $initial_reply_to;
1491 $references = $initial_reply_to || '';
1492 $subject = $initial_subject;
1493 $message_num = 0;
1495 foreach my $t (@files) {
1496 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1498 my $author = undef;
1499 my $sauthor = undef;
1500 my $author_encoding;
1501 my $has_content_type;
1502 my $body_encoding;
1503 my $xfer_encoding;
1504 my $has_mime_version;
1505 @to = ();
1506 @cc = ();
1507 @xh = ();
1508 my $input_format = undef;
1509 my @header = ();
1510 $message = "";
1511 $message_num++;
1512 # First unfold multiline header fields
1513 while(<$fh>) {
1514 last if /^\s*$/;
1515 if (/^\s+\S/ and @header) {
1516 chomp($header[$#header]);
1517 s/^\s+/ /;
1518 $header[$#header] .= $_;
1519 } else {
1520 push(@header, $_);
1523 # Now parse the header
1524 foreach(@header) {
1525 if (/^From /) {
1526 $input_format = 'mbox';
1527 next;
1529 chomp;
1530 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1531 $input_format = 'mbox';
1534 if (defined $input_format && $input_format eq 'mbox') {
1535 if (/^Subject:\s+(.*)$/i) {
1536 $subject = $1;
1538 elsif (/^From:\s+(.*)$/i) {
1539 ($author, $author_encoding) = unquote_rfc2047($1);
1540 $sauthor = sanitize_address($author);
1541 next if $suppress_cc{'author'};
1542 next if $suppress_cc{'self'} and $sauthor eq $sender;
1543 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1544 $1, $_) unless $quiet;
1545 push @cc, $1;
1547 elsif (/^To:\s+(.*)$/i) {
1548 foreach my $addr (parse_address_line($1)) {
1549 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1550 $addr, $_) unless $quiet;
1551 push @to, $addr;
1554 elsif (/^Cc:\s+(.*)$/i) {
1555 foreach my $addr (parse_address_line($1)) {
1556 my $qaddr = unquote_rfc2047($addr);
1557 my $saddr = sanitize_address($qaddr);
1558 if ($saddr eq $sender) {
1559 next if ($suppress_cc{'self'});
1560 } else {
1561 next if ($suppress_cc{'cc'});
1563 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1564 $addr, $_) unless $quiet;
1565 push @cc, $addr;
1568 elsif (/^Content-type:/i) {
1569 $has_content_type = 1;
1570 if (/charset="?([^ "]+)/) {
1571 $body_encoding = $1;
1573 push @xh, $_;
1575 elsif (/^MIME-Version/i) {
1576 $has_mime_version = 1;
1577 push @xh, $_;
1579 elsif (/^Message-Id: (.*)/i) {
1580 $message_id = $1;
1582 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1583 $xfer_encoding = $1 if not defined $xfer_encoding;
1585 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1586 push @xh, $_;
1589 } else {
1590 # In the traditional
1591 # "send lots of email" format,
1592 # line 1 = cc
1593 # line 2 = subject
1594 # So let's support that, too.
1595 $input_format = 'lots';
1596 if (@cc == 0 && !$suppress_cc{'cc'}) {
1597 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1598 $_, $_) unless $quiet;
1599 push @cc, $_;
1600 } elsif (!defined $subject) {
1601 $subject = $_;
1605 # Now parse the message body
1606 while(<$fh>) {
1607 $message .= $_;
1608 if (/^(Signed-off-by|Cc): (.*)/i) {
1609 chomp;
1610 my ($what, $c) = ($1, $2);
1611 # strip garbage for the address we'll use:
1612 $c = strip_garbage_one_address($c);
1613 # sanitize a bit more to decide whether to suppress the address:
1614 my $sc = sanitize_address($c);
1615 if ($sc eq $sender) {
1616 next if ($suppress_cc{'self'});
1617 } else {
1618 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1619 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1621 push @cc, $c;
1622 printf(__("(body) Adding cc: %s from line '%s'\n"),
1623 $c, $_) unless $quiet;
1626 close $fh;
1628 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1629 if defined $to_cmd;
1630 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1631 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1633 if ($broken_encoding{$t} && !$has_content_type) {
1634 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1635 $has_content_type = 1;
1636 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1637 $body_encoding = $auto_8bit_encoding;
1640 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1641 $subject = quote_subject($subject, $auto_8bit_encoding);
1644 if (defined $sauthor and $sauthor ne $sender) {
1645 $message = "From: $author\n\n$message";
1646 if (defined $author_encoding) {
1647 if ($has_content_type) {
1648 if ($body_encoding eq $author_encoding) {
1649 # ok, we already have the right encoding
1651 else {
1652 # uh oh, we should re-encode
1655 else {
1656 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1657 $has_content_type = 1;
1658 push @xh,
1659 "Content-Type: text/plain; charset=$author_encoding";
1663 if (defined $target_xfer_encoding) {
1664 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1665 $message = apply_transfer_encoding(
1666 $message, $xfer_encoding, $target_xfer_encoding);
1667 $xfer_encoding = $target_xfer_encoding;
1669 if (defined $xfer_encoding) {
1670 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1672 if (defined $xfer_encoding or $has_content_type) {
1673 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1676 $needs_confirm = (
1677 $confirm eq "always" or
1678 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1679 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1680 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1682 @to = process_address_list(@to);
1683 @cc = process_address_list(@cc);
1685 @to = (@initial_to, @to);
1686 @cc = (@initial_cc, @cc);
1688 if ($message_num == 1) {
1689 if (defined $cover_cc and $cover_cc) {
1690 @initial_cc = @cc;
1692 if (defined $cover_to and $cover_to) {
1693 @initial_to = @to;
1697 my $message_was_sent = send_message();
1699 # set up for the next message
1700 if ($thread && $message_was_sent &&
1701 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1702 $message_num == 1)) {
1703 $reply_to = $message_id;
1704 if (length $references > 0) {
1705 $references .= "\n $message_id";
1706 } else {
1707 $references = "$message_id";
1710 $message_id = undef;
1711 $num_sent++;
1712 if (defined $batch_size && $num_sent == $batch_size) {
1713 $num_sent = 0;
1714 $smtp->quit if defined $smtp;
1715 undef $smtp;
1716 undef $auth;
1717 sleep($relogin_delay) if defined $relogin_delay;
1721 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1722 # and return a results array
1723 sub recipients_cmd {
1724 my ($prefix, $what, $cmd, $file) = @_;
1726 my @addresses = ();
1727 open my $fh, "-|", "$cmd \Q$file\E"
1728 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1729 while (my $address = <$fh>) {
1730 $address =~ s/^\s*//g;
1731 $address =~ s/\s*$//g;
1732 $address = sanitize_address($address);
1733 next if ($address eq $sender and $suppress_cc{'self'});
1734 push @addresses, $address;
1735 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1736 $prefix, $what, $address, $cmd) unless $quiet;
1738 close $fh
1739 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1740 return @addresses;
1743 cleanup_compose_files();
1745 sub cleanup_compose_files {
1746 unlink($compose_filename, $compose_filename . ".final") if $compose;
1749 $smtp->quit if $smtp;
1751 sub apply_transfer_encoding {
1752 my $message = shift;
1753 my $from = shift;
1754 my $to = shift;
1756 return $message if ($from eq $to and $from ne '7bit');
1758 require MIME::QuotedPrint;
1759 require MIME::Base64;
1761 $message = MIME::QuotedPrint::decode($message)
1762 if ($from eq 'quoted-printable');
1763 $message = MIME::Base64::decode($message)
1764 if ($from eq 'base64');
1766 die __("cannot send message as 7bit")
1767 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1768 return $message
1769 if ($to eq '7bit' or $to eq '8bit');
1770 return MIME::QuotedPrint::encode($message, "\n", 0)
1771 if ($to eq 'quoted-printable');
1772 return MIME::Base64::encode($message, "\n")
1773 if ($to eq 'base64');
1774 die __("invalid transfer encoding");
1777 sub unique_email_list {
1778 my %seen;
1779 my @emails;
1781 foreach my $entry (@_) {
1782 my $clean = extract_valid_address_or_die($entry);
1783 $seen{$clean} ||= 0;
1784 next if $seen{$clean}++;
1785 push @emails, $entry;
1787 return @emails;
1790 sub validate_patch {
1791 my $fn = shift;
1793 if ($repo) {
1794 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1795 'sendemail-validate');
1796 my $hook_error;
1797 if (-x $validate_hook) {
1798 my $target = abs_path($fn);
1799 # The hook needs a correct cwd and GIT_DIR.
1800 my $cwd_save = cwd();
1801 chdir($repo->wc_path() or $repo->repo_path())
1802 or die("chdir: $!");
1803 local $ENV{"GIT_DIR"} = $repo->repo_path();
1804 $hook_error = "rejected by sendemail-validate hook"
1805 if system($validate_hook, $target);
1806 chdir($cwd_save) or die("chdir: $!");
1808 return $hook_error if $hook_error;
1811 open(my $fh, '<', $fn)
1812 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1813 while (my $line = <$fh>) {
1814 if (length($line) > 998) {
1815 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1818 return;
1821 sub handle_backup {
1822 my ($last, $lastlen, $file, $known_suffix) = @_;
1823 my ($suffix, $skip);
1825 $skip = 0;
1826 if (defined $last &&
1827 ($lastlen < length($file)) &&
1828 (substr($file, 0, $lastlen) eq $last) &&
1829 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1830 if (defined $known_suffix && $suffix eq $known_suffix) {
1831 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1832 $skip = 1;
1833 } else {
1834 # TRANSLATORS: please keep "[y|N]" as is.
1835 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1836 valid_re => qr/^(?:y|n)/i,
1837 default => 'n');
1838 $skip = ($answer ne 'y');
1839 if ($skip) {
1840 $known_suffix = $suffix;
1844 return ($skip, $known_suffix);
1847 sub handle_backup_files {
1848 my @file = @_;
1849 my ($last, $lastlen, $known_suffix, $skip, @result);
1850 for my $file (@file) {
1851 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1852 $file, $known_suffix);
1853 push @result, $file unless $skip;
1854 $last = $file;
1855 $lastlen = length($file);
1857 return @result;
1860 sub file_has_nonascii {
1861 my $fn = shift;
1862 open(my $fh, '<', $fn)
1863 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1864 while (my $line = <$fh>) {
1865 return 1 if $line =~ /[^[:ascii:]]/;
1867 return 0;
1870 sub body_or_subject_has_nonascii {
1871 my $fn = shift;
1872 open(my $fh, '<', $fn)
1873 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1874 while (my $line = <$fh>) {
1875 last if $line =~ /^$/;
1876 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1878 while (my $line = <$fh>) {
1879 return 1 if $line =~ /[^[:ascii:]]/;
1881 return 0;