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