Merge branch 'master' of github.com:git/git
[alt-git.git] / git-send-email.perl
blob5262d88ee32073f83bbb0c18c3386b6a3db12cd8
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 $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
22 use Getopt::Long;
23 use Git::LoadCPAN::Error qw(:try);
24 use Git;
25 use Git::I18N;
27 Getopt::Long::Configure qw/ pass_through /;
29 package FakeTerm;
30 sub new {
31 my ($class, $reason) = @_;
32 return bless \$reason, shift;
34 sub readline {
35 my $self = shift;
36 die "Cannot use readline on FakeTerm: $$self";
38 package main;
41 sub usage {
42 print <<EOT;
43 git send-email [options] <file | directory | rev-list options >
44 git send-email --dump-aliases
46 Composing:
47 --from <str> * Email From:
48 --[no-]to <str> * Email To:
49 --[no-]cc <str> * Email Cc:
50 --[no-]bcc <str> * Email Bcc:
51 --subject <str> * Email "Subject:"
52 --reply-to <str> * Email "Reply-To:"
53 --in-reply-to <str> * Email "In-Reply-To:"
54 --[no-]xmailer * Add "X-Mailer:" header (default).
55 --[no-]annotate * Review each patch that will be sent in an editor.
56 --compose * Open an editor for introduction.
57 --compose-encoding <str> * Encoding to assume for introduction.
58 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
59 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
61 Sending:
62 --envelope-sender <str> * Email envelope sender.
63 --sendmail-cmd <str> * Command to run to send email.
64 --smtp-server <str:int> * Outgoing SMTP server to use. The port
65 is optional. Default 'localhost'.
66 --smtp-server-option <str> * Outgoing SMTP server option to use.
67 --smtp-server-port <int> * Outgoing SMTP server port.
68 --smtp-user <str> * Username for SMTP-AUTH.
69 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
70 --smtp-encryption <str> * tls or ssl; anything else disables.
71 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
72 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
73 Pass an empty string to disable certificate
74 verification.
75 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
76 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms, or
77 "none" to disable authentication.
78 This setting forces to use one of the listed mechanisms.
79 --no-smtp-auth Disable SMTP authentication. Shorthand for
80 `--smtp-auth=none`
81 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
83 --batch-size <int> * send max <int> message per connection.
84 --relogin-delay <int> * delay <int> seconds between two successive login.
85 This option can only be used with --batch-size
87 Automating:
88 --identity <str> * Use the sendemail.<id> options.
89 --to-cmd <str> * Email To: via `<str> \$patch_path`
90 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`
91 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, misc-by, all.
92 --[no-]cc-cover * Email Cc: addresses in the cover letter.
93 --[no-]to-cover * Email To: addresses in the cover letter.
94 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
95 --[no-]suppress-from * Send to self. Default off.
96 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
97 --[no-]thread * Use In-Reply-To: field. Default on.
99 Administering:
100 --confirm <str> * Confirm recipients before sending;
101 auto, cc, compose, always, or never.
102 --quiet * Output one line of info per email.
103 --dry-run * Don't actually send the emails.
104 --[no-]validate * Perform patch sanity checks. Default on.
105 --[no-]format-patch * understand any non optional arguments as
106 `git format-patch` ones.
107 --force * Send even if safety checks would prevent it.
109 Information:
110 --dump-aliases * Dump configured aliases and exit.
113 exit(1);
116 sub completion_helper {
117 print Git::command('format-patch', '--git-completion-helper');
118 exit(0);
121 # most mail servers generate the Date: header, but not all...
122 sub format_2822_time {
123 my ($time) = @_;
124 my @localtm = localtime($time);
125 my @gmttm = gmtime($time);
126 my $localmin = $localtm[1] + $localtm[2] * 60;
127 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
128 if ($localtm[0] != $gmttm[0]) {
129 die __("local zone differs from GMT by a non-minute interval\n");
131 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
132 $localmin += 1440;
133 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
134 $localmin -= 1440;
135 } elsif ($gmttm[6] != $localtm[6]) {
136 die __("local time offset greater than or equal to 24 hours\n");
138 my $offset = $localmin - $gmtmin;
139 my $offhour = $offset / 60;
140 my $offmin = abs($offset % 60);
141 if (abs($offhour) >= 24) {
142 die __("local time offset greater than or equal to 24 hours\n");
145 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
146 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
147 $localtm[3],
148 qw(Jan Feb Mar Apr May Jun
149 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
150 $localtm[5]+1900,
151 $localtm[2],
152 $localtm[1],
153 $localtm[0],
154 ($offset >= 0) ? '+' : '-',
155 abs($offhour),
156 $offmin,
160 my $smtp;
161 my $auth;
162 my $num_sent = 0;
164 # Regexes for RFC 2047 productions.
165 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
166 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
167 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
169 # Variables we fill in automatically, or via prompting:
170 my (@to,@cc,@xh,$envelope_sender,
171 $initial_in_reply_to,$reply_to,$initial_subject,@files,
172 $author,$sender,$smtp_authpass,$annotate,$compose,$time);
173 # Things we either get from config, *or* are overridden on the
174 # command-line.
175 my ($no_cc, $no_to, $no_bcc, $no_identity);
176 my (@config_to, @getopt_to);
177 my (@config_cc, @getopt_cc);
178 my (@config_bcc, @getopt_bcc);
180 # Example reply to:
181 #$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
183 my $repo = eval { Git->repository() };
184 my @repo = $repo ? ($repo) : ();
186 # Behavior modification variables
187 my ($quiet, $dry_run) = (0, 0);
188 my $format_patch;
189 my $compose_filename;
190 my $force = 0;
191 my $dump_aliases = 0;
193 # Handle interactive edition of files.
194 my $multiedit;
195 my $editor;
197 sub system_or_msg {
198 my ($args, $msg) = @_;
199 system(@$args);
200 my $signalled = $? & 127;
201 my $exit_code = $? >> 8;
202 return unless $signalled or $exit_code;
204 my @sprintf_args = ($args->[0], $exit_code);
205 if (defined $msg) {
206 # Quiet the 'redundant' warning category, except we
207 # need to support down to Perl 5.8, so we can't do a
208 # "no warnings 'redundant'", since that category was
209 # introduced in perl 5.22, and asking for it will die
210 # on older perls.
211 no warnings;
212 return sprintf($msg, @sprintf_args);
214 return sprintf(__("fatal: command '%s' died with exit code %d"),
215 @sprintf_args);
218 sub system_or_die {
219 my $msg = system_or_msg(@_);
220 die $msg if $msg;
223 sub do_edit {
224 if (!defined($editor)) {
225 $editor = Git::command_oneline('var', 'GIT_EDITOR');
227 my $die_msg = __("the editor exited uncleanly, aborting everything");
228 if (defined($multiedit) && !$multiedit) {
229 system_or_die(['sh', '-c', $editor.' "$@"', $editor, $_], $die_msg) for @_;
230 } else {
231 system_or_die(['sh', '-c', $editor.' "$@"', $editor, @_], $die_msg);
235 # Variables with corresponding config settings
236 my ($suppress_from, $signed_off_by_cc);
237 my ($cover_cc, $cover_to);
238 my ($to_cmd, $cc_cmd);
239 my ($smtp_server, $smtp_server_port, @smtp_server_options);
240 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
241 my ($batch_size, $relogin_delay);
242 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
243 my ($confirm);
244 my (@suppress_cc);
245 my ($auto_8bit_encoding);
246 my ($compose_encoding);
247 my ($sendmail_cmd);
248 # Variables with corresponding config settings & hardcoded defaults
249 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
250 my $thread = 1;
251 my $chain_reply_to = 0;
252 my $use_xmailer = 1;
253 my $validate = 1;
254 my $target_xfer_encoding = 'auto';
255 my $forbid_sendmail_variables = 1;
257 my %config_bool_settings = (
258 "thread" => \$thread,
259 "chainreplyto" => \$chain_reply_to,
260 "suppressfrom" => \$suppress_from,
261 "signedoffbycc" => \$signed_off_by_cc,
262 "cccover" => \$cover_cc,
263 "tocover" => \$cover_to,
264 "signedoffcc" => \$signed_off_by_cc,
265 "validate" => \$validate,
266 "multiedit" => \$multiedit,
267 "annotate" => \$annotate,
268 "xmailer" => \$use_xmailer,
269 "forbidsendmailvariables" => \$forbid_sendmail_variables,
272 my %config_settings = (
273 "smtpencryption" => \$smtp_encryption,
274 "smtpserver" => \$smtp_server,
275 "smtpserverport" => \$smtp_server_port,
276 "smtpserveroption" => \@smtp_server_options,
277 "smtpuser" => \$smtp_authuser,
278 "smtppass" => \$smtp_authpass,
279 "smtpdomain" => \$smtp_domain,
280 "smtpauth" => \$smtp_auth,
281 "smtpbatchsize" => \$batch_size,
282 "smtprelogindelay" => \$relogin_delay,
283 "to" => \@config_to,
284 "tocmd" => \$to_cmd,
285 "cc" => \@config_cc,
286 "cccmd" => \$cc_cmd,
287 "aliasfiletype" => \$aliasfiletype,
288 "bcc" => \@config_bcc,
289 "suppresscc" => \@suppress_cc,
290 "envelopesender" => \$envelope_sender,
291 "confirm" => \$confirm,
292 "from" => \$sender,
293 "assume8bitencoding" => \$auto_8bit_encoding,
294 "composeencoding" => \$compose_encoding,
295 "transferencoding" => \$target_xfer_encoding,
296 "sendmailcmd" => \$sendmail_cmd,
299 my %config_path_settings = (
300 "aliasesfile" => \@alias_files,
301 "smtpsslcertpath" => \$smtp_ssl_cert_path,
304 # Handle Uncouth Termination
305 sub signal_handler {
306 # Make text normal
307 require Term::ANSIColor;
308 print Term::ANSIColor::color("reset"), "\n";
310 # SMTP password masked
311 system "stty echo";
313 # tmp files from --compose
314 if (defined $compose_filename) {
315 if (-e $compose_filename) {
316 printf __("'%s' contains an intermediate version ".
317 "of the email you were composing.\n"),
318 $compose_filename;
320 if (-e ($compose_filename . ".final")) {
321 printf __("'%s.final' contains the composed email.\n"),
322 $compose_filename;
326 exit;
329 $SIG{TERM} = \&signal_handler;
330 $SIG{INT} = \&signal_handler;
332 # Read our sendemail.* config
333 sub read_config {
334 my ($known_keys, $configured, $prefix) = @_;
336 foreach my $setting (keys %config_bool_settings) {
337 my $target = $config_bool_settings{$setting};
338 my $key = "$prefix.$setting";
339 next unless exists $known_keys->{$key};
340 my $v = (@{$known_keys->{$key}} == 1 &&
341 (defined $known_keys->{$key}->[0] &&
342 $known_keys->{$key}->[0] =~ /^(?:true|false)$/s))
343 ? $known_keys->{$key}->[0] eq 'true'
344 : Git::config_bool(@repo, $key);
345 next unless defined $v;
346 next if $configured->{$setting}++;
347 $$target = $v;
350 foreach my $setting (keys %config_path_settings) {
351 my $target = $config_path_settings{$setting};
352 my $key = "$prefix.$setting";
353 next unless exists $known_keys->{$key};
354 if (ref($target) eq "ARRAY") {
355 my @values = Git::config_path(@repo, $key);
356 next unless @values;
357 next if $configured->{$setting}++;
358 @$target = @values;
360 else {
361 my $v = Git::config_path(@repo, "$prefix.$setting");
362 next unless defined $v;
363 next if $configured->{$setting}++;
364 $$target = $v;
368 foreach my $setting (keys %config_settings) {
369 my $target = $config_settings{$setting};
370 my $key = "$prefix.$setting";
371 next unless exists $known_keys->{$key};
372 if (ref($target) eq "ARRAY") {
373 my @values = @{$known_keys->{$key}};
374 @values = grep { defined } @values;
375 next if $configured->{$setting}++;
376 @$target = @values;
378 else {
379 my $v = $known_keys->{$key}->[-1];
380 next unless defined $v;
381 next if $configured->{$setting}++;
382 $$target = $v;
387 sub config_regexp {
388 my ($regex) = @_;
389 my @ret;
390 eval {
391 my $ret = Git::command(
392 'config',
393 '--null',
394 '--get-regexp',
395 $regex,
397 @ret = map {
398 # We must always return ($k, $v) here, since
399 # empty config values will be just "key\0",
400 # not "key\nvalue\0".
401 my ($k, $v) = split /\n/, $_, 2;
402 ($k, $v);
403 } split /\0/, $ret;
405 } or do {
406 # If we have no keys we're OK, otherwise re-throw
407 die $@ if $@->value != 1;
409 return @ret;
412 # Save ourselves a lot of work of shelling out to 'git config' (it
413 # parses 'bool' etc.) by only doing so for config keys that exist.
414 my %known_config_keys;
416 my @kv = config_regexp("^sende?mail[.]");
417 while (my ($k, $v) = splice @kv, 0, 2) {
418 push @{$known_config_keys{$k}} => $v;
422 # sendemail.identity yields to --identity. We must parse this
423 # special-case first before the rest of the config is read.
425 my $key = "sendemail.identity";
426 $identity = Git::config(@repo, $key) if exists $known_config_keys{$key};
428 my $rc = GetOptions(
429 "identity=s" => \$identity,
430 "no-identity" => \$no_identity,
432 usage() unless $rc;
433 undef $identity if $no_identity;
435 # Now we know enough to read the config
437 my %configured;
438 read_config(\%known_config_keys, \%configured, "sendemail.$identity") if defined $identity;
439 read_config(\%known_config_keys, \%configured, "sendemail");
442 # Begin by accumulating all the variables (defined above), that we will end up
443 # needing, first, from the command line:
445 my $help;
446 my $git_completion_helper;
447 $rc = GetOptions("h" => \$help,
448 "dump-aliases" => \$dump_aliases);
449 usage() unless $rc;
450 die __("--dump-aliases incompatible with other options\n")
451 if !$help and $dump_aliases and @ARGV;
452 $rc = GetOptions(
453 "sender|from=s" => \$sender,
454 "in-reply-to=s" => \$initial_in_reply_to,
455 "reply-to=s" => \$reply_to,
456 "subject=s" => \$initial_subject,
457 "to=s" => \@getopt_to,
458 "to-cmd=s" => \$to_cmd,
459 "no-to" => \$no_to,
460 "cc=s" => \@getopt_cc,
461 "no-cc" => \$no_cc,
462 "bcc=s" => \@getopt_bcc,
463 "no-bcc" => \$no_bcc,
464 "chain-reply-to!" => \$chain_reply_to,
465 "no-chain-reply-to" => sub {$chain_reply_to = 0},
466 "sendmail-cmd=s" => \$sendmail_cmd,
467 "smtp-server=s" => \$smtp_server,
468 "smtp-server-option=s" => \@smtp_server_options,
469 "smtp-server-port=s" => \$smtp_server_port,
470 "smtp-user=s" => \$smtp_authuser,
471 "smtp-pass:s" => \$smtp_authpass,
472 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
473 "smtp-encryption=s" => \$smtp_encryption,
474 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
475 "smtp-debug:i" => \$debug_net_smtp,
476 "smtp-domain:s" => \$smtp_domain,
477 "smtp-auth=s" => \$smtp_auth,
478 "no-smtp-auth" => sub {$smtp_auth = 'none'},
479 "annotate!" => \$annotate,
480 "no-annotate" => sub {$annotate = 0},
481 "compose" => \$compose,
482 "quiet" => \$quiet,
483 "cc-cmd=s" => \$cc_cmd,
484 "suppress-from!" => \$suppress_from,
485 "no-suppress-from" => sub {$suppress_from = 0},
486 "suppress-cc=s" => \@suppress_cc,
487 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
488 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
489 "cc-cover|cc-cover!" => \$cover_cc,
490 "no-cc-cover" => sub {$cover_cc = 0},
491 "to-cover|to-cover!" => \$cover_to,
492 "no-to-cover" => sub {$cover_to = 0},
493 "confirm=s" => \$confirm,
494 "dry-run" => \$dry_run,
495 "envelope-sender=s" => \$envelope_sender,
496 "thread!" => \$thread,
497 "no-thread" => sub {$thread = 0},
498 "validate!" => \$validate,
499 "no-validate" => sub {$validate = 0},
500 "transfer-encoding=s" => \$target_xfer_encoding,
501 "format-patch!" => \$format_patch,
502 "no-format-patch" => sub {$format_patch = 0},
503 "8bit-encoding=s" => \$auto_8bit_encoding,
504 "compose-encoding=s" => \$compose_encoding,
505 "force" => \$force,
506 "xmailer!" => \$use_xmailer,
507 "no-xmailer" => sub {$use_xmailer = 0},
508 "batch-size=i" => \$batch_size,
509 "relogin-delay=i" => \$relogin_delay,
510 "git-completion-helper" => \$git_completion_helper,
513 # Munge any "either config or getopt, not both" variables
514 my @initial_to = @getopt_to ? @getopt_to : ($no_to ? () : @config_to);
515 my @initial_cc = @getopt_cc ? @getopt_cc : ($no_cc ? () : @config_cc);
516 my @initial_bcc = @getopt_bcc ? @getopt_bcc : ($no_bcc ? () : @config_bcc);
518 usage() if $help;
519 completion_helper() if $git_completion_helper;
520 unless ($rc) {
521 usage();
524 if ($forbid_sendmail_variables && grep { /^sendmail/s } keys %known_config_keys) {
525 die __("fatal: found configuration options for 'sendmail'\n" .
526 "git-send-email is configured with the sendemail.* options - note the 'e'.\n" .
527 "Set sendemail.forbidSendmailVariables to false to disable this check.\n");
530 die __("Cannot run git format-patch from outside a repository\n")
531 if $format_patch and not $repo;
533 die __("`batch-size` and `relogin` must be specified together " .
534 "(via command-line or configuration option)\n")
535 if defined $relogin_delay and not defined $batch_size;
537 # 'default' encryption is none -- this only prevents a warning
538 $smtp_encryption = '' unless (defined $smtp_encryption);
540 # Set CC suppressions
541 my(%suppress_cc);
542 if (@suppress_cc) {
543 foreach my $entry (@suppress_cc) {
544 # Please update $__git_send_email_suppresscc_options
545 # in git-completion.bash when you add new options.
546 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
547 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc|misc-by)$/;
548 $suppress_cc{$entry} = 1;
552 if ($suppress_cc{'all'}) {
553 foreach my $entry (qw (cccmd cc author self sob body bodycc misc-by)) {
554 $suppress_cc{$entry} = 1;
556 delete $suppress_cc{'all'};
559 # If explicit old-style ones are specified, they trump --suppress-cc.
560 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
561 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
563 if ($suppress_cc{'body'}) {
564 foreach my $entry (qw (sob bodycc misc-by)) {
565 $suppress_cc{$entry} = 1;
567 delete $suppress_cc{'body'};
570 # Set confirm's default value
571 my $confirm_unconfigured = !defined $confirm;
572 if ($confirm_unconfigured) {
573 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
575 # Please update $__git_send_email_confirm_options in
576 # git-completion.bash when you add new options.
577 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
578 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
580 # Debugging, print out the suppressions.
581 if (0) {
582 print "suppressions:\n";
583 foreach my $entry (keys %suppress_cc) {
584 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
588 my ($repoauthor, $repocommitter);
590 my %cache;
591 my ($author, $committer);
592 my $common = sub {
593 my ($what) = @_;
594 return $cache{$what} if exists $cache{$what};
595 ($cache{$what}) = Git::ident_person(@repo, $what);
596 return $cache{$what};
598 $repoauthor = sub { $common->('author') };
599 $repocommitter = sub { $common->('committer') };
602 sub parse_address_line {
603 require Git::LoadCPAN::Mail::Address;
604 return map { $_->format } Mail::Address->parse($_[0]);
607 sub split_addrs {
608 require Text::ParseWords;
609 return Text::ParseWords::quotewords('\s*,\s*', 1, @_);
612 my %aliases;
614 sub parse_sendmail_alias {
615 local $_ = shift;
616 if (/"/) {
617 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
618 } elsif (/:include:/) {
619 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
620 } elsif (/[\/|]/) {
621 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
622 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
623 my ($alias, $addr) = ($1, $2);
624 $aliases{$alias} = [ split_addrs($addr) ];
625 } else {
626 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
630 sub parse_sendmail_aliases {
631 my $fh = shift;
632 my $s = '';
633 while (<$fh>) {
634 chomp;
635 next if /^\s*$/ || /^\s*#/;
636 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
637 parse_sendmail_alias($s) if $s;
638 $s = $_;
640 $s =~ s/\\$//; # silently tolerate stray '\' on last line
641 parse_sendmail_alias($s) if $s;
644 my %parse_alias = (
645 # multiline formats can be supported in the future
646 mutt => sub { my $fh = shift; while (<$fh>) {
647 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
648 my ($alias, $addr) = ($1, $2);
649 $addr =~ s/#.*$//; # mutt allows # comments
650 # commas delimit multiple addresses
651 my @addr = split_addrs($addr);
653 # quotes may be escaped in the file,
654 # unescape them so we do not double-escape them later.
655 s/\\"/"/g foreach @addr;
656 $aliases{$alias} = \@addr
657 }}},
658 mailrc => sub { my $fh = shift; while (<$fh>) {
659 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
660 require Text::ParseWords;
661 # spaces delimit multiple addresses
662 $aliases{$1} = [ Text::ParseWords::quotewords('\s+', 0, $2) ];
663 }}},
664 pine => sub { my $fh = shift; my $f='\t[^\t]*';
665 for (my $x = ''; defined($x); $x = $_) {
666 chomp $x;
667 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
668 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
669 $aliases{$1} = [ split_addrs($2) ];
671 elm => sub { my $fh = shift;
672 while (<$fh>) {
673 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
674 my ($alias, $addr) = ($1, $2);
675 $aliases{$alias} = [ split_addrs($addr) ];
677 } },
678 sendmail => \&parse_sendmail_aliases,
679 gnus => sub { my $fh = shift; while (<$fh>) {
680 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
681 $aliases{$1} = [ $2 ];
683 # Please update _git_config() in git-completion.bash when you
684 # add new MUAs.
687 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
688 foreach my $file (@alias_files) {
689 open my $fh, '<', $file or die "opening $file: $!\n";
690 $parse_alias{$aliasfiletype}->($fh);
691 close $fh;
695 if ($dump_aliases) {
696 print "$_\n" for (sort keys %aliases);
697 exit(0);
700 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
701 # $f is a revision list specification to be passed to format-patch.
702 sub is_format_patch_arg {
703 return unless $repo;
704 my $f = shift;
705 try {
706 $repo->command('rev-parse', '--verify', '--quiet', $f);
707 if (defined($format_patch)) {
708 return $format_patch;
710 die sprintf(__(<<EOF), $f, $f);
711 File '%s' exists but it could also be the range of commits
712 to produce patches for. Please disambiguate by...
714 * Saying "./%s" if you mean a file; or
715 * Giving --format-patch option if you mean a range.
717 } catch Git::Error::Command with {
718 # Not a valid revision. Treat it as a filename.
719 return 0;
723 # Now that all the defaults are set, process the rest of the command line
724 # arguments and collect up the files that need to be processed.
725 my @rev_list_opts;
726 while (defined(my $f = shift @ARGV)) {
727 if ($f eq "--") {
728 push @rev_list_opts, "--", @ARGV;
729 @ARGV = ();
730 } elsif (-d $f and !is_format_patch_arg($f)) {
731 opendir my $dh, $f
732 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
734 require File::Spec;
735 push @files, grep { -f $_ } map { File::Spec->catfile($f, $_) }
736 sort readdir $dh;
737 closedir $dh;
738 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
739 push @files, $f;
740 } else {
741 push @rev_list_opts, $f;
745 if (@rev_list_opts) {
746 die __("Cannot run git format-patch from outside a repository\n")
747 unless $repo;
748 require File::Temp;
749 push @files, $repo->command('format-patch', '-o', File::Temp::tempdir(CLEANUP => 1), @rev_list_opts);
752 @files = handle_backup_files(@files);
754 if ($validate) {
755 foreach my $f (@files) {
756 unless (-p $f) {
757 validate_patch($f, $target_xfer_encoding);
762 if (@files) {
763 unless ($quiet) {
764 print $_,"\n" for (@files);
766 } else {
767 print STDERR __("\nNo patch files specified!\n\n");
768 usage();
771 sub get_patch_subject {
772 my $fn = shift;
773 open (my $fh, '<', $fn);
774 while (my $line = <$fh>) {
775 next unless ($line =~ /^Subject: (.*)$/);
776 close $fh;
777 return "GIT: $1\n";
779 close $fh;
780 die sprintf(__("No subject line in %s?"), $fn);
783 if ($compose) {
784 # Note that this does not need to be secure, but we will make a small
785 # effort to have it be unique
786 require File::Temp;
787 $compose_filename = ($repo ?
788 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
789 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
790 open my $c, ">", $compose_filename
791 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
794 my $tpl_sender = $sender || $repoauthor->() || $repocommitter->() || '';
795 my $tpl_subject = $initial_subject || '';
796 my $tpl_in_reply_to = $initial_in_reply_to || '';
797 my $tpl_reply_to = $reply_to || '';
799 print $c <<EOT1, Git::prefix_lines("GIT: ", __(<<EOT2)), <<EOT3;
800 From $tpl_sender # This line is ignored.
801 EOT1
802 Lines beginning in "GIT:" will be removed.
803 Consider including an overall diffstat or table of contents
804 for the patch you are writing.
806 Clear the body content if you don't wish to send a summary.
807 EOT2
808 From: $tpl_sender
809 Reply-To: $tpl_reply_to
810 Subject: $tpl_subject
811 In-Reply-To: $tpl_in_reply_to
813 EOT3
814 for my $f (@files) {
815 print $c get_patch_subject($f);
817 close $c;
819 if ($annotate) {
820 do_edit($compose_filename, @files);
821 } else {
822 do_edit($compose_filename);
825 open $c, "<", $compose_filename
826 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
828 if (!defined $compose_encoding) {
829 $compose_encoding = "UTF-8";
832 my %parsed_email;
833 while (my $line = <$c>) {
834 next if $line =~ m/^GIT:/;
835 parse_header_line($line, \%parsed_email);
836 if ($line =~ /^$/) {
837 $parsed_email{'body'} = filter_body($c);
840 close $c;
842 open my $c2, ">", $compose_filename . ".final"
843 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
846 if ($parsed_email{'From'}) {
847 $sender = delete($parsed_email{'From'});
849 if ($parsed_email{'In-Reply-To'}) {
850 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
852 if ($parsed_email{'Reply-To'}) {
853 $reply_to = delete($parsed_email{'Reply-To'});
855 if ($parsed_email{'Subject'}) {
856 $initial_subject = delete($parsed_email{'Subject'});
857 print $c2 "Subject: " .
858 quote_subject($initial_subject, $compose_encoding) .
859 "\n";
862 if ($parsed_email{'MIME-Version'}) {
863 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
864 "Content-Type: $parsed_email{'Content-Type'};\n",
865 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
866 delete($parsed_email{'MIME-Version'});
867 delete($parsed_email{'Content-Type'});
868 delete($parsed_email{'Content-Transfer-Encoding'});
869 } elsif (file_has_nonascii($compose_filename)) {
870 my $content_type = (delete($parsed_email{'Content-Type'}) or
871 "text/plain; charset=$compose_encoding");
872 print $c2 "MIME-Version: 1.0\n",
873 "Content-Type: $content_type\n",
874 "Content-Transfer-Encoding: 8bit\n";
876 # Preserve unknown headers
877 foreach my $key (keys %parsed_email) {
878 next if $key eq 'body';
879 print $c2 "$key: $parsed_email{$key}";
882 if ($parsed_email{'body'}) {
883 print $c2 "\n$parsed_email{'body'}\n";
884 delete($parsed_email{'body'});
885 } else {
886 print __("Summary email is empty, skipping it\n");
887 $compose = -1;
890 close $c2;
892 } elsif ($annotate) {
893 do_edit(@files);
896 sub term {
897 my $term = eval {
898 require Term::ReadLine;
899 $ENV{"GIT_SEND_EMAIL_NOTTY"}
900 ? Term::ReadLine->new('git-send-email', \*STDIN, \*STDOUT)
901 : Term::ReadLine->new('git-send-email');
903 if ($@) {
904 $term = FakeTerm->new("$@: going non-interactive");
906 return $term;
909 sub ask {
910 my ($prompt, %arg) = @_;
911 my $valid_re = $arg{valid_re};
912 my $default = $arg{default};
913 my $confirm_only = $arg{confirm_only};
914 my $resp;
915 my $i = 0;
916 my $term = term();
917 return defined $default ? $default : undef
918 unless defined $term->IN and defined fileno($term->IN) and
919 defined $term->OUT and defined fileno($term->OUT);
920 while ($i++ < 10) {
921 $resp = $term->readline($prompt);
922 if (!defined $resp) { # EOF
923 print "\n";
924 return defined $default ? $default : undef;
926 if ($resp eq '' and defined $default) {
927 return $default;
929 if (!defined $valid_re or $resp =~ /$valid_re/) {
930 return $resp;
932 if ($confirm_only) {
933 my $yesno = $term->readline(
934 # TRANSLATORS: please keep [y/N] as is.
935 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
936 if (defined $yesno && $yesno =~ /y/i) {
937 return $resp;
941 return;
944 sub parse_header_line {
945 my $lines = shift;
946 my $parsed_line = shift;
947 my $addr_pat = join "|", qw(To Cc Bcc);
949 foreach (split(/\n/, $lines)) {
950 if (/^($addr_pat):\s*(.+)$/i) {
951 $parsed_line->{$1} = [ parse_address_line($2) ];
952 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
953 $parsed_line->{$1} = $2;
958 sub filter_body {
959 my $c = shift;
960 my $body = "";
961 while (my $body_line = <$c>) {
962 if ($body_line !~ m/^GIT:/) {
963 $body .= $body_line;
966 return $body;
970 my %broken_encoding;
972 sub file_declares_8bit_cte {
973 my $fn = shift;
974 open (my $fh, '<', $fn);
975 while (my $line = <$fh>) {
976 last if ($line =~ /^$/);
977 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
979 close $fh;
980 return 0;
983 foreach my $f (@files) {
984 next unless (body_or_subject_has_nonascii($f)
985 && !file_declares_8bit_cte($f));
986 $broken_encoding{$f} = 1;
989 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
990 print __("The following files are 8bit, but do not declare " .
991 "a Content-Transfer-Encoding.\n");
992 foreach my $f (sort keys %broken_encoding) {
993 print " $f\n";
995 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
996 valid_re => qr/.{4}/, confirm_only => 1,
997 default => "UTF-8");
1000 if (!$force) {
1001 for my $f (@files) {
1002 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
1003 die sprintf(__("Refusing to send because the patch\n\t%s\n"
1004 . "has the template subject '*** SUBJECT HERE ***'. "
1005 . "Pass --force if you really want to send.\n"), $f);
1010 if (defined $sender) {
1011 $sender =~ s/^\s+|\s+$//g;
1012 ($sender) = expand_aliases($sender);
1013 } else {
1014 $sender = $repoauthor->() || $repocommitter->() || '';
1017 # $sender could be an already sanitized address
1018 # (e.g. sendemail.from could be manually sanitized by user).
1019 # But it's a no-op to run sanitize_address on an already sanitized address.
1020 $sender = sanitize_address($sender);
1022 my $to_whom = __("To whom should the emails be sent (if anyone)?");
1023 my $prompting = 0;
1024 if (!@initial_to && !defined $to_cmd) {
1025 my $to = ask("$to_whom ",
1026 default => "",
1027 valid_re => qr/\@.*\./, confirm_only => 1);
1028 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
1029 $prompting++;
1032 sub expand_aliases {
1033 return map { expand_one_alias($_) } @_;
1036 my %EXPANDED_ALIASES;
1037 sub expand_one_alias {
1038 my $alias = shift;
1039 if ($EXPANDED_ALIASES{$alias}) {
1040 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
1042 local $EXPANDED_ALIASES{$alias} = 1;
1043 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
1046 @initial_to = process_address_list(@initial_to);
1047 @initial_cc = process_address_list(@initial_cc);
1048 @initial_bcc = process_address_list(@initial_bcc);
1050 if ($thread && !defined $initial_in_reply_to && $prompting) {
1051 $initial_in_reply_to = ask(
1052 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
1053 default => "",
1054 valid_re => qr/\@.*\./, confirm_only => 1);
1056 if (defined $initial_in_reply_to) {
1057 $initial_in_reply_to =~ s/^\s*<?//;
1058 $initial_in_reply_to =~ s/>?\s*$//;
1059 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
1062 if (defined $reply_to) {
1063 $reply_to =~ s/^\s+|\s+$//g;
1064 ($reply_to) = expand_aliases($reply_to);
1065 $reply_to = sanitize_address($reply_to);
1068 if (!defined $sendmail_cmd && !defined $smtp_server) {
1069 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1070 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
1071 foreach (@sendmail_paths) {
1072 if (-x $_) {
1073 $sendmail_cmd = $_;
1074 last;
1078 if (!defined $sendmail_cmd) {
1079 $smtp_server = 'localhost'; # could be 127.0.0.1, too... *shrug*
1083 if ($compose && $compose > 0) {
1084 @files = ($compose_filename . ".final", @files);
1087 # Variables we set as part of the loop over files
1088 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
1089 $needs_confirm, $message_num, $ask_default);
1091 sub extract_valid_address {
1092 my $address = shift;
1093 my $local_part_regexp = qr/[^<>"\s@]+/;
1094 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
1096 # check for a local address:
1097 return $address if ($address =~ /^($local_part_regexp)$/);
1099 $address =~ s/^\s*<(.*)>\s*$/$1/;
1100 my $have_email_valid = eval { require Email::Valid; 1 };
1101 if ($have_email_valid) {
1102 return scalar Email::Valid->address($address);
1105 # less robust/correct than the monster regexp in Email::Valid,
1106 # but still does a 99% job, and one less dependency
1107 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1108 return;
1111 sub extract_valid_address_or_die {
1112 my $address = shift;
1113 $address = extract_valid_address($address);
1114 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1115 if !$address;
1116 return $address;
1119 sub validate_address {
1120 my $address = shift;
1121 while (!extract_valid_address($address)) {
1122 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1123 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1124 # translation. The program will only accept English input
1125 # at this point.
1126 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1127 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1128 default => 'q');
1129 if (/^d/i) {
1130 return undef;
1131 } elsif (/^q/i) {
1132 cleanup_compose_files();
1133 exit(0);
1135 $address = ask("$to_whom ",
1136 default => "",
1137 valid_re => qr/\@.*\./, confirm_only => 1);
1139 return $address;
1142 sub validate_address_list {
1143 return (grep { defined $_ }
1144 map { validate_address($_) } @_);
1147 # Usually don't need to change anything below here.
1149 # we make a "fake" message id by taking the current number
1150 # of seconds since the beginning of Unix time and tacking on
1151 # a random number to the end, in case we are called quicker than
1152 # 1 second since the last time we were called.
1154 # We'll setup a template for the message id, using the "from" address:
1156 my ($message_id_stamp, $message_id_serial);
1157 sub make_message_id {
1158 my $uniq;
1159 if (!defined $message_id_stamp) {
1160 require POSIX;
1161 $message_id_stamp = POSIX::strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1162 $message_id_serial = 0;
1164 $message_id_serial++;
1165 $uniq = "$message_id_stamp-$message_id_serial";
1167 my $du_part;
1168 for ($sender, $repocommitter->(), $repoauthor->()) {
1169 $du_part = extract_valid_address(sanitize_address($_));
1170 last if (defined $du_part and $du_part ne '');
1172 if (not defined $du_part or $du_part eq '') {
1173 require Sys::Hostname;
1174 $du_part = 'user@' . Sys::Hostname::hostname();
1176 my $message_id_template = "<%s-%s>";
1177 $message_id = sprintf($message_id_template, $uniq, $du_part);
1178 #print "new message id = $message_id\n"; # Was useful for debugging
1183 $time = time - scalar $#files;
1185 sub unquote_rfc2047 {
1186 local ($_) = @_;
1187 my $charset;
1188 my $sep = qr/[ \t]+/;
1189 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1190 my @words = split $sep, $&;
1191 foreach (@words) {
1192 m/$re_encoded_word/;
1193 $charset = $1;
1194 my $encoding = $2;
1195 my $text = $3;
1196 if ($encoding eq 'q' || $encoding eq 'Q') {
1197 $_ = $text;
1198 s/_/ /g;
1199 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1200 } else {
1201 # other encodings not supported yet
1204 join '', @words;
1205 }eg;
1206 return wantarray ? ($_, $charset) : $_;
1209 sub quote_rfc2047 {
1210 local $_ = shift;
1211 my $encoding = shift || 'UTF-8';
1212 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1213 s/(.*)/=\?$encoding\?q\?$1\?=/;
1214 return $_;
1217 sub is_rfc2047_quoted {
1218 my $s = shift;
1219 length($s) <= 75 &&
1220 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1223 sub subject_needs_rfc2047_quoting {
1224 my $s = shift;
1226 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1229 sub quote_subject {
1230 local $subject = shift;
1231 my $encoding = shift || 'UTF-8';
1233 if (subject_needs_rfc2047_quoting($subject)) {
1234 return quote_rfc2047($subject, $encoding);
1236 return $subject;
1239 # use the simplest quoting being able to handle the recipient
1240 sub sanitize_address {
1241 my ($recipient) = @_;
1243 # remove garbage after email address
1244 $recipient =~ s/(.*>).*$/$1/;
1246 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1248 if (not $recipient_name) {
1249 return $recipient;
1252 # if recipient_name is already quoted, do nothing
1253 if (is_rfc2047_quoted($recipient_name)) {
1254 return $recipient;
1257 # remove non-escaped quotes
1258 $recipient_name =~ s/(^|[^\\])"/$1/g;
1260 # rfc2047 is needed if a non-ascii char is included
1261 if ($recipient_name =~ /[^[:ascii:]]/) {
1262 $recipient_name = quote_rfc2047($recipient_name);
1265 # double quotes are needed if specials or CTLs are included
1266 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1267 $recipient_name =~ s/([\\\r])/\\$1/g;
1268 $recipient_name = qq["$recipient_name"];
1271 return "$recipient_name $recipient_addr";
1275 sub strip_garbage_one_address {
1276 my ($addr) = @_;
1277 chomp $addr;
1278 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1279 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1280 # Foo Bar <foobar@example.com> [possibly garbage here]
1281 return $1;
1283 if ($addr =~ /^(<[^>]*>).*/) {
1284 # <foo@example.com> [possibly garbage here]
1285 # if garbage contains other addresses, they are ignored.
1286 return $1;
1288 if ($addr =~ /^([^"#,\s]*)/) {
1289 # address without quoting: remove anything after the address
1290 return $1;
1292 return $addr;
1295 sub sanitize_address_list {
1296 return (map { sanitize_address($_) } @_);
1299 sub process_address_list {
1300 my @addr_list = map { parse_address_line($_) } @_;
1301 @addr_list = expand_aliases(@addr_list);
1302 @addr_list = sanitize_address_list(@addr_list);
1303 @addr_list = validate_address_list(@addr_list);
1304 return @addr_list;
1307 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1309 # Tightly configured MTAa require that a caller sends a real DNS
1310 # domain name that corresponds the IP address in the HELO/EHLO
1311 # handshake. This is used to verify the connection and prevent
1312 # spammers from trying to hide their identity. If the DNS and IP don't
1313 # match, the receiving MTA may deny the connection.
1315 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1317 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1318 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1320 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1321 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1323 sub valid_fqdn {
1324 my $domain = shift;
1325 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1328 sub maildomain_net {
1329 my $maildomain;
1331 require Net::Domain;
1332 my $domain = Net::Domain::domainname();
1333 $maildomain = $domain if valid_fqdn($domain);
1335 return $maildomain;
1338 sub maildomain_mta {
1339 my $maildomain;
1341 for my $host (qw(mailhost localhost)) {
1342 require Net::SMTP;
1343 my $smtp = Net::SMTP->new($host);
1344 if (defined $smtp) {
1345 my $domain = $smtp->domain;
1346 $smtp->quit;
1348 $maildomain = $domain if valid_fqdn($domain);
1350 last if $maildomain;
1354 return $maildomain;
1357 sub maildomain {
1358 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1361 sub smtp_host_string {
1362 if (defined $smtp_server_port) {
1363 return "$smtp_server:$smtp_server_port";
1364 } else {
1365 return $smtp_server;
1369 # Returns 1 if authentication succeeded or was not necessary
1370 # (smtp_user was not specified), and 0 otherwise.
1372 sub smtp_auth_maybe {
1373 if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1374 return 1;
1377 # Workaround AUTH PLAIN/LOGIN interaction defect
1378 # with Authen::SASL::Cyrus
1379 eval {
1380 require Authen::SASL;
1381 Authen::SASL->import(qw(Perl));
1384 # Check mechanism naming as defined in:
1385 # https://tools.ietf.org/html/rfc4422#page-8
1386 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1387 die "invalid smtp auth: '${smtp_auth}'";
1390 # TODO: Authentication may fail not because credentials were
1391 # invalid but due to other reasons, in which we should not
1392 # reject credentials.
1393 $auth = Git::credential({
1394 'protocol' => 'smtp',
1395 'host' => smtp_host_string(),
1396 'username' => $smtp_authuser,
1397 # if there's no password, "git credential fill" will
1398 # give us one, otherwise it'll just pass this one.
1399 'password' => $smtp_authpass
1400 }, sub {
1401 my $cred = shift;
1403 if ($smtp_auth) {
1404 my $sasl = Authen::SASL->new(
1405 mechanism => $smtp_auth,
1406 callback => {
1407 user => $cred->{'username'},
1408 pass => $cred->{'password'},
1409 authname => $cred->{'username'},
1413 return !!$smtp->auth($sasl);
1416 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1419 return $auth;
1422 sub ssl_verify_params {
1423 eval {
1424 require IO::Socket::SSL;
1425 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1427 if ($@) {
1428 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1429 return;
1432 if (!defined $smtp_ssl_cert_path) {
1433 # use the OpenSSL defaults
1434 return (SSL_verify_mode => SSL_VERIFY_PEER());
1437 if ($smtp_ssl_cert_path eq "") {
1438 return (SSL_verify_mode => SSL_VERIFY_NONE());
1439 } elsif (-d $smtp_ssl_cert_path) {
1440 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1441 SSL_ca_path => $smtp_ssl_cert_path);
1442 } elsif (-f $smtp_ssl_cert_path) {
1443 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1444 SSL_ca_file => $smtp_ssl_cert_path);
1445 } else {
1446 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1450 sub file_name_is_absolute {
1451 my ($path) = @_;
1453 # msys does not grok DOS drive-prefixes
1454 if ($^O eq 'msys') {
1455 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1458 require File::Spec::Functions;
1459 return File::Spec::Functions::file_name_is_absolute($path);
1462 # Prepares the email, then asks the user what to do.
1464 # If the user chooses to send the email, it's sent and 1 is returned.
1465 # If the user chooses not to send the email, 0 is returned.
1466 # If the user decides they want to make further edits, -1 is returned and the
1467 # caller is expected to call send_message again after the edits are performed.
1469 # If an error occurs sending the email, this just dies.
1471 sub send_message {
1472 my @recipients = unique_email_list(@to);
1473 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1474 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1476 @cc);
1477 my $to = join (",\n\t", @recipients);
1478 @recipients = unique_email_list(@recipients,@cc,@initial_bcc);
1479 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1480 my $date = format_2822_time($time++);
1481 my $gitversion = '@@GIT_VERSION@@';
1482 if ($gitversion =~ m/..GIT_VERSION../) {
1483 $gitversion = Git::version();
1486 my $cc = join(",\n\t", unique_email_list(@cc));
1487 my $ccline = "";
1488 if ($cc ne '') {
1489 $ccline = "\nCc: $cc";
1491 make_message_id() unless defined($message_id);
1493 my $header = "From: $sender
1494 To: $to${ccline}
1495 Subject: $subject
1496 Date: $date
1497 Message-Id: $message_id
1499 if ($use_xmailer) {
1500 $header .= "X-Mailer: git-send-email $gitversion\n";
1502 if ($in_reply_to) {
1504 $header .= "In-Reply-To: $in_reply_to\n";
1505 $header .= "References: $references\n";
1507 if ($reply_to) {
1508 $header .= "Reply-To: $reply_to\n";
1510 if (@xh) {
1511 $header .= join("\n", @xh) . "\n";
1514 my @sendmail_parameters = ('-i', @recipients);
1515 my $raw_from = $sender;
1516 if (defined $envelope_sender && $envelope_sender ne "auto") {
1517 $raw_from = $envelope_sender;
1519 $raw_from = extract_valid_address($raw_from);
1520 unshift (@sendmail_parameters,
1521 '-f', $raw_from) if(defined $envelope_sender);
1523 if ($needs_confirm && !$dry_run) {
1524 print "\n$header\n";
1525 if ($needs_confirm eq "inform") {
1526 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1527 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1528 print __ <<EOF ;
1529 The Cc list above has been expanded by additional
1530 addresses found in the patch commit message. By default
1531 send-email prompts before sending whenever this occurs.
1532 This behavior is controlled by the sendemail.confirm
1533 configuration setting.
1535 For additional information, run 'git send-email --help'.
1536 To retain the current behavior, but squelch this message,
1537 run 'git config --global sendemail.confirm auto'.
1541 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1542 # translation. The program will only accept English input
1543 # at this point.
1544 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1545 valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1546 default => $ask_default);
1547 die __("Send this email reply required") unless defined $_;
1548 if (/^n/i) {
1549 return 0;
1550 } elsif (/^e/i) {
1551 return -1;
1552 } elsif (/^q/i) {
1553 cleanup_compose_files();
1554 exit(0);
1555 } elsif (/^a/i) {
1556 $confirm = 'never';
1560 unshift (@sendmail_parameters, @smtp_server_options);
1562 if ($dry_run) {
1563 # We don't want to send the email.
1564 } elsif (defined $sendmail_cmd || file_name_is_absolute($smtp_server)) {
1565 my $pid = open my $sm, '|-';
1566 defined $pid or die $!;
1567 if (!$pid) {
1568 if (defined $sendmail_cmd) {
1569 exec ("sh", "-c", "$sendmail_cmd \"\$@\"", "-", @sendmail_parameters)
1570 or die $!;
1571 } else {
1572 exec ($smtp_server, @sendmail_parameters)
1573 or die $!;
1576 print $sm "$header\n$message";
1577 close $sm or die $!;
1578 } else {
1580 if (!defined $smtp_server) {
1581 die __("The required SMTP server is not properly defined.")
1584 require Net::SMTP;
1585 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1586 $smtp_domain ||= maildomain();
1588 if ($smtp_encryption eq 'ssl') {
1589 $smtp_server_port ||= 465; # ssmtp
1590 require IO::Socket::SSL;
1592 # Suppress "variable accessed once" warning.
1594 no warnings 'once';
1595 $IO::Socket::SSL::DEBUG = 1;
1598 # Net::SMTP::SSL->new() does not forward any SSL options
1599 IO::Socket::SSL::set_client_defaults(
1600 ssl_verify_params());
1602 if ($use_net_smtp_ssl) {
1603 require Net::SMTP::SSL;
1604 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1605 Hello => $smtp_domain,
1606 Port => $smtp_server_port,
1607 Debug => $debug_net_smtp);
1609 else {
1610 $smtp ||= Net::SMTP->new($smtp_server,
1611 Hello => $smtp_domain,
1612 Port => $smtp_server_port,
1613 Debug => $debug_net_smtp,
1614 SSL => 1);
1617 elsif (!$smtp) {
1618 $smtp_server_port ||= 25;
1619 $smtp ||= Net::SMTP->new($smtp_server,
1620 Hello => $smtp_domain,
1621 Debug => $debug_net_smtp,
1622 Port => $smtp_server_port);
1623 if ($smtp_encryption eq 'tls' && $smtp) {
1624 if ($use_net_smtp_ssl) {
1625 $smtp->command('STARTTLS');
1626 $smtp->response();
1627 if ($smtp->code != 220) {
1628 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1630 require Net::SMTP::SSL;
1631 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1632 ssl_verify_params())
1633 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1635 else {
1636 $smtp->starttls(ssl_verify_params())
1637 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1639 # Send EHLO again to receive fresh
1640 # supported commands
1641 $smtp->hello($smtp_domain);
1645 if (!$smtp) {
1646 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1647 " VALUES: server=$smtp_server ",
1648 "encryption=$smtp_encryption ",
1649 "hello=$smtp_domain",
1650 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1653 smtp_auth_maybe or die $smtp->message;
1655 $smtp->mail( $raw_from ) or die $smtp->message;
1656 $smtp->to( @recipients ) or die $smtp->message;
1657 $smtp->data or die $smtp->message;
1658 $smtp->datasend("$header\n") or die $smtp->message;
1659 my @lines = split /^/, $message;
1660 foreach my $line (@lines) {
1661 $smtp->datasend("$line") or die $smtp->message;
1663 $smtp->dataend() or die $smtp->message;
1664 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1666 if ($quiet) {
1667 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1668 } else {
1669 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1670 if (!defined $sendmail_cmd && !file_name_is_absolute($smtp_server)) {
1671 print "Server: $smtp_server\n";
1672 print "MAIL FROM:<$raw_from>\n";
1673 foreach my $entry (@recipients) {
1674 print "RCPT TO:<$entry>\n";
1676 } else {
1677 my $sm;
1678 if (defined $sendmail_cmd) {
1679 $sm = $sendmail_cmd;
1680 } else {
1681 $sm = $smtp_server;
1684 print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1686 print $header, "\n";
1687 if ($smtp) {
1688 print __("Result: "), $smtp->code, ' ',
1689 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1690 } else {
1691 print __("Result: OK\n");
1695 return 1;
1698 $in_reply_to = $initial_in_reply_to;
1699 $references = $initial_in_reply_to || '';
1700 $message_num = 0;
1702 # Prepares the email, prompts the user, sends it out
1703 # Returns 0 if an edit was done and the function should be called again, or 1
1704 # otherwise.
1705 sub process_file {
1706 my ($t) = @_;
1708 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1710 my $author = undef;
1711 my $sauthor = undef;
1712 my $author_encoding;
1713 my $has_content_type;
1714 my $body_encoding;
1715 my $xfer_encoding;
1716 my $has_mime_version;
1717 @to = ();
1718 @cc = ();
1719 @xh = ();
1720 my $input_format = undef;
1721 my @header = ();
1722 $subject = $initial_subject;
1723 $message = "";
1724 $message_num++;
1725 # First unfold multiline header fields
1726 while(<$fh>) {
1727 last if /^\s*$/;
1728 if (/^\s+\S/ and @header) {
1729 chomp($header[$#header]);
1730 s/^\s+/ /;
1731 $header[$#header] .= $_;
1732 } else {
1733 push(@header, $_);
1736 # Now parse the header
1737 foreach(@header) {
1738 if (/^From /) {
1739 $input_format = 'mbox';
1740 next;
1742 chomp;
1743 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1744 $input_format = 'mbox';
1747 if (defined $input_format && $input_format eq 'mbox') {
1748 if (/^Subject:\s+(.*)$/i) {
1749 $subject = $1;
1751 elsif (/^From:\s+(.*)$/i) {
1752 ($author, $author_encoding) = unquote_rfc2047($1);
1753 $sauthor = sanitize_address($author);
1754 next if $suppress_cc{'author'};
1755 next if $suppress_cc{'self'} and $sauthor eq $sender;
1756 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1757 $1, $_) unless $quiet;
1758 push @cc, $1;
1760 elsif (/^To:\s+(.*)$/i) {
1761 foreach my $addr (parse_address_line($1)) {
1762 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1763 $addr, $_) unless $quiet;
1764 push @to, $addr;
1767 elsif (/^Cc:\s+(.*)$/i) {
1768 foreach my $addr (parse_address_line($1)) {
1769 my $qaddr = unquote_rfc2047($addr);
1770 my $saddr = sanitize_address($qaddr);
1771 if ($saddr eq $sender) {
1772 next if ($suppress_cc{'self'});
1773 } else {
1774 next if ($suppress_cc{'cc'});
1776 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1777 $addr, $_) unless $quiet;
1778 push @cc, $addr;
1781 elsif (/^Content-type:/i) {
1782 $has_content_type = 1;
1783 if (/charset="?([^ "]+)/) {
1784 $body_encoding = $1;
1786 push @xh, $_;
1788 elsif (/^MIME-Version/i) {
1789 $has_mime_version = 1;
1790 push @xh, $_;
1792 elsif (/^Message-Id: (.*)/i) {
1793 $message_id = $1;
1795 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1796 $xfer_encoding = $1 if not defined $xfer_encoding;
1798 elsif (/^In-Reply-To: (.*)/i) {
1799 if (!$initial_in_reply_to || $thread) {
1800 $in_reply_to = $1;
1803 elsif (/^References: (.*)/i) {
1804 if (!$initial_in_reply_to || $thread) {
1805 $references = $1;
1808 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1809 push @xh, $_;
1811 } else {
1812 # In the traditional
1813 # "send lots of email" format,
1814 # line 1 = cc
1815 # line 2 = subject
1816 # So let's support that, too.
1817 $input_format = 'lots';
1818 if (@cc == 0 && !$suppress_cc{'cc'}) {
1819 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1820 $_, $_) unless $quiet;
1821 push @cc, $_;
1822 } elsif (!defined $subject) {
1823 $subject = $_;
1827 # Now parse the message body
1828 while(<$fh>) {
1829 $message .= $_;
1830 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1831 chomp;
1832 my ($what, $c) = ($1, $2);
1833 # strip garbage for the address we'll use:
1834 $c = strip_garbage_one_address($c);
1835 # sanitize a bit more to decide whether to suppress the address:
1836 my $sc = sanitize_address($c);
1837 if ($sc eq $sender) {
1838 next if ($suppress_cc{'self'});
1839 } else {
1840 if ($what =~ /^Signed-off-by$/i) {
1841 next if $suppress_cc{'sob'};
1842 } elsif ($what =~ /-by$/i) {
1843 next if $suppress_cc{'misc-by'};
1844 } elsif ($what =~ /Cc/i) {
1845 next if $suppress_cc{'bodycc'};
1848 if ($c !~ /.+@.+|<.+>/) {
1849 printf("(body) Ignoring %s from line '%s'\n",
1850 $what, $_) unless $quiet;
1851 next;
1853 push @cc, $c;
1854 printf(__("(body) Adding cc: %s from line '%s'\n"),
1855 $c, $_) unless $quiet;
1858 close $fh;
1860 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t)
1861 if defined $to_cmd;
1862 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t)
1863 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1865 if ($broken_encoding{$t} && !$has_content_type) {
1866 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1867 $has_content_type = 1;
1868 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1869 $body_encoding = $auto_8bit_encoding;
1872 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1873 $subject = quote_subject($subject, $auto_8bit_encoding);
1876 if (defined $sauthor and $sauthor ne $sender) {
1877 $message = "From: $author\n\n$message";
1878 if (defined $author_encoding) {
1879 if ($has_content_type) {
1880 if ($body_encoding eq $author_encoding) {
1881 # ok, we already have the right encoding
1883 else {
1884 # uh oh, we should re-encode
1887 else {
1888 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1889 $has_content_type = 1;
1890 push @xh,
1891 "Content-Type: text/plain; charset=$author_encoding";
1895 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1896 ($message, $xfer_encoding) = apply_transfer_encoding(
1897 $message, $xfer_encoding, $target_xfer_encoding);
1898 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1899 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1901 $needs_confirm = (
1902 $confirm eq "always" or
1903 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1904 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1905 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1907 @to = process_address_list(@to);
1908 @cc = process_address_list(@cc);
1910 @to = (@initial_to, @to);
1911 @cc = (@initial_cc, @cc);
1913 if ($message_num == 1) {
1914 if (defined $cover_cc and $cover_cc) {
1915 @initial_cc = @cc;
1917 if (defined $cover_to and $cover_to) {
1918 @initial_to = @to;
1922 my $message_was_sent = send_message();
1923 if ($message_was_sent == -1) {
1924 do_edit($t);
1925 return 0;
1928 # set up for the next message
1929 if ($thread) {
1930 if ($message_was_sent &&
1931 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1932 $message_num == 1)) {
1933 $in_reply_to = $message_id;
1934 if (length $references > 0) {
1935 $references .= "\n $message_id";
1936 } else {
1937 $references = "$message_id";
1940 } elsif (!defined $initial_in_reply_to) {
1941 # --thread and --in-reply-to manage the "In-Reply-To" header and by
1942 # extension the "References" header. If these commands are not used, reset
1943 # the header values to their defaults.
1944 $in_reply_to = undef;
1945 $references = '';
1947 $message_id = undef;
1948 $num_sent++;
1949 if (defined $batch_size && $num_sent == $batch_size) {
1950 $num_sent = 0;
1951 $smtp->quit if defined $smtp;
1952 undef $smtp;
1953 undef $auth;
1954 sleep($relogin_delay) if defined $relogin_delay;
1957 return 1;
1960 foreach my $t (@files) {
1961 while (!process_file($t)) {
1962 # user edited the file
1966 # Execute a command (e.g. $to_cmd) to get a list of email addresses
1967 # and return a results array
1968 sub recipients_cmd {
1969 my ($prefix, $what, $cmd, $file) = @_;
1971 my @addresses = ();
1972 open my $fh, "-|", "$cmd \Q$file\E"
1973 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
1974 while (my $address = <$fh>) {
1975 $address =~ s/^\s*//g;
1976 $address =~ s/\s*$//g;
1977 $address = sanitize_address($address);
1978 next if ($address eq $sender and $suppress_cc{'self'});
1979 push @addresses, $address;
1980 printf(__("(%s) Adding %s: %s from: '%s'\n"),
1981 $prefix, $what, $address, $cmd) unless $quiet;
1983 close $fh
1984 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
1985 return @addresses;
1988 cleanup_compose_files();
1990 sub cleanup_compose_files {
1991 unlink($compose_filename, $compose_filename . ".final") if $compose;
1994 $smtp->quit if $smtp;
1996 sub apply_transfer_encoding {
1997 my $message = shift;
1998 my $from = shift;
1999 my $to = shift;
2001 return ($message, $to) if ($from eq $to and $from ne '7bit');
2003 require MIME::QuotedPrint;
2004 require MIME::Base64;
2006 $message = MIME::QuotedPrint::decode($message)
2007 if ($from eq 'quoted-printable');
2008 $message = MIME::Base64::decode($message)
2009 if ($from eq 'base64');
2011 $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2012 if $to eq 'auto';
2014 die __("cannot send message as 7bit")
2015 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2016 return ($message, $to)
2017 if ($to eq '7bit' or $to eq '8bit');
2018 return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2019 if ($to eq 'quoted-printable');
2020 return (MIME::Base64::encode($message, "\n"), $to)
2021 if ($to eq 'base64');
2022 die __("invalid transfer encoding");
2025 sub unique_email_list {
2026 my %seen;
2027 my @emails;
2029 foreach my $entry (@_) {
2030 my $clean = extract_valid_address_or_die($entry);
2031 $seen{$clean} ||= 0;
2032 next if $seen{$clean}++;
2033 push @emails, $entry;
2035 return @emails;
2038 sub validate_patch {
2039 my ($fn, $xfer_encoding) = @_;
2041 if ($repo) {
2042 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2043 require File::Spec;
2044 my $validate_hook = File::Spec->catfile($hooks_path,
2045 'sendemail-validate');
2046 my $hook_error;
2047 if (-x $validate_hook) {
2048 require Cwd;
2049 my $target = Cwd::abs_path($fn);
2050 # The hook needs a correct cwd and GIT_DIR.
2051 my $cwd_save = Cwd::getcwd();
2052 chdir($repo->wc_path() or $repo->repo_path())
2053 or die("chdir: $!");
2054 local $ENV{"GIT_DIR"} = $repo->repo_path();
2055 $hook_error = system_or_msg([$validate_hook, $target]);
2056 chdir($cwd_save) or die("chdir: $!");
2058 if ($hook_error) {
2059 die sprintf(__("fatal: %s: rejected by sendemail-validate hook\n" .
2060 "%s\n" .
2061 "warning: no patches were sent\n"), $fn, $hook_error);
2065 # Any long lines will be automatically fixed if we use a suitable transfer
2066 # encoding.
2067 unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2068 open(my $fh, '<', $fn)
2069 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2070 while (my $line = <$fh>) {
2071 if (length($line) > 998) {
2072 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2073 "warning: no patches were sent\n"), $fn, $.);
2077 return;
2080 sub handle_backup {
2081 my ($last, $lastlen, $file, $known_suffix) = @_;
2082 my ($suffix, $skip);
2084 $skip = 0;
2085 if (defined $last &&
2086 ($lastlen < length($file)) &&
2087 (substr($file, 0, $lastlen) eq $last) &&
2088 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2089 if (defined $known_suffix && $suffix eq $known_suffix) {
2090 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2091 $skip = 1;
2092 } else {
2093 # TRANSLATORS: please keep "[y|N]" as is.
2094 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2095 valid_re => qr/^(?:y|n)/i,
2096 default => 'n');
2097 $skip = ($answer ne 'y');
2098 if ($skip) {
2099 $known_suffix = $suffix;
2103 return ($skip, $known_suffix);
2106 sub handle_backup_files {
2107 my @file = @_;
2108 my ($last, $lastlen, $known_suffix, $skip, @result);
2109 for my $file (@file) {
2110 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2111 $file, $known_suffix);
2112 push @result, $file unless $skip;
2113 $last = $file;
2114 $lastlen = length($file);
2116 return @result;
2119 sub file_has_nonascii {
2120 my $fn = shift;
2121 open(my $fh, '<', $fn)
2122 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2123 while (my $line = <$fh>) {
2124 return 1 if $line =~ /[^[:ascii:]]/;
2126 return 0;
2129 sub body_or_subject_has_nonascii {
2130 my $fn = shift;
2131 open(my $fh, '<', $fn)
2132 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2133 while (my $line = <$fh>) {
2134 last if $line =~ /^$/;
2135 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2137 while (my $line = <$fh>) {
2138 return 1 if $line =~ /[^[:ascii:]]/;
2140 return 0;