doc: describe git svn init --ignore-refs
[git/git-svn.git] / git-send-email.perl
blob7fd58744360a2bb14531ed3f73092b45449d5590
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 Automating:
86 --identity <str> * Use the sendemail.<id> options.
87 --to-cmd <str> * Email To: via `<str> \$patch_path`
88 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
89 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, all.
90 --[no-]cc-cover * Email Cc: addresses in the cover letter.
91 --[no-]to-cover * Email To: addresses in the cover letter.
92 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
93 --[no-]suppress-from * Send to self. Default off.
94 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
95 --[no-]thread * Use In-Reply-To: field. Default on.
97 Administering:
98 --confirm <str> * Confirm recipients before sending;
99 auto, cc, compose, always, or never.
100 --quiet * Output one line of info per email.
101 --dry-run * Don't actually send the emails.
102 --[no-]validate * Perform patch sanity checks. Default on.
103 --[no-]format-patch * understand any non optional arguments as
104 `git format-patch` ones.
105 --force * Send even if safety checks would prevent it.
107 Information:
108 --dump-aliases * Dump configured aliases and exit.
111 exit(1);
114 # most mail servers generate the Date: header, but not all...
115 sub format_2822_time {
116 my ($time) = @_;
117 my @localtm = localtime($time);
118 my @gmttm = gmtime($time);
119 my $localmin = $localtm[1] + $localtm[2] * 60;
120 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
121 if ($localtm[0] != $gmttm[0]) {
122 die __("local zone differs from GMT by a non-minute interval\n");
124 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
125 $localmin += 1440;
126 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
127 $localmin -= 1440;
128 } elsif ($gmttm[6] != $localtm[6]) {
129 die __("local time offset greater than or equal to 24 hours\n");
131 my $offset = $localmin - $gmtmin;
132 my $offhour = $offset / 60;
133 my $offmin = abs($offset % 60);
134 if (abs($offhour) >= 24) {
135 die __("local time offset greater than or equal to 24 hours\n");
138 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
139 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
140 $localtm[3],
141 qw(Jan Feb Mar Apr May Jun
142 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
143 $localtm[5]+1900,
144 $localtm[2],
145 $localtm[1],
146 $localtm[0],
147 ($offset >= 0) ? '+' : '-',
148 abs($offhour),
149 $offmin,
153 my $have_email_valid = eval { require Email::Valid; 1 };
154 my $have_mail_address = eval { require Mail::Address; 1 };
155 my $smtp;
156 my $auth;
158 # Regexes for RFC 2047 productions.
159 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
160 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
161 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
163 # Variables we fill in automatically, or via prompting:
164 my (@to,$no_to,@initial_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh,
165 $initial_reply_to,$initial_subject,@files,
166 $author,$sender,$smtp_authpass,$annotate,$use_xmailer,$compose,$time);
168 my $envelope_sender;
170 # Example reply to:
171 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
173 my $repo = eval { Git->repository() };
174 my @repo = $repo ? ($repo) : ();
175 my $term = eval {
176 $ENV{"GIT_SEND_EMAIL_NOTTY"}
177 ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT
178 : new Term::ReadLine 'git-send-email';
180 if ($@) {
181 $term = new FakeTerm "$@: going non-interactive";
184 # Behavior modification variables
185 my ($quiet, $dry_run) = (0, 0);
186 my $format_patch;
187 my $compose_filename;
188 my $force = 0;
189 my $dump_aliases = 0;
191 # Handle interactive edition of files.
192 my $multiedit;
193 my $editor;
195 sub do_edit {
196 if (!defined($editor)) {
197 $editor = Git::command_oneline('var', 'GIT_EDITOR');
199 if (defined($multiedit) && !$multiedit) {
200 map {
201 system('sh', '-c', $editor.' "$@"', $editor, $_);
202 if (($? & 127) || ($? >> 8)) {
203 die(__("the editor exited uncleanly, aborting everything"));
205 } @_;
206 } else {
207 system('sh', '-c', $editor.' "$@"', $editor, @_);
208 if (($? & 127) || ($? >> 8)) {
209 die(__("the editor exited uncleanly, aborting everything"));
214 # Variables with corresponding config settings
215 my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc);
216 my ($cover_cc, $cover_to);
217 my ($to_cmd, $cc_cmd);
218 my ($smtp_server, $smtp_server_port, @smtp_server_options);
219 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
220 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
221 my ($validate, $confirm);
222 my (@suppress_cc);
223 my ($auto_8bit_encoding);
224 my ($compose_encoding);
225 my ($target_xfer_encoding);
227 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
229 my %config_bool_settings = (
230 "thread" => [\$thread, 1],
231 "chainreplyto" => [\$chain_reply_to, 0],
232 "suppressfrom" => [\$suppress_from, undef],
233 "signedoffbycc" => [\$signed_off_by_cc, undef],
234 "cccover" => [\$cover_cc, undef],
235 "tocover" => [\$cover_to, undef],
236 "signedoffcc" => [\$signed_off_by_cc, undef], # Deprecated
237 "validate" => [\$validate, 1],
238 "multiedit" => [\$multiedit, undef],
239 "annotate" => [\$annotate, undef],
240 "xmailer" => [\$use_xmailer, 1]
243 my %config_settings = (
244 "smtpserver" => \$smtp_server,
245 "smtpserverport" => \$smtp_server_port,
246 "smtpserveroption" => \@smtp_server_options,
247 "smtpuser" => \$smtp_authuser,
248 "smtppass" => \$smtp_authpass,
249 "smtpdomain" => \$smtp_domain,
250 "smtpauth" => \$smtp_auth,
251 "to" => \@initial_to,
252 "tocmd" => \$to_cmd,
253 "cc" => \@initial_cc,
254 "cccmd" => \$cc_cmd,
255 "aliasfiletype" => \$aliasfiletype,
256 "bcc" => \@bcclist,
257 "suppresscc" => \@suppress_cc,
258 "envelopesender" => \$envelope_sender,
259 "confirm" => \$confirm,
260 "from" => \$sender,
261 "assume8bitencoding" => \$auto_8bit_encoding,
262 "composeencoding" => \$compose_encoding,
263 "transferencoding" => \$target_xfer_encoding,
266 my %config_path_settings = (
267 "aliasesfile" => \@alias_files,
268 "smtpsslcertpath" => \$smtp_ssl_cert_path,
271 # Handle Uncouth Termination
272 sub signal_handler {
274 # Make text normal
275 print color("reset"), "\n";
277 # SMTP password masked
278 system "stty echo";
280 # tmp files from --compose
281 if (defined $compose_filename) {
282 if (-e $compose_filename) {
283 printf __("'%s' contains an intermediate version ".
284 "of the email you were composing.\n"),
285 $compose_filename;
287 if (-e ($compose_filename . ".final")) {
288 printf __("'%s.final' contains the composed email.\n"),
289 $compose_filename;
293 exit;
296 $SIG{TERM} = \&signal_handler;
297 $SIG{INT} = \&signal_handler;
299 # Begin by accumulating all the variables (defined above), that we will end up
300 # needing, first, from the command line:
302 my $help;
303 my $rc = GetOptions("h" => \$help,
304 "dump-aliases" => \$dump_aliases);
305 usage() unless $rc;
306 die __("--dump-aliases incompatible with other options\n")
307 if !$help and $dump_aliases and @ARGV;
308 $rc = GetOptions(
309 "sender|from=s" => \$sender,
310 "in-reply-to=s" => \$initial_reply_to,
311 "subject=s" => \$initial_subject,
312 "to=s" => \@initial_to,
313 "to-cmd=s" => \$to_cmd,
314 "no-to" => \$no_to,
315 "cc=s" => \@initial_cc,
316 "no-cc" => \$no_cc,
317 "bcc=s" => \@bcclist,
318 "no-bcc" => \$no_bcc,
319 "chain-reply-to!" => \$chain_reply_to,
320 "no-chain-reply-to" => sub {$chain_reply_to = 0},
321 "smtp-server=s" => \$smtp_server,
322 "smtp-server-option=s" => \@smtp_server_options,
323 "smtp-server-port=s" => \$smtp_server_port,
324 "smtp-user=s" => \$smtp_authuser,
325 "smtp-pass:s" => \$smtp_authpass,
326 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
327 "smtp-encryption=s" => \$smtp_encryption,
328 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
329 "smtp-debug:i" => \$debug_net_smtp,
330 "smtp-domain:s" => \$smtp_domain,
331 "smtp-auth=s" => \$smtp_auth,
332 "identity=s" => \$identity,
333 "annotate!" => \$annotate,
334 "no-annotate" => sub {$annotate = 0},
335 "compose" => \$compose,
336 "quiet" => \$quiet,
337 "cc-cmd=s" => \$cc_cmd,
338 "suppress-from!" => \$suppress_from,
339 "no-suppress-from" => sub {$suppress_from = 0},
340 "suppress-cc=s" => \@suppress_cc,
341 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
342 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
343 "cc-cover|cc-cover!" => \$cover_cc,
344 "no-cc-cover" => sub {$cover_cc = 0},
345 "to-cover|to-cover!" => \$cover_to,
346 "no-to-cover" => sub {$cover_to = 0},
347 "confirm=s" => \$confirm,
348 "dry-run" => \$dry_run,
349 "envelope-sender=s" => \$envelope_sender,
350 "thread!" => \$thread,
351 "no-thread" => sub {$thread = 0},
352 "validate!" => \$validate,
353 "no-validate" => sub {$validate = 0},
354 "transfer-encoding=s" => \$target_xfer_encoding,
355 "format-patch!" => \$format_patch,
356 "no-format-patch" => sub {$format_patch = 0},
357 "8bit-encoding=s" => \$auto_8bit_encoding,
358 "compose-encoding=s" => \$compose_encoding,
359 "force" => \$force,
360 "xmailer!" => \$use_xmailer,
361 "no-xmailer" => sub {$use_xmailer = 0},
364 usage() if $help;
365 unless ($rc) {
366 usage();
369 die __("Cannot run git format-patch from outside a repository\n")
370 if $format_patch and not $repo;
372 # Now, let's fill any that aren't set in with defaults:
374 sub read_config {
375 my ($prefix) = @_;
377 foreach my $setting (keys %config_bool_settings) {
378 my $target = $config_bool_settings{$setting}->[0];
379 $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target);
382 foreach my $setting (keys %config_path_settings) {
383 my $target = $config_path_settings{$setting};
384 if (ref($target) eq "ARRAY") {
385 unless (@$target) {
386 my @values = Git::config_path(@repo, "$prefix.$setting");
387 @$target = @values if (@values && defined $values[0]);
390 else {
391 $$target = Git::config_path(@repo, "$prefix.$setting") unless (defined $$target);
395 foreach my $setting (keys %config_settings) {
396 my $target = $config_settings{$setting};
397 next if $setting eq "to" and defined $no_to;
398 next if $setting eq "cc" and defined $no_cc;
399 next if $setting eq "bcc" and defined $no_bcc;
400 if (ref($target) eq "ARRAY") {
401 unless (@$target) {
402 my @values = Git::config(@repo, "$prefix.$setting");
403 @$target = @values if (@values && defined $values[0]);
406 else {
407 $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target);
411 if (!defined $smtp_encryption) {
412 my $enc = Git::config(@repo, "$prefix.smtpencryption");
413 if (defined $enc) {
414 $smtp_encryption = $enc;
415 } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) {
416 $smtp_encryption = 'ssl';
421 # read configuration from [sendemail "$identity"], fall back on [sendemail]
422 $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity);
423 read_config("sendemail.$identity") if (defined $identity);
424 read_config("sendemail");
426 # fall back on builtin bool defaults
427 foreach my $setting (values %config_bool_settings) {
428 ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]}));
431 # 'default' encryption is none -- this only prevents a warning
432 $smtp_encryption = '' unless (defined $smtp_encryption);
434 # Set CC suppressions
435 my(%suppress_cc);
436 if (@suppress_cc) {
437 foreach my $entry (@suppress_cc) {
438 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
439 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
440 $suppress_cc{$entry} = 1;
444 if ($suppress_cc{'all'}) {
445 foreach my $entry (qw (cccmd cc author self sob body bodycc)) {
446 $suppress_cc{$entry} = 1;
448 delete $suppress_cc{'all'};
451 # If explicit old-style ones are specified, they trump --suppress-cc.
452 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
453 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
455 if ($suppress_cc{'body'}) {
456 foreach my $entry (qw (sob bodycc)) {
457 $suppress_cc{$entry} = 1;
459 delete $suppress_cc{'body'};
462 # Set confirm's default value
463 my $confirm_unconfigured = !defined $confirm;
464 if ($confirm_unconfigured) {
465 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
467 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
468 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
470 # Debugging, print out the suppressions.
471 if (0) {
472 print "suppressions:\n";
473 foreach my $entry (keys %suppress_cc) {
474 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
478 my ($repoauthor, $repocommitter);
479 ($repoauthor) = Git::ident_person(@repo, 'author');
480 ($repocommitter) = Git::ident_person(@repo, 'committer');
482 sub parse_address_line {
483 if ($have_mail_address) {
484 return map { $_->format } Mail::Address->parse($_[0]);
485 } else {
486 return Git::parse_mailboxes($_[0]);
490 sub split_addrs {
491 return quotewords('\s*,\s*', 1, @_);
494 my %aliases;
496 sub parse_sendmail_alias {
497 local $_ = shift;
498 if (/"/) {
499 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
500 } elsif (/:include:/) {
501 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
502 } elsif (/[\/|]/) {
503 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
504 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
505 my ($alias, $addr) = ($1, $2);
506 $aliases{$alias} = [ split_addrs($addr) ];
507 } else {
508 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
512 sub parse_sendmail_aliases {
513 my $fh = shift;
514 my $s = '';
515 while (<$fh>) {
516 chomp;
517 next if /^\s*$/ || /^\s*#/;
518 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
519 parse_sendmail_alias($s) if $s;
520 $s = $_;
522 $s =~ s/\\$//; # silently tolerate stray '\' on last line
523 parse_sendmail_alias($s) if $s;
526 my %parse_alias = (
527 # multiline formats can be supported in the future
528 mutt => sub { my $fh = shift; while (<$fh>) {
529 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
530 my ($alias, $addr) = ($1, $2);
531 $addr =~ s/#.*$//; # mutt allows # comments
532 # commas delimit multiple addresses
533 my @addr = split_addrs($addr);
535 # quotes may be escaped in the file,
536 # unescape them so we do not double-escape them later.
537 s/\\"/"/g foreach @addr;
538 $aliases{$alias} = \@addr
539 }}},
540 mailrc => sub { my $fh = shift; while (<$fh>) {
541 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
542 # spaces delimit multiple addresses
543 $aliases{$1} = [ quotewords('\s+', 0, $2) ];
544 }}},
545 pine => sub { my $fh = shift; my $f='\t[^\t]*';
546 for (my $x = ''; defined($x); $x = $_) {
547 chomp $x;
548 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
549 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
550 $aliases{$1} = [ split_addrs($2) ];
552 elm => sub { my $fh = shift;
553 while (<$fh>) {
554 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
555 my ($alias, $addr) = ($1, $2);
556 $aliases{$alias} = [ split_addrs($addr) ];
558 } },
559 sendmail => \&parse_sendmail_aliases,
560 gnus => sub { my $fh = shift; while (<$fh>) {
561 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
562 $aliases{$1} = [ $2 ];
566 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
567 foreach my $file (@alias_files) {
568 open my $fh, '<', $file or die "opening $file: $!\n";
569 $parse_alias{$aliasfiletype}->($fh);
570 close $fh;
574 if ($dump_aliases) {
575 print "$_\n" for (sort keys %aliases);
576 exit(0);
579 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
580 # $f is a revision list specification to be passed to format-patch.
581 sub is_format_patch_arg {
582 return unless $repo;
583 my $f = shift;
584 try {
585 $repo->command('rev-parse', '--verify', '--quiet', $f);
586 if (defined($format_patch)) {
587 return $format_patch;
589 die sprintf(__ <<EOF, $f, $f);
590 File '%s' exists but it could also be the range of commits
591 to produce patches for. Please disambiguate by...
593 * Saying "./%s" if you mean a file; or
594 * Giving --format-patch option if you mean a range.
596 } catch Git::Error::Command with {
597 # Not a valid revision. Treat it as a filename.
598 return 0;
602 # Now that all the defaults are set, process the rest of the command line
603 # arguments and collect up the files that need to be processed.
604 my @rev_list_opts;
605 while (defined(my $f = shift @ARGV)) {
606 if ($f eq "--") {
607 push @rev_list_opts, "--", @ARGV;
608 @ARGV = ();
609 } elsif (-d $f and !is_format_patch_arg($f)) {
610 opendir my $dh, $f
611 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
613 push @files, grep { -f $_ } map { catfile($f, $_) }
614 sort readdir $dh;
615 closedir $dh;
616 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
617 push @files, $f;
618 } else {
619 push @rev_list_opts, $f;
623 if (@rev_list_opts) {
624 die __("Cannot run git format-patch from outside a repository\n")
625 unless $repo;
626 push @files, $repo->command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts);
629 @files = handle_backup_files(@files);
631 if ($validate) {
632 foreach my $f (@files) {
633 unless (-p $f) {
634 my $error = validate_patch($f);
635 $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
636 $f, $error);
641 if (@files) {
642 unless ($quiet) {
643 print $_,"\n" for (@files);
645 } else {
646 print STDERR __("\nNo patch files specified!\n\n");
647 usage();
650 sub get_patch_subject {
651 my $fn = shift;
652 open (my $fh, '<', $fn);
653 while (my $line = <$fh>) {
654 next unless ($line =~ /^Subject: (.*)$/);
655 close $fh;
656 return "GIT: $1\n";
658 close $fh;
659 die sprintf(__("No subject line in %s?"), $fn);
662 if ($compose) {
663 # Note that this does not need to be secure, but we will make a small
664 # effort to have it be unique
665 $compose_filename = ($repo ?
666 tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
667 tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
668 open my $c, ">", $compose_filename
669 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
672 my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
673 my $tpl_subject = $initial_subject || '';
674 my $tpl_reply_to = $initial_reply_to || '';
676 print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
677 From $tpl_sender # This line is ignored.
678 EOT1
679 Lines beginning in "GIT:" will be removed.
680 Consider including an overall diffstat or table of contents
681 for the patch you are writing.
683 Clear the body content if you don't wish to send a summary.
684 EOT2
685 From: $tpl_sender
686 Subject: $tpl_subject
687 In-Reply-To: $tpl_reply_to
689 EOT3
690 for my $f (@files) {
691 print $c get_patch_subject($f);
693 close $c;
695 if ($annotate) {
696 do_edit($compose_filename, @files);
697 } else {
698 do_edit($compose_filename);
701 open my $c2, ">", $compose_filename . ".final"
702 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
704 open $c, "<", $compose_filename
705 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
707 my $need_8bit_cte = file_has_nonascii($compose_filename);
708 my $in_body = 0;
709 my $summary_empty = 1;
710 if (!defined $compose_encoding) {
711 $compose_encoding = "UTF-8";
713 while(<$c>) {
714 next if m/^GIT:/;
715 if ($in_body) {
716 $summary_empty = 0 unless (/^\n$/);
717 } elsif (/^\n$/) {
718 $in_body = 1;
719 if ($need_8bit_cte) {
720 print $c2 "MIME-Version: 1.0\n",
721 "Content-Type: text/plain; ",
722 "charset=$compose_encoding\n",
723 "Content-Transfer-Encoding: 8bit\n";
725 } elsif (/^MIME-Version:/i) {
726 $need_8bit_cte = 0;
727 } elsif (/^Subject:\s*(.+)\s*$/i) {
728 $initial_subject = $1;
729 my $subject = $initial_subject;
730 $_ = "Subject: " .
731 quote_subject($subject, $compose_encoding) .
732 "\n";
733 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
734 $initial_reply_to = $1;
735 next;
736 } elsif (/^From:\s*(.+)\s*$/i) {
737 $sender = $1;
738 next;
739 } elsif (/^(?:To|Cc|Bcc):/i) {
740 print __("To/Cc/Bcc fields are not interpreted yet, they have been ignored\n");
741 next;
743 print $c2 $_;
745 close $c;
746 close $c2;
748 if ($summary_empty) {
749 print __("Summary email is empty, skipping it\n");
750 $compose = -1;
752 } elsif ($annotate) {
753 do_edit(@files);
756 sub ask {
757 my ($prompt, %arg) = @_;
758 my $valid_re = $arg{valid_re};
759 my $default = $arg{default};
760 my $confirm_only = $arg{confirm_only};
761 my $resp;
762 my $i = 0;
763 return defined $default ? $default : undef
764 unless defined $term->IN and defined fileno($term->IN) and
765 defined $term->OUT and defined fileno($term->OUT);
766 while ($i++ < 10) {
767 $resp = $term->readline($prompt);
768 if (!defined $resp) { # EOF
769 print "\n";
770 return defined $default ? $default : undef;
772 if ($resp eq '' and defined $default) {
773 return $default;
775 if (!defined $valid_re or $resp =~ /$valid_re/) {
776 return $resp;
778 if ($confirm_only) {
779 my $yesno = $term->readline(
780 # TRANSLATORS: please keep [y/N] as is.
781 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
782 if (defined $yesno && $yesno =~ /y/i) {
783 return $resp;
787 return;
790 my %broken_encoding;
792 sub file_declares_8bit_cte {
793 my $fn = shift;
794 open (my $fh, '<', $fn);
795 while (my $line = <$fh>) {
796 last if ($line =~ /^$/);
797 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
799 close $fh;
800 return 0;
803 foreach my $f (@files) {
804 next unless (body_or_subject_has_nonascii($f)
805 && !file_declares_8bit_cte($f));
806 $broken_encoding{$f} = 1;
809 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
810 print __("The following files are 8bit, but do not declare " .
811 "a Content-Transfer-Encoding.\n");
812 foreach my $f (sort keys %broken_encoding) {
813 print " $f\n";
815 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
816 valid_re => qr/.{4}/, confirm_only => 1,
817 default => "UTF-8");
820 if (!$force) {
821 for my $f (@files) {
822 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
823 die sprintf(__("Refusing to send because the patch\n\t%s\n"
824 . "has the template subject '*** SUBJECT HERE ***'. "
825 . "Pass --force if you really want to send.\n"), $f);
830 if (defined $sender) {
831 $sender =~ s/^\s+|\s+$//g;
832 ($sender) = expand_aliases($sender);
833 } else {
834 $sender = $repoauthor || $repocommitter || '';
837 # $sender could be an already sanitized address
838 # (e.g. sendemail.from could be manually sanitized by user).
839 # But it's a no-op to run sanitize_address on an already sanitized address.
840 $sender = sanitize_address($sender);
842 my $to_whom = __("To whom should the emails be sent (if anyone)?");
843 my $prompting = 0;
844 if (!@initial_to && !defined $to_cmd) {
845 my $to = ask("$to_whom ",
846 default => "",
847 valid_re => qr/\@.*\./, confirm_only => 1);
848 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
849 $prompting++;
852 sub expand_aliases {
853 return map { expand_one_alias($_) } @_;
856 my %EXPANDED_ALIASES;
857 sub expand_one_alias {
858 my $alias = shift;
859 if ($EXPANDED_ALIASES{$alias}) {
860 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
862 local $EXPANDED_ALIASES{$alias} = 1;
863 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
866 @initial_to = process_address_list(@initial_to);
867 @initial_cc = process_address_list(@initial_cc);
868 @bcclist = process_address_list(@bcclist);
870 if ($thread && !defined $initial_reply_to && $prompting) {
871 $initial_reply_to = ask(
872 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
873 default => "",
874 valid_re => qr/\@.*\./, confirm_only => 1);
876 if (defined $initial_reply_to) {
877 $initial_reply_to =~ s/^\s*<?//;
878 $initial_reply_to =~ s/>?\s*$//;
879 $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne '';
882 if (!defined $smtp_server) {
883 foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) {
884 if (-x $_) {
885 $smtp_server = $_;
886 last;
889 $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug*
892 if ($compose && $compose > 0) {
893 @files = ($compose_filename . ".final", @files);
896 # Variables we set as part of the loop over files
897 our ($message_id, %mail, $subject, $reply_to, $references, $message,
898 $needs_confirm, $message_num, $ask_default);
900 sub extract_valid_address {
901 my $address = shift;
902 my $local_part_regexp = qr/[^<>"\s@]+/;
903 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
905 # check for a local address:
906 return $address if ($address =~ /^($local_part_regexp)$/);
908 $address =~ s/^\s*<(.*)>\s*$/$1/;
909 if ($have_email_valid) {
910 return scalar Email::Valid->address($address);
913 # less robust/correct than the monster regexp in Email::Valid,
914 # but still does a 99% job, and one less dependency
915 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
916 return;
919 sub extract_valid_address_or_die {
920 my $address = shift;
921 $address = extract_valid_address($address);
922 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
923 if !$address;
924 return $address;
927 sub validate_address {
928 my $address = shift;
929 while (!extract_valid_address($address)) {
930 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
931 # TRANSLATORS: Make sure to include [q] [d] [e] in your
932 # translation. The program will only accept English input
933 # at this point.
934 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
935 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
936 default => 'q');
937 if (/^d/i) {
938 return undef;
939 } elsif (/^q/i) {
940 cleanup_compose_files();
941 exit(0);
943 $address = ask("$to_whom ",
944 default => "",
945 valid_re => qr/\@.*\./, confirm_only => 1);
947 return $address;
950 sub validate_address_list {
951 return (grep { defined $_ }
952 map { validate_address($_) } @_);
955 # Usually don't need to change anything below here.
957 # we make a "fake" message id by taking the current number
958 # of seconds since the beginning of Unix time and tacking on
959 # a random number to the end, in case we are called quicker than
960 # 1 second since the last time we were called.
962 # We'll setup a template for the message id, using the "from" address:
964 my ($message_id_stamp, $message_id_serial);
965 sub make_message_id {
966 my $uniq;
967 if (!defined $message_id_stamp) {
968 $message_id_stamp = strftime("%Y%m%d%H%M%S.$$", gmtime(time));
969 $message_id_serial = 0;
971 $message_id_serial++;
972 $uniq = "$message_id_stamp-$message_id_serial";
974 my $du_part;
975 for ($sender, $repocommitter, $repoauthor) {
976 $du_part = extract_valid_address(sanitize_address($_));
977 last if (defined $du_part and $du_part ne '');
979 if (not defined $du_part or $du_part eq '') {
980 require Sys::Hostname;
981 $du_part = 'user@' . Sys::Hostname::hostname();
983 my $message_id_template = "<%s-%s>";
984 $message_id = sprintf($message_id_template, $uniq, $du_part);
985 #print "new message id = $message_id\n"; # Was useful for debugging
990 $time = time - scalar $#files;
992 sub unquote_rfc2047 {
993 local ($_) = @_;
994 my $charset;
995 my $sep = qr/[ \t]+/;
996 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
997 my @words = split $sep, $&;
998 foreach (@words) {
999 m/$re_encoded_word/;
1000 $charset = $1;
1001 my $encoding = $2;
1002 my $text = $3;
1003 if ($encoding eq 'q' || $encoding eq 'Q') {
1004 $_ = $text;
1005 s/_/ /g;
1006 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1007 } else {
1008 # other encodings not supported yet
1011 join '', @words;
1012 }eg;
1013 return wantarray ? ($_, $charset) : $_;
1016 sub quote_rfc2047 {
1017 local $_ = shift;
1018 my $encoding = shift || 'UTF-8';
1019 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1020 s/(.*)/=\?$encoding\?q\?$1\?=/;
1021 return $_;
1024 sub is_rfc2047_quoted {
1025 my $s = shift;
1026 length($s) <= 75 &&
1027 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1030 sub subject_needs_rfc2047_quoting {
1031 my $s = shift;
1033 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1036 sub quote_subject {
1037 local $subject = shift;
1038 my $encoding = shift || 'UTF-8';
1040 if (subject_needs_rfc2047_quoting($subject)) {
1041 return quote_rfc2047($subject, $encoding);
1043 return $subject;
1046 # use the simplest quoting being able to handle the recipient
1047 sub sanitize_address {
1048 my ($recipient) = @_;
1050 # remove garbage after email address
1051 $recipient =~ s/(.*>).*$/$1/;
1053 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1055 if (not $recipient_name) {
1056 return $recipient;
1059 # if recipient_name is already quoted, do nothing
1060 if (is_rfc2047_quoted($recipient_name)) {
1061 return $recipient;
1064 # remove non-escaped quotes
1065 $recipient_name =~ s/(^|[^\\])"/$1/g;
1067 # rfc2047 is needed if a non-ascii char is included
1068 if ($recipient_name =~ /[^[:ascii:]]/) {
1069 $recipient_name = quote_rfc2047($recipient_name);
1072 # double quotes are needed if specials or CTLs are included
1073 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1074 $recipient_name =~ s/([\\\r])/\\$1/g;
1075 $recipient_name = qq["$recipient_name"];
1078 return "$recipient_name $recipient_addr";
1082 sub sanitize_address_list {
1083 return (map { sanitize_address($_) } @_);
1086 sub process_address_list {
1087 my @addr_list = map { parse_address_line($_) } @_;
1088 @addr_list = expand_aliases(@addr_list);
1089 @addr_list = sanitize_address_list(@addr_list);
1090 @addr_list = validate_address_list(@addr_list);
1091 return @addr_list;
1094 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1096 # Tightly configured MTAa require that a caller sends a real DNS
1097 # domain name that corresponds the IP address in the HELO/EHLO
1098 # handshake. This is used to verify the connection and prevent
1099 # spammers from trying to hide their identity. If the DNS and IP don't
1100 # match, the receiveing MTA may deny the connection.
1102 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1104 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1105 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1107 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1108 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1110 sub valid_fqdn {
1111 my $domain = shift;
1112 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1115 sub maildomain_net {
1116 my $maildomain;
1118 if (eval { require Net::Domain; 1 }) {
1119 my $domain = Net::Domain::domainname();
1120 $maildomain = $domain if valid_fqdn($domain);
1123 return $maildomain;
1126 sub maildomain_mta {
1127 my $maildomain;
1129 if (eval { require Net::SMTP; 1 }) {
1130 for my $host (qw(mailhost localhost)) {
1131 my $smtp = Net::SMTP->new($host);
1132 if (defined $smtp) {
1133 my $domain = $smtp->domain;
1134 $smtp->quit;
1136 $maildomain = $domain if valid_fqdn($domain);
1138 last if $maildomain;
1143 return $maildomain;
1146 sub maildomain {
1147 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1150 sub smtp_host_string {
1151 if (defined $smtp_server_port) {
1152 return "$smtp_server:$smtp_server_port";
1153 } else {
1154 return $smtp_server;
1158 # Returns 1 if authentication succeeded or was not necessary
1159 # (smtp_user was not specified), and 0 otherwise.
1161 sub smtp_auth_maybe {
1162 if (!defined $smtp_authuser || $auth) {
1163 return 1;
1166 # Workaround AUTH PLAIN/LOGIN interaction defect
1167 # with Authen::SASL::Cyrus
1168 eval {
1169 require Authen::SASL;
1170 Authen::SASL->import(qw(Perl));
1173 # Check mechanism naming as defined in:
1174 # https://tools.ietf.org/html/rfc4422#page-8
1175 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1176 die "invalid smtp auth: '${smtp_auth}'";
1179 # TODO: Authentication may fail not because credentials were
1180 # invalid but due to other reasons, in which we should not
1181 # reject credentials.
1182 $auth = Git::credential({
1183 'protocol' => 'smtp',
1184 'host' => smtp_host_string(),
1185 'username' => $smtp_authuser,
1186 # if there's no password, "git credential fill" will
1187 # give us one, otherwise it'll just pass this one.
1188 'password' => $smtp_authpass
1189 }, sub {
1190 my $cred = shift;
1192 if ($smtp_auth) {
1193 my $sasl = Authen::SASL->new(
1194 mechanism => $smtp_auth,
1195 callback => {
1196 user => $cred->{'username'},
1197 pass => $cred->{'password'},
1198 authname => $cred->{'username'},
1202 return !!$smtp->auth($sasl);
1205 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1208 return $auth;
1211 sub ssl_verify_params {
1212 eval {
1213 require IO::Socket::SSL;
1214 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1216 if ($@) {
1217 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1218 return;
1221 if (!defined $smtp_ssl_cert_path) {
1222 # use the OpenSSL defaults
1223 return (SSL_verify_mode => SSL_VERIFY_PEER());
1226 if ($smtp_ssl_cert_path eq "") {
1227 return (SSL_verify_mode => SSL_VERIFY_NONE());
1228 } elsif (-d $smtp_ssl_cert_path) {
1229 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1230 SSL_ca_path => $smtp_ssl_cert_path);
1231 } elsif (-f $smtp_ssl_cert_path) {
1232 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1233 SSL_ca_file => $smtp_ssl_cert_path);
1234 } else {
1235 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1239 sub file_name_is_absolute {
1240 my ($path) = @_;
1242 # msys does not grok DOS drive-prefixes
1243 if ($^O eq 'msys') {
1244 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1247 require File::Spec::Functions;
1248 return File::Spec::Functions::file_name_is_absolute($path);
1251 # Returns 1 if the message was sent, and 0 otherwise.
1252 # In actuality, the whole program dies when there
1253 # is an error sending a message.
1255 sub send_message {
1256 my @recipients = unique_email_list(@to);
1257 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1258 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1260 @cc);
1261 my $to = join (",\n\t", @recipients);
1262 @recipients = unique_email_list(@recipients,@cc,@bcclist);
1263 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1264 my $date = format_2822_time($time++);
1265 my $gitversion = '@@GIT_VERSION@@';
1266 if ($gitversion =~ m/..GIT_VERSION../) {
1267 $gitversion = Git::version();
1270 my $cc = join(",\n\t", unique_email_list(@cc));
1271 my $ccline = "";
1272 if ($cc ne '') {
1273 $ccline = "\nCc: $cc";
1275 make_message_id() unless defined($message_id);
1277 my $header = "From: $sender
1278 To: $to${ccline}
1279 Subject: $subject
1280 Date: $date
1281 Message-Id: $message_id
1283 if ($use_xmailer) {
1284 $header .= "X-Mailer: git-send-email $gitversion\n";
1286 if ($reply_to) {
1288 $header .= "In-Reply-To: $reply_to\n";
1289 $header .= "References: $references\n";
1291 if (@xh) {
1292 $header .= join("\n", @xh) . "\n";
1295 my @sendmail_parameters = ('-i', @recipients);
1296 my $raw_from = $sender;
1297 if (defined $envelope_sender && $envelope_sender ne "auto") {
1298 $raw_from = $envelope_sender;
1300 $raw_from = extract_valid_address($raw_from);
1301 unshift (@sendmail_parameters,
1302 '-f', $raw_from) if(defined $envelope_sender);
1304 if ($needs_confirm && !$dry_run) {
1305 print "\n$header\n";
1306 if ($needs_confirm eq "inform") {
1307 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1308 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1309 print __ <<EOF ;
1310 The Cc list above has been expanded by additional
1311 addresses found in the patch commit message. By default
1312 send-email prompts before sending whenever this occurs.
1313 This behavior is controlled by the sendemail.confirm
1314 configuration setting.
1316 For additional information, run 'git send-email --help'.
1317 To retain the current behavior, but squelch this message,
1318 run 'git config --global sendemail.confirm auto'.
1322 # TRANSLATORS: Make sure to include [y] [n] [q] [a] in your
1323 # translation. The program will only accept English input
1324 # at this point.
1325 $_ = ask(__("Send this email? ([y]es|[n]o|[q]uit|[a]ll): "),
1326 valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
1327 default => $ask_default);
1328 die __("Send this email reply required") unless defined $_;
1329 if (/^n/i) {
1330 return 0;
1331 } elsif (/^q/i) {
1332 cleanup_compose_files();
1333 exit(0);
1334 } elsif (/^a/i) {
1335 $confirm = 'never';
1339 unshift (@sendmail_parameters, @smtp_server_options);
1341 if ($dry_run) {
1342 # We don't want to send the email.
1343 } elsif (file_name_is_absolute($smtp_server)) {
1344 my $pid = open my $sm, '|-';
1345 defined $pid or die $!;
1346 if (!$pid) {
1347 exec($smtp_server, @sendmail_parameters) or die $!;
1349 print $sm "$header\n$message";
1350 close $sm or die $!;
1351 } else {
1353 if (!defined $smtp_server) {
1354 die __("The required SMTP server is not properly defined.")
1357 require Net::SMTP;
1358 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1359 $smtp_domain ||= maildomain();
1361 if ($smtp_encryption eq 'ssl') {
1362 $smtp_server_port ||= 465; # ssmtp
1363 require IO::Socket::SSL;
1365 # Suppress "variable accessed once" warning.
1367 no warnings 'once';
1368 $IO::Socket::SSL::DEBUG = 1;
1371 # Net::SMTP::SSL->new() does not forward any SSL options
1372 IO::Socket::SSL::set_client_defaults(
1373 ssl_verify_params());
1375 if ($use_net_smtp_ssl) {
1376 require Net::SMTP::SSL;
1377 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1378 Hello => $smtp_domain,
1379 Port => $smtp_server_port,
1380 Debug => $debug_net_smtp);
1382 else {
1383 $smtp ||= Net::SMTP->new($smtp_server,
1384 Hello => $smtp_domain,
1385 Port => $smtp_server_port,
1386 Debug => $debug_net_smtp,
1387 SSL => 1);
1390 else {
1391 $smtp_server_port ||= 25;
1392 $smtp ||= Net::SMTP->new($smtp_server,
1393 Hello => $smtp_domain,
1394 Debug => $debug_net_smtp,
1395 Port => $smtp_server_port);
1396 if ($smtp_encryption eq 'tls' && $smtp) {
1397 if ($use_net_smtp_ssl) {
1398 $smtp->command('STARTTLS');
1399 $smtp->response();
1400 if ($smtp->code != 220) {
1401 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1403 require Net::SMTP::SSL;
1404 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1405 ssl_verify_params())
1406 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1408 else {
1409 $smtp->starttls(ssl_verify_params())
1410 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1412 $smtp_encryption = '';
1413 # Send EHLO again to receive fresh
1414 # supported commands
1415 $smtp->hello($smtp_domain);
1419 if (!$smtp) {
1420 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1421 " VALUES: server=$smtp_server ",
1422 "encryption=$smtp_encryption ",
1423 "hello=$smtp_domain",
1424 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1427 smtp_auth_maybe or die $smtp->message;
1429 $smtp->mail( $raw_from ) or die $smtp->message;
1430 $smtp->to( @recipients ) or die $smtp->message;
1431 $smtp->data or die $smtp->message;
1432 $smtp->datasend("$header\n") or die $smtp->message;
1433 my @lines = split /^/, $message;
1434 foreach my $line (@lines) {
1435 $smtp->datasend("$line") or die $smtp->message;
1437 $smtp->dataend() or die $smtp->message;
1438 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1440 if ($quiet) {
1441 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1442 } else {
1443 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1444 if (!file_name_is_absolute($smtp_server)) {
1445 print "Server: $smtp_server\n";
1446 print "MAIL FROM:<$raw_from>\n";
1447 foreach my $entry (@recipients) {
1448 print "RCPT TO:<$entry>\n";
1450 } else {
1451 print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n";
1453 print $header, "\n";
1454 if ($smtp) {
1455 print __("Result: "), $smtp->code, ' ',
1456 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1457 } else {
1458 print __("Result: OK\n");
1462 return 1;
1465 $reply_to = $initial_reply_to;
1466 $references = $initial_reply_to || '';
1467 $subject = $initial_subject;
1468 $message_num = 0;
1470 foreach my $t (@files) {
1471 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1473 my $author = undef;
1474 my $sauthor = undef;
1475 my $author_encoding;
1476 my $has_content_type;
1477 my $body_encoding;
1478 my $xfer_encoding;
1479 my $has_mime_version;
1480 @to = ();
1481 @cc = ();
1482 @xh = ();
1483 my $input_format = undef;
1484 my @header = ();
1485 $message = "";
1486 $message_num++;
1487 # First unfold multiline header fields
1488 while(<$fh>) {
1489 last if /^\s*$/;
1490 if (/^\s+\S/ and @header) {
1491 chomp($header[$#header]);
1492 s/^\s+/ /;
1493 $header[$#header] .= $_;
1494 } else {
1495 push(@header, $_);
1498 # Now parse the header
1499 foreach(@header) {
1500 if (/^From /) {
1501 $input_format = 'mbox';
1502 next;
1504 chomp;
1505 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1506 $input_format = 'mbox';
1509 if (defined $input_format && $input_format eq 'mbox') {
1510 if (/^Subject:\s+(.*)$/i) {
1511 $subject = $1;
1513 elsif (/^From:\s+(.*)$/i) {
1514 ($author, $author_encoding) = unquote_rfc2047($1);
1515 $sauthor = sanitize_address($author);
1516 next if $suppress_cc{'author'};
1517 next if $suppress_cc{'self'} and $sauthor eq $sender;
1518 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1519 $1, $_) unless $quiet;
1520 push @cc, $1;
1522 elsif (/^To:\s+(.*)$/i) {
1523 foreach my $addr (parse_address_line($1)) {
1524 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1525 $addr, $_) unless $quiet;
1526 push @to, $addr;
1529 elsif (/^Cc:\s+(.*)$/i) {
1530 foreach my $addr (parse_address_line($1)) {
1531 my $qaddr = unquote_rfc2047($addr);
1532 my $saddr = sanitize_address($qaddr);
1533 if ($saddr eq $sender) {
1534 next if ($suppress_cc{'self'});
1535 } else {
1536 next if ($suppress_cc{'cc'});
1538 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1539 $addr, $_) unless $quiet;
1540 push @cc, $addr;
1543 elsif (/^Content-type:/i) {
1544 $has_content_type = 1;
1545 if (/charset="?([^ "]+)/) {
1546 $body_encoding = $1;
1548 push @xh, $_;
1550 elsif (/^MIME-Version/i) {
1551 $has_mime_version = 1;
1552 push @xh, $_;
1554 elsif (/^Message-Id: (.*)/i) {
1555 $message_id = $1;
1557 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1558 $xfer_encoding = $1 if not defined $xfer_encoding;
1560 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1561 push @xh, $_;
1564 } else {
1565 # In the traditional
1566 # "send lots of email" format,
1567 # line 1 = cc
1568 # line 2 = subject
1569 # So let's support that, too.
1570 $input_format = 'lots';
1571 if (@cc == 0 && !$suppress_cc{'cc'}) {
1572 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1573 $_, $_) unless $quiet;
1574 push @cc, $_;
1575 } elsif (!defined $subject) {
1576 $subject = $_;
1580 # Now parse the message body
1581 while(<$fh>) {
1582 $message .= $_;
1583 if (/^(Signed-off-by|Cc): ([^>]*>?)/i) {
1584 chomp;
1585 my ($what, $c) = ($1, $2);
1586 chomp $c;
1587 my $sc = sanitize_address($c);
1588 if ($sc eq $sender) {
1589 next if ($suppress_cc{'self'});
1590 } else {
1591 next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i;
1592 next if $suppress_cc{'bodycc'} and $what =~ /Cc/i;
1594 push @cc, $c;
1595 printf(__("(body) Adding cc: %s from line '%s'\n"),
1596 $c, $_) unless $quiet;
1599 close $fh;
1601 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1602 if defined $to_cmd;
1603 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1604 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1606 if ($broken_encoding{$t} && !$has_content_type) {
1607 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1608 $has_content_type = 1;
1609 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1610 $body_encoding = $auto_8bit_encoding;
1613 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1614 $subject = quote_subject($subject, $auto_8bit_encoding);
1617 if (defined $sauthor and $sauthor ne $sender) {
1618 $message = "From: $author\n\n$message";
1619 if (defined $author_encoding) {
1620 if ($has_content_type) {
1621 if ($body_encoding eq $author_encoding) {
1622 # ok, we already have the right encoding
1624 else {
1625 # uh oh, we should re-encode
1628 else {
1629 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1630 $has_content_type = 1;
1631 push @xh,
1632 "Content-Type: text/plain; charset=$author_encoding";
1636 if (defined $target_xfer_encoding) {
1637 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1638 $message = apply_transfer_encoding(
1639 $message, $xfer_encoding, $target_xfer_encoding);
1640 $xfer_encoding = $target_xfer_encoding;
1642 if (defined $xfer_encoding) {
1643 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1645 if (defined $xfer_encoding or $has_content_type) {
1646 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1649 $needs_confirm = (
1650 $confirm eq "always" or
1651 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1652 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1653 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1655 @to = process_address_list(@to);
1656 @cc = process_address_list(@cc);
1658 @to = (@initial_to, @to);
1659 @cc = (@initial_cc, @cc);
1661 if ($message_num == 1) {
1662 if (defined $cover_cc and $cover_cc) {
1663 @initial_cc = @cc;
1665 if (defined $cover_to and $cover_to) {
1666 @initial_to = @to;
1670 my $message_was_sent = send_message();
1672 # set up for the next message
1673 if ($thread && $message_was_sent &&
1674 ($chain_reply_to || !defined $reply_to || length($reply_to) == 0 ||
1675 $message_num == 1)) {
1676 $reply_to = $message_id;
1677 if (length $references > 0) {
1678 $references .= "\n $message_id";
1679 } else {
1680 $references = "$message_id";
1683 $message_id = undef;
1686 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1687 # and return a results array
1688 sub recipients_cmd {
1689 my ($prefix, $what, $cmd, $file) = @_;
1691 my @addresses = ();
1692 open my $fh, "-|", "$cmd \Q$file\E"
1693 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1694 while (my $address = <$fh>) {
1695 $address =~ s/^\s*//g;
1696 $address =~ s/\s*$//g;
1697 $address = sanitize_address($address);
1698 next if ($address eq $sender and $suppress_cc{'self'});
1699 push @addresses, $address;
1700 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1701 $prefix, $what, $address, $cmd) unless $quiet;
1703 close $fh
1704 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1705 return @addresses;
1708 cleanup_compose_files();
1710 sub cleanup_compose_files {
1711 unlink($compose_filename, $compose_filename . ".final") if $compose;
1714 $smtp->quit if $smtp;
1716 sub apply_transfer_encoding {
1717 my $message = shift;
1718 my $from = shift;
1719 my $to = shift;
1721 return $message if ($from eq $to and $from ne '7bit');
1723 require MIME::QuotedPrint;
1724 require MIME::Base64;
1726 $message = MIME::QuotedPrint::decode($message)
1727 if ($from eq 'quoted-printable');
1728 $message = MIME::Base64::decode($message)
1729 if ($from eq 'base64');
1731 die __("cannot send message as 7bit")
1732 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
1733 return $message
1734 if ($to eq '7bit' or $to eq '8bit');
1735 return MIME::QuotedPrint::encode($message, "\n", 0)
1736 if ($to eq 'quoted-printable');
1737 return MIME::Base64::encode($message, "\n")
1738 if ($to eq 'base64');
1739 die __("invalid transfer encoding");
1742 sub unique_email_list {
1743 my %seen;
1744 my @emails;
1746 foreach my $entry (@_) {
1747 my $clean = extract_valid_address_or_die($entry);
1748 $seen{$clean} ||= 0;
1749 next if $seen{$clean}++;
1750 push @emails, $entry;
1752 return @emails;
1755 sub validate_patch {
1756 my $fn = shift;
1758 if ($repo) {
1759 my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
1760 'sendemail-validate');
1761 my $hook_error;
1762 if (-x $validate_hook) {
1763 my $target = abs_path($fn);
1764 # The hook needs a correct cwd and GIT_DIR.
1765 my $cwd_save = cwd();
1766 chdir($repo->wc_path() or $repo->repo_path())
1767 or die("chdir: $!");
1768 local $ENV{"GIT_DIR"} = $repo->repo_path();
1769 $hook_error = "rejected by sendemail-validate hook"
1770 if system($validate_hook, $target);
1771 chdir($cwd_save) or die("chdir: $!");
1773 return $hook_error if $hook_error;
1776 open(my $fh, '<', $fn)
1777 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1778 while (my $line = <$fh>) {
1779 if (length($line) > 998) {
1780 return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
1783 return;
1786 sub handle_backup {
1787 my ($last, $lastlen, $file, $known_suffix) = @_;
1788 my ($suffix, $skip);
1790 $skip = 0;
1791 if (defined $last &&
1792 ($lastlen < length($file)) &&
1793 (substr($file, 0, $lastlen) eq $last) &&
1794 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
1795 if (defined $known_suffix && $suffix eq $known_suffix) {
1796 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
1797 $skip = 1;
1798 } else {
1799 # TRANSLATORS: please keep "[y|N]" as is.
1800 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
1801 valid_re => qr/^(?:y|n)/i,
1802 default => 'n');
1803 $skip = ($answer ne 'y');
1804 if ($skip) {
1805 $known_suffix = $suffix;
1809 return ($skip, $known_suffix);
1812 sub handle_backup_files {
1813 my @file = @_;
1814 my ($last, $lastlen, $known_suffix, $skip, @result);
1815 for my $file (@file) {
1816 ($skip, $known_suffix) = handle_backup($last, $lastlen,
1817 $file, $known_suffix);
1818 push @result, $file unless $skip;
1819 $last = $file;
1820 $lastlen = length($file);
1822 return @result;
1825 sub file_has_nonascii {
1826 my $fn = shift;
1827 open(my $fh, '<', $fn)
1828 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1829 while (my $line = <$fh>) {
1830 return 1 if $line =~ /[^[:ascii:]]/;
1832 return 0;
1835 sub body_or_subject_has_nonascii {
1836 my $fn = shift;
1837 open(my $fh, '<', $fn)
1838 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
1839 while (my $line = <$fh>) {
1840 last if $line =~ /^$/;
1841 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
1843 while (my $line = <$fh>) {
1844 return 1 if $line =~ /[^[:ascii:]]/;
1846 return 0;