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