Merge branch 'rc/trace-upload-pack'
[alt-git.git] / git-send-email.perl
blobcacdbd6bb2e41823994071fc936148dab806f7c2
1 #!/usr/bin/perl
3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
6 # GPL v2 (See COPYING)
8 # Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
10 # Sends a collection of emails to the given email addresses, disturbingly fast.
12 # Supports two formats:
13 # 1. mbox format files (ignoring most headers and MIME formatting - this is designed for sending patches)
14 # 2. The original format support by Greg's script:
15 # first line of the message is who to CC,
16 # and second line is the subject of the message.
19 use 5.008;
20 use strict;
21 use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
22 use Getopt::Long;
23 use Git::LoadCPAN::Error qw(:try);
24 use Git;
25 use Git::I18N;
27 Getopt::Long::Configure qw/ pass_through /;
29 sub usage {
30 print <<EOT;
31 git send-email' [<options>] <file|directory>
32 git send-email' [<options>] <format-patch options>
33 git send-email --dump-aliases
35 Composing:
36 --from <str> * Email From:
37 --[no-]to <str> * Email To:
38 --[no-]cc <str> * Email Cc:
39 --[no-]bcc <str> * Email Bcc:
40 --subject <str> * Email "Subject:"
41 --reply-to <str> * Email "Reply-To:"
42 --in-reply-to <str> * Email "In-Reply-To:"
43 --[no-]xmailer * Add "X-Mailer:" header (default).
44 --[no-]annotate * Review each patch that will be sent in an editor.
45 --compose * Open an editor for introduction.
46 --compose-encoding <str> * Encoding to assume for introduction.
47 --8bit-encoding <str> * Encoding to assume 8bit mails if undeclared
48 --transfer-encoding <str> * Transfer encoding to use (quoted-printable, 8bit, base64)
50 Sending:
51 --envelope-sender <str> * Email envelope sender.
52 --sendmail-cmd <str> * Command to run to send email.
53 --smtp-server <str:int> * Outgoing SMTP server to use. The port
54 is optional. Default 'localhost'.
55 --smtp-server-option <str> * Outgoing SMTP server option to use.
56 --smtp-server-port <int> * Outgoing SMTP server port.
57 --smtp-user <str> * Username for SMTP-AUTH.
58 --smtp-pass <str> * Password for SMTP-AUTH; not necessary.
59 --smtp-encryption <str> * tls or ssl; anything else disables.
60 --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'.
61 --smtp-ssl-cert-path <str> * Path to ca-certificates (either directory or file).
62 Pass an empty string to disable certificate
63 verification.
64 --smtp-domain <str> * The domain name sent to HELO/EHLO handshake
65 --smtp-auth <str> * Space-separated list of allowed AUTH mechanisms, or
66 "none" to disable authentication.
67 This setting forces to use one of the listed mechanisms.
68 --no-smtp-auth Disable SMTP authentication. Shorthand for
69 `--smtp-auth=none`
70 --smtp-debug <0|1> * Disable, enable Net::SMTP debug.
72 --batch-size <int> * send max <int> message per connection.
73 --relogin-delay <int> * delay <int> seconds between two successive login.
74 This option can only be used with --batch-size
76 Automating:
77 --identity <str> * Use the sendemail.<id> options.
78 --to-cmd <str> * Email To: via `<str> \$patch_path`.
79 --cc-cmd <str> * Email Cc: via `<str> \$patch_path`.
80 --header-cmd <str> * Add headers via `<str> \$patch_path`.
81 --no-header-cmd * Disable any header command in use.
82 --suppress-cc <str> * author, self, sob, cc, cccmd, body, bodycc, misc-by, all.
83 --[no-]cc-cover * Email Cc: addresses in the cover letter.
84 --[no-]to-cover * Email To: addresses in the cover letter.
85 --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on.
86 --[no-]suppress-from * Send to self. Default off.
87 --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off.
88 --[no-]thread * Use In-Reply-To: field. Default on.
90 Administering:
91 --confirm <str> * Confirm recipients before sending;
92 auto, cc, compose, always, or never.
93 --quiet * Output one line of info per email.
94 --dry-run * Don't actually send the emails.
95 --[no-]validate * Perform patch sanity checks. Default on.
96 --[no-]format-patch * understand any non optional arguments as
97 `git format-patch` ones.
98 --force * Send even if safety checks would prevent it.
100 Information:
101 --dump-aliases * Dump configured aliases and exit.
104 exit(1);
107 sub uniq {
108 my %seen;
109 grep !$seen{$_}++, @_;
112 sub completion_helper {
113 my ($original_opts) = @_;
114 my %not_for_completion = (
115 "git-completion-helper" => undef,
116 "h" => undef,
118 my @send_email_opts = ();
120 foreach my $key (keys %$original_opts) {
121 unless (exists $not_for_completion{$key}) {
122 $key =~ s/!$//;
124 if ($key =~ /[:=][si]$/) {
125 $key =~ s/[:=][si]$//;
126 push (@send_email_opts, "--$_=") foreach (split (/\|/, $key));
127 } else {
128 push (@send_email_opts, "--$_") foreach (split (/\|/, $key));
133 my @format_patch_opts = split(/ /, Git::command('format-patch', '--git-completion-helper'));
134 my @opts = (@send_email_opts, @format_patch_opts);
135 @opts = uniq (grep !/^$/, @opts);
136 # There's an implicit '\n' here already, no need to add an explicit one.
137 print "@opts";
138 exit(0);
141 # most mail servers generate the Date: header, but not all...
142 sub format_2822_time {
143 my ($time) = @_;
144 my @localtm = localtime($time);
145 my @gmttm = gmtime($time);
146 my $localmin = $localtm[1] + $localtm[2] * 60;
147 my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
148 if ($localtm[0] != $gmttm[0]) {
149 die __("local zone differs from GMT by a non-minute interval\n");
151 if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
152 $localmin += 1440;
153 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
154 $localmin -= 1440;
155 } elsif ($gmttm[6] != $localtm[6]) {
156 die __("local time offset greater than or equal to 24 hours\n");
158 my $offset = $localmin - $gmtmin;
159 my $offhour = $offset / 60;
160 my $offmin = abs($offset % 60);
161 if (abs($offhour) >= 24) {
162 die __("local time offset greater than or equal to 24 hours\n");
165 return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
166 qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
167 $localtm[3],
168 qw(Jan Feb Mar Apr May Jun
169 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
170 $localtm[5]+1900,
171 $localtm[2],
172 $localtm[1],
173 $localtm[0],
174 ($offset >= 0) ? '+' : '-',
175 abs($offhour),
176 $offmin,
180 my $smtp;
181 my $auth;
182 my $num_sent = 0;
184 # Regexes for RFC 2047 productions.
185 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
186 my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
187 my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
189 # Variables we fill in automatically, or via prompting:
190 my (@to,@cc,@xh,$envelope_sender,
191 $initial_in_reply_to,$reply_to,$initial_subject,@files,
192 $author,$sender,$smtp_authpass,$annotate,$compose,$time);
193 # Things we either get from config, *or* are overridden on the
194 # command-line.
195 my ($no_cc, $no_to, $no_bcc, $no_identity, $no_header_cmd);
196 my (@config_to, @getopt_to);
197 my (@config_cc, @getopt_cc);
198 my (@config_bcc, @getopt_bcc);
200 # Example reply to:
201 #$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
203 my $repo = eval { Git->repository() };
204 my @repo = $repo ? ($repo) : ();
206 # Behavior modification variables
207 my ($quiet, $dry_run) = (0, 0);
208 my $format_patch;
209 my $compose_filename;
210 my $force = 0;
211 my $dump_aliases = 0;
213 # Variables to prevent short format-patch options from being captured
214 # as abbreviated send-email options
215 my $reroll_count;
217 # Handle interactive edition of files.
218 my $multiedit;
219 my $editor;
221 sub system_or_msg {
222 my ($args, $msg, $cmd_name) = @_;
223 system(@$args);
224 my $signalled = $? & 127;
225 my $exit_code = $? >> 8;
226 return unless $signalled or $exit_code;
228 my @sprintf_args = ($cmd_name ? $cmd_name : $args->[0], $exit_code);
229 if (defined $msg) {
230 # Quiet the 'redundant' warning category, except we
231 # need to support down to Perl 5.8, so we can't do a
232 # "no warnings 'redundant'", since that category was
233 # introduced in perl 5.22, and asking for it will die
234 # on older perls.
235 no warnings;
236 return sprintf($msg, @sprintf_args);
238 return sprintf(__("fatal: command '%s' died with exit code %d"),
239 @sprintf_args);
242 sub system_or_die {
243 my $msg = system_or_msg(@_);
244 die $msg if $msg;
247 sub do_edit {
248 if (!defined($editor)) {
249 $editor = Git::command_oneline('var', 'GIT_EDITOR');
251 my $die_msg = __("the editor exited uncleanly, aborting everything");
252 if (defined($multiedit) && !$multiedit) {
253 system_or_die(['sh', '-c', $editor.' "$@"', $editor, $_], $die_msg) for @_;
254 } else {
255 system_or_die(['sh', '-c', $editor.' "$@"', $editor, @_], $die_msg);
259 # Variables with corresponding config settings
260 my ($suppress_from, $signed_off_by_cc);
261 my ($cover_cc, $cover_to);
262 my ($to_cmd, $cc_cmd, $header_cmd);
263 my ($smtp_server, $smtp_server_port, @smtp_server_options);
264 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
265 my ($batch_size, $relogin_delay);
266 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
267 my ($confirm);
268 my (@suppress_cc);
269 my ($auto_8bit_encoding);
270 my ($compose_encoding);
271 my ($sendmail_cmd);
272 # Variables with corresponding config settings & hardcoded defaults
273 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
274 my $thread = 1;
275 my $chain_reply_to = 0;
276 my $use_xmailer = 1;
277 my $validate = 1;
278 my $target_xfer_encoding = 'auto';
279 my $forbid_sendmail_variables = 1;
281 my %config_bool_settings = (
282 "thread" => \$thread,
283 "chainreplyto" => \$chain_reply_to,
284 "suppressfrom" => \$suppress_from,
285 "signedoffbycc" => \$signed_off_by_cc,
286 "cccover" => \$cover_cc,
287 "tocover" => \$cover_to,
288 "signedoffcc" => \$signed_off_by_cc,
289 "validate" => \$validate,
290 "multiedit" => \$multiedit,
291 "annotate" => \$annotate,
292 "xmailer" => \$use_xmailer,
293 "forbidsendmailvariables" => \$forbid_sendmail_variables,
296 my %config_settings = (
297 "smtpencryption" => \$smtp_encryption,
298 "smtpserver" => \$smtp_server,
299 "smtpserverport" => \$smtp_server_port,
300 "smtpserveroption" => \@smtp_server_options,
301 "smtpuser" => \$smtp_authuser,
302 "smtppass" => \$smtp_authpass,
303 "smtpdomain" => \$smtp_domain,
304 "smtpauth" => \$smtp_auth,
305 "smtpbatchsize" => \$batch_size,
306 "smtprelogindelay" => \$relogin_delay,
307 "to" => \@config_to,
308 "tocmd" => \$to_cmd,
309 "cc" => \@config_cc,
310 "cccmd" => \$cc_cmd,
311 "headercmd" => \$header_cmd,
312 "aliasfiletype" => \$aliasfiletype,
313 "bcc" => \@config_bcc,
314 "suppresscc" => \@suppress_cc,
315 "envelopesender" => \$envelope_sender,
316 "confirm" => \$confirm,
317 "from" => \$sender,
318 "assume8bitencoding" => \$auto_8bit_encoding,
319 "composeencoding" => \$compose_encoding,
320 "transferencoding" => \$target_xfer_encoding,
321 "sendmailcmd" => \$sendmail_cmd,
324 my %config_path_settings = (
325 "aliasesfile" => \@alias_files,
326 "smtpsslcertpath" => \$smtp_ssl_cert_path,
329 # Handle Uncouth Termination
330 sub signal_handler {
331 # Make text normal
332 require Term::ANSIColor;
333 print Term::ANSIColor::color("reset"), "\n";
335 # SMTP password masked
336 system "stty echo";
338 # tmp files from --compose
339 if (defined $compose_filename) {
340 if (-e $compose_filename) {
341 printf __("'%s' contains an intermediate version ".
342 "of the email you were composing.\n"),
343 $compose_filename;
345 if (-e ($compose_filename . ".final")) {
346 printf __("'%s.final' contains the composed email.\n"),
347 $compose_filename;
351 exit;
354 $SIG{TERM} = \&signal_handler;
355 $SIG{INT} = \&signal_handler;
357 # Read our sendemail.* config
358 sub read_config {
359 my ($known_keys, $configured, $prefix) = @_;
361 foreach my $setting (keys %config_bool_settings) {
362 my $target = $config_bool_settings{$setting};
363 my $key = "$prefix.$setting";
364 next unless exists $known_keys->{$key};
365 my $v = (@{$known_keys->{$key}} == 1 &&
366 (defined $known_keys->{$key}->[0] &&
367 $known_keys->{$key}->[0] =~ /^(?:true|false)$/s))
368 ? $known_keys->{$key}->[0] eq 'true'
369 : Git::config_bool(@repo, $key);
370 next unless defined $v;
371 next if $configured->{$setting}++;
372 $$target = $v;
375 foreach my $setting (keys %config_path_settings) {
376 my $target = $config_path_settings{$setting};
377 my $key = "$prefix.$setting";
378 next unless exists $known_keys->{$key};
379 if (ref($target) eq "ARRAY") {
380 my @values = Git::config_path(@repo, $key);
381 next unless @values;
382 next if $configured->{$setting}++;
383 @$target = @values;
385 else {
386 my $v = Git::config_path(@repo, "$prefix.$setting");
387 next unless defined $v;
388 next if $configured->{$setting}++;
389 $$target = $v;
393 foreach my $setting (keys %config_settings) {
394 my $target = $config_settings{$setting};
395 my $key = "$prefix.$setting";
396 next unless exists $known_keys->{$key};
397 if (ref($target) eq "ARRAY") {
398 my @values = @{$known_keys->{$key}};
399 @values = grep { defined } @values;
400 next if $configured->{$setting}++;
401 @$target = @values;
403 else {
404 my $v = $known_keys->{$key}->[-1];
405 next unless defined $v;
406 next if $configured->{$setting}++;
407 $$target = $v;
412 sub config_regexp {
413 my ($regex) = @_;
414 my @ret;
415 eval {
416 my $ret = Git::command(
417 'config',
418 '--null',
419 '--get-regexp',
420 $regex,
422 @ret = map {
423 # We must always return ($k, $v) here, since
424 # empty config values will be just "key\0",
425 # not "key\nvalue\0".
426 my ($k, $v) = split /\n/, $_, 2;
427 ($k, $v);
428 } split /\0/, $ret;
430 } or do {
431 # If we have no keys we're OK, otherwise re-throw
432 die $@ if $@->value != 1;
434 return @ret;
437 # Save ourselves a lot of work of shelling out to 'git config' (it
438 # parses 'bool' etc.) by only doing so for config keys that exist.
439 my %known_config_keys;
441 my @kv = config_regexp("^sende?mail[.]");
442 while (my ($k, $v) = splice @kv, 0, 2) {
443 push @{$known_config_keys{$k}} => $v;
447 # sendemail.identity yields to --identity. We must parse this
448 # special-case first before the rest of the config is read.
450 my $key = "sendemail.identity";
451 $identity = Git::config(@repo, $key) if exists $known_config_keys{$key};
453 my %identity_options = (
454 "identity=s" => \$identity,
455 "no-identity" => \$no_identity,
457 my $rc = GetOptions(%identity_options);
458 usage() unless $rc;
459 undef $identity if $no_identity;
461 # Now we know enough to read the config
463 my %configured;
464 read_config(\%known_config_keys, \%configured, "sendemail.$identity") if defined $identity;
465 read_config(\%known_config_keys, \%configured, "sendemail");
468 # Begin by accumulating all the variables (defined above), that we will end up
469 # needing, first, from the command line:
471 my $help;
472 my $git_completion_helper;
473 my %dump_aliases_options = (
474 "h" => \$help,
475 "dump-aliases" => \$dump_aliases,
477 $rc = GetOptions(%dump_aliases_options);
478 usage() unless $rc;
479 die __("--dump-aliases incompatible with other options\n")
480 if !$help and $dump_aliases and @ARGV;
481 my %options = (
482 "sender|from=s" => \$sender,
483 "in-reply-to=s" => \$initial_in_reply_to,
484 "reply-to=s" => \$reply_to,
485 "subject=s" => \$initial_subject,
486 "to=s" => \@getopt_to,
487 "to-cmd=s" => \$to_cmd,
488 "no-to" => \$no_to,
489 "cc=s" => \@getopt_cc,
490 "no-cc" => \$no_cc,
491 "bcc=s" => \@getopt_bcc,
492 "no-bcc" => \$no_bcc,
493 "chain-reply-to!" => \$chain_reply_to,
494 "no-chain-reply-to" => sub {$chain_reply_to = 0},
495 "sendmail-cmd=s" => \$sendmail_cmd,
496 "smtp-server=s" => \$smtp_server,
497 "smtp-server-option=s" => \@smtp_server_options,
498 "smtp-server-port=s" => \$smtp_server_port,
499 "smtp-user=s" => \$smtp_authuser,
500 "smtp-pass:s" => \$smtp_authpass,
501 "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
502 "smtp-encryption=s" => \$smtp_encryption,
503 "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
504 "smtp-debug:i" => \$debug_net_smtp,
505 "smtp-domain:s" => \$smtp_domain,
506 "smtp-auth=s" => \$smtp_auth,
507 "no-smtp-auth" => sub {$smtp_auth = 'none'},
508 "annotate!" => \$annotate,
509 "no-annotate" => sub {$annotate = 0},
510 "compose" => \$compose,
511 "quiet" => \$quiet,
512 "cc-cmd=s" => \$cc_cmd,
513 "header-cmd=s" => \$header_cmd,
514 "no-header-cmd" => \$no_header_cmd,
515 "suppress-from!" => \$suppress_from,
516 "no-suppress-from" => sub {$suppress_from = 0},
517 "suppress-cc=s" => \@suppress_cc,
518 "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
519 "no-signed-off-cc|no-signed-off-by-cc" => sub {$signed_off_by_cc = 0},
520 "cc-cover|cc-cover!" => \$cover_cc,
521 "no-cc-cover" => sub {$cover_cc = 0},
522 "to-cover|to-cover!" => \$cover_to,
523 "no-to-cover" => sub {$cover_to = 0},
524 "confirm=s" => \$confirm,
525 "dry-run" => \$dry_run,
526 "envelope-sender=s" => \$envelope_sender,
527 "thread!" => \$thread,
528 "no-thread" => sub {$thread = 0},
529 "validate!" => \$validate,
530 "no-validate" => sub {$validate = 0},
531 "transfer-encoding=s" => \$target_xfer_encoding,
532 "format-patch!" => \$format_patch,
533 "no-format-patch" => sub {$format_patch = 0},
534 "8bit-encoding=s" => \$auto_8bit_encoding,
535 "compose-encoding=s" => \$compose_encoding,
536 "force" => \$force,
537 "xmailer!" => \$use_xmailer,
538 "no-xmailer" => sub {$use_xmailer = 0},
539 "batch-size=i" => \$batch_size,
540 "relogin-delay=i" => \$relogin_delay,
541 "git-completion-helper" => \$git_completion_helper,
542 "v=s" => \$reroll_count,
544 $rc = GetOptions(%options);
546 # Munge any "either config or getopt, not both" variables
547 my @initial_to = @getopt_to ? @getopt_to : ($no_to ? () : @config_to);
548 my @initial_cc = @getopt_cc ? @getopt_cc : ($no_cc ? () : @config_cc);
549 my @initial_bcc = @getopt_bcc ? @getopt_bcc : ($no_bcc ? () : @config_bcc);
551 usage() if $help;
552 my %all_options = (%options, %dump_aliases_options, %identity_options);
553 completion_helper(\%all_options) if $git_completion_helper;
554 unless ($rc) {
555 usage();
558 if ($forbid_sendmail_variables && grep { /^sendmail/s } keys %known_config_keys) {
559 die __("fatal: found configuration options for 'sendmail'\n" .
560 "git-send-email is configured with the sendemail.* options - note the 'e'.\n" .
561 "Set sendemail.forbidSendmailVariables to false to disable this check.\n");
564 die __("Cannot run git format-patch from outside a repository\n")
565 if $format_patch and not $repo;
567 die __("`batch-size` and `relogin` must be specified together " .
568 "(via command-line or configuration option)\n")
569 if defined $relogin_delay and not defined $batch_size;
571 # 'default' encryption is none -- this only prevents a warning
572 $smtp_encryption = '' unless (defined $smtp_encryption);
574 # Set CC suppressions
575 my(%suppress_cc);
576 if (@suppress_cc) {
577 foreach my $entry (@suppress_cc) {
578 # Please update $__git_send_email_suppresscc_options
579 # in git-completion.bash when you add new options.
580 die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
581 unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc|misc-by)$/;
582 $suppress_cc{$entry} = 1;
586 if ($suppress_cc{'all'}) {
587 foreach my $entry (qw (cccmd cc author self sob body bodycc misc-by)) {
588 $suppress_cc{$entry} = 1;
590 delete $suppress_cc{'all'};
593 # If explicit old-style ones are specified, they trump --suppress-cc.
594 $suppress_cc{'self'} = $suppress_from if defined $suppress_from;
595 $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
597 if ($suppress_cc{'body'}) {
598 foreach my $entry (qw (sob bodycc misc-by)) {
599 $suppress_cc{$entry} = 1;
601 delete $suppress_cc{'body'};
604 # Set confirm's default value
605 my $confirm_unconfigured = !defined $confirm;
606 if ($confirm_unconfigured) {
607 $confirm = scalar %suppress_cc ? 'compose' : 'auto';
609 # Please update $__git_send_email_confirm_options in
610 # git-completion.bash when you add new options.
611 die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
612 unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
614 # Debugging, print out the suppressions.
615 if (0) {
616 print "suppressions:\n";
617 foreach my $entry (keys %suppress_cc) {
618 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
622 my ($repoauthor, $repocommitter);
624 my %cache;
625 my ($author, $committer);
626 my $common = sub {
627 my ($what) = @_;
628 return $cache{$what} if exists $cache{$what};
629 ($cache{$what}) = Git::ident_person(@repo, $what);
630 return $cache{$what};
632 $repoauthor = sub { $common->('author') };
633 $repocommitter = sub { $common->('committer') };
636 sub parse_address_line {
637 require Git::LoadCPAN::Mail::Address;
638 return map { $_->format } Mail::Address->parse($_[0]);
641 sub split_addrs {
642 require Text::ParseWords;
643 return Text::ParseWords::quotewords('\s*,\s*', 1, @_);
646 my %aliases;
648 sub parse_sendmail_alias {
649 local $_ = shift;
650 if (/"/) {
651 printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
652 } elsif (/:include:/) {
653 printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
654 } elsif (/[\/|]/) {
655 printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
656 } elsif (/^(\S+?)\s*:\s*(.+)$/) {
657 my ($alias, $addr) = ($1, $2);
658 $aliases{$alias} = [ split_addrs($addr) ];
659 } else {
660 printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
664 sub parse_sendmail_aliases {
665 my $fh = shift;
666 my $s = '';
667 while (<$fh>) {
668 chomp;
669 next if /^\s*$/ || /^\s*#/;
670 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
671 parse_sendmail_alias($s) if $s;
672 $s = $_;
674 $s =~ s/\\$//; # silently tolerate stray '\' on last line
675 parse_sendmail_alias($s) if $s;
678 my %parse_alias = (
679 # multiline formats can be supported in the future
680 mutt => sub { my $fh = shift; while (<$fh>) {
681 if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
682 my ($alias, $addr) = ($1, $2);
683 $addr =~ s/#.*$//; # mutt allows # comments
684 # commas delimit multiple addresses
685 my @addr = split_addrs($addr);
687 # quotes may be escaped in the file,
688 # unescape them so we do not double-escape them later.
689 s/\\"/"/g foreach @addr;
690 $aliases{$alias} = \@addr
691 }}},
692 mailrc => sub { my $fh = shift; while (<$fh>) {
693 if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
694 require Text::ParseWords;
695 # spaces delimit multiple addresses
696 $aliases{$1} = [ Text::ParseWords::quotewords('\s+', 0, $2) ];
697 }}},
698 pine => sub { my $fh = shift; my $f='\t[^\t]*';
699 for (my $x = ''; defined($x); $x = $_) {
700 chomp $x;
701 $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
702 $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
703 $aliases{$1} = [ split_addrs($2) ];
705 elm => sub { my $fh = shift;
706 while (<$fh>) {
707 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
708 my ($alias, $addr) = ($1, $2);
709 $aliases{$alias} = [ split_addrs($addr) ];
711 } },
712 sendmail => \&parse_sendmail_aliases,
713 gnus => sub { my $fh = shift; while (<$fh>) {
714 if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
715 $aliases{$1} = [ $2 ];
717 # Please update _git_config() in git-completion.bash when you
718 # add new MUAs.
721 if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
722 foreach my $file (@alias_files) {
723 open my $fh, '<', $file or die "opening $file: $!\n";
724 $parse_alias{$aliasfiletype}->($fh);
725 close $fh;
729 if ($dump_aliases) {
730 print "$_\n" for (sort keys %aliases);
731 exit(0);
734 # is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
735 # $f is a revision list specification to be passed to format-patch.
736 sub is_format_patch_arg {
737 return unless $repo;
738 my $f = shift;
739 try {
740 $repo->command('rev-parse', '--verify', '--quiet', $f);
741 if (defined($format_patch)) {
742 return $format_patch;
744 die sprintf(__(<<EOF), $f, $f);
745 File '%s' exists but it could also be the range of commits
746 to produce patches for. Please disambiguate by...
748 * Saying "./%s" if you mean a file; or
749 * Giving --format-patch option if you mean a range.
751 } catch Git::Error::Command with {
752 # Not a valid revision. Treat it as a filename.
753 return 0;
757 # Now that all the defaults are set, process the rest of the command line
758 # arguments and collect up the files that need to be processed.
759 my @rev_list_opts;
760 while (defined(my $f = shift @ARGV)) {
761 if ($f eq "--") {
762 push @rev_list_opts, "--", @ARGV;
763 @ARGV = ();
764 } elsif (-d $f and !is_format_patch_arg($f)) {
765 opendir my $dh, $f
766 or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
768 require File::Spec;
769 push @files, grep { -f $_ } map { File::Spec->catfile($f, $_) }
770 sort readdir $dh;
771 closedir $dh;
772 } elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
773 push @files, $f;
774 } else {
775 push @rev_list_opts, $f;
779 if (@rev_list_opts) {
780 die __("Cannot run git format-patch from outside a repository\n")
781 unless $repo;
782 require File::Temp;
783 push @files, $repo->command('format-patch', '-o', File::Temp::tempdir(CLEANUP => 1),
784 defined $reroll_count ? ('-v', $reroll_count) : (),
785 @rev_list_opts);
788 if (defined $sender) {
789 $sender =~ s/^\s+|\s+$//g;
790 ($sender) = expand_aliases($sender);
791 } else {
792 $sender = $repoauthor->() || $repocommitter->() || '';
795 # $sender could be an already sanitized address
796 # (e.g. sendemail.from could be manually sanitized by user).
797 # But it's a no-op to run sanitize_address on an already sanitized address.
798 $sender = sanitize_address($sender);
800 $time = time - scalar $#files;
802 @files = handle_backup_files(@files);
804 if (@files) {
805 unless ($quiet) {
806 print $_,"\n" for (@files);
808 } else {
809 print STDERR __("\nNo patch files specified!\n\n");
810 usage();
813 sub get_patch_subject {
814 my $fn = shift;
815 open (my $fh, '<', $fn);
816 while (my $line = <$fh>) {
817 next unless ($line =~ /^Subject: (.*)$/);
818 close $fh;
819 return "GIT: $1\n";
821 close $fh;
822 die sprintf(__("No subject line in %s?"), $fn);
825 if ($compose) {
826 # Note that this does not need to be secure, but we will make a small
827 # effort to have it be unique
828 require File::Temp;
829 $compose_filename = ($repo ?
830 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
831 File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
832 open my $c, ">", $compose_filename
833 or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
836 my $tpl_sender = $sender || $repoauthor->() || $repocommitter->() || '';
837 my $tpl_subject = $initial_subject || '';
838 my $tpl_in_reply_to = $initial_in_reply_to || '';
839 my $tpl_reply_to = $reply_to || '';
840 my $tpl_to = join(',', @initial_to);
841 my $tpl_cc = join(',', @initial_cc);
842 my $tpl_bcc = join(', ', @initial_bcc);
844 print $c <<EOT1, Git::prefix_lines("GIT: ", __(<<EOT2)), <<EOT3;
845 From $tpl_sender # This line is ignored.
846 EOT1
847 Lines beginning in "GIT:" will be removed.
848 Consider including an overall diffstat or table of contents
849 for the patch you are writing.
851 Clear the body content if you don't wish to send a summary.
852 EOT2
853 From: $tpl_sender
854 To: $tpl_to
855 Cc: $tpl_cc
856 Bcc: $tpl_bcc
857 Reply-To: $tpl_reply_to
858 Subject: $tpl_subject
859 In-Reply-To: $tpl_in_reply_to
861 EOT3
862 for my $f (@files) {
863 print $c get_patch_subject($f);
865 close $c;
867 if ($annotate) {
868 do_edit($compose_filename, @files);
869 } else {
870 do_edit($compose_filename);
873 open my $c2, ">", $compose_filename . ".final"
874 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
876 open $c, "<", $compose_filename
877 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
879 my $need_8bit_cte = file_has_nonascii($compose_filename);
880 my $in_body = 0;
881 my $summary_empty = 1;
882 if (!defined $compose_encoding) {
883 $compose_encoding = "UTF-8";
885 while(<$c>) {
886 next if m/^GIT:/;
887 if ($in_body) {
888 $summary_empty = 0 unless (/^\n$/);
889 } elsif (/^\n$/) {
890 $in_body = 1;
891 if ($need_8bit_cte) {
892 print $c2 "MIME-Version: 1.0\n",
893 "Content-Type: text/plain; ",
894 "charset=$compose_encoding\n",
895 "Content-Transfer-Encoding: 8bit\n";
897 } elsif (/^MIME-Version:/i) {
898 $need_8bit_cte = 0;
899 } elsif (/^Subject:\s*(.+)\s*$/i) {
900 $initial_subject = $1;
901 my $subject = $initial_subject;
902 $_ = "Subject: " .
903 quote_subject($subject, $compose_encoding) .
904 "\n";
905 } elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
906 $initial_in_reply_to = $1;
907 next;
908 } elsif (/^Reply-To:\s*(.+)\s*$/i) {
909 $reply_to = $1;
910 } elsif (/^From:\s*(.+)\s*$/i) {
911 $sender = $1;
912 next;
913 } elsif (/^To:\s*(.+)\s*$/i) {
914 @initial_to = parse_address_line($1);
915 next;
916 } elsif (/^Cc:\s*(.+)\s*$/i) {
917 @initial_cc = parse_address_line($1);
918 next;
919 } elsif (/^Bcc:/i) {
920 @initial_bcc = parse_address_line($1);
921 next;
923 print $c2 $_;
925 close $c;
926 close $c2;
928 if ($summary_empty) {
929 print __("Summary email is empty, skipping it\n");
930 $compose = -1;
932 } elsif ($annotate) {
933 do_edit(@files);
937 # Only instantiate one $term per program run, since some
938 # Term::ReadLine providers refuse to create a second instance.
939 my $term;
940 sub term {
941 require Term::ReadLine;
942 if (!defined $term) {
943 $term = $ENV{"GIT_SEND_EMAIL_NOTTY"}
944 ? Term::ReadLine->new('git-send-email', \*STDIN, \*STDOUT)
945 : Term::ReadLine->new('git-send-email');
947 return $term;
951 sub ask {
952 my ($prompt, %arg) = @_;
953 my $valid_re = $arg{valid_re};
954 my $default = $arg{default};
955 my $confirm_only = $arg{confirm_only};
956 my $resp;
957 my $i = 0;
958 my $term = term();
959 return defined $default ? $default : undef
960 unless defined $term->IN and defined fileno($term->IN) and
961 defined $term->OUT and defined fileno($term->OUT);
962 while ($i++ < 10) {
963 $resp = $term->readline($prompt);
964 if (!defined $resp) { # EOF
965 print "\n";
966 return defined $default ? $default : undef;
968 if ($resp eq '' and defined $default) {
969 return $default;
971 if (!defined $valid_re or $resp =~ /$valid_re/) {
972 return $resp;
974 if ($confirm_only) {
975 my $yesno = $term->readline(
976 # TRANSLATORS: please keep [y/N] as is.
977 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
978 if (defined $yesno && $yesno =~ /y/i) {
979 return $resp;
983 return;
986 my %broken_encoding;
988 sub file_declares_8bit_cte {
989 my $fn = shift;
990 open (my $fh, '<', $fn);
991 while (my $line = <$fh>) {
992 last if ($line =~ /^$/);
993 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
995 close $fh;
996 return 0;
999 foreach my $f (@files) {
1000 next unless (body_or_subject_has_nonascii($f)
1001 && !file_declares_8bit_cte($f));
1002 $broken_encoding{$f} = 1;
1005 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
1006 print __("The following files are 8bit, but do not declare " .
1007 "a Content-Transfer-Encoding.\n");
1008 foreach my $f (sort keys %broken_encoding) {
1009 print " $f\n";
1011 $auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
1012 valid_re => qr/.{4}/, confirm_only => 1,
1013 default => "UTF-8");
1016 if (!$force) {
1017 for my $f (@files) {
1018 if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
1019 die sprintf(__("Refusing to send because the patch\n\t%s\n"
1020 . "has the template subject '*** SUBJECT HERE ***'. "
1021 . "Pass --force if you really want to send.\n"), $f);
1026 my $to_whom = __("To whom should the emails be sent (if anyone)?");
1027 my $prompting = 0;
1028 if (!@initial_to && !defined $to_cmd) {
1029 my $to = ask("$to_whom ",
1030 default => "",
1031 valid_re => qr/\@.*\./, confirm_only => 1);
1032 push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
1033 $prompting++;
1036 sub expand_aliases {
1037 return map { expand_one_alias($_) } @_;
1040 my %EXPANDED_ALIASES;
1041 sub expand_one_alias {
1042 my $alias = shift;
1043 if ($EXPANDED_ALIASES{$alias}) {
1044 die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
1046 local $EXPANDED_ALIASES{$alias} = 1;
1047 return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
1050 @initial_to = process_address_list(@initial_to);
1051 @initial_cc = process_address_list(@initial_cc);
1052 @initial_bcc = process_address_list(@initial_bcc);
1054 if ($thread && !defined $initial_in_reply_to && $prompting) {
1055 $initial_in_reply_to = ask(
1056 __("Message-ID to be used as In-Reply-To for the first email (if any)? "),
1057 default => "",
1058 valid_re => qr/\@.*\./, confirm_only => 1);
1060 if (defined $initial_in_reply_to) {
1061 $initial_in_reply_to =~ s/^\s*<?//;
1062 $initial_in_reply_to =~ s/>?\s*$//;
1063 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
1066 if (defined $reply_to) {
1067 $reply_to =~ s/^\s+|\s+$//g;
1068 ($reply_to) = expand_aliases($reply_to);
1069 $reply_to = sanitize_address($reply_to);
1072 if (!defined $sendmail_cmd && !defined $smtp_server) {
1073 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1074 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
1075 foreach (@sendmail_paths) {
1076 if (-x $_) {
1077 $sendmail_cmd = $_;
1078 last;
1082 if (!defined $sendmail_cmd) {
1083 $smtp_server = 'localhost'; # could be 127.0.0.1, too... *shrug*
1087 if ($compose && $compose > 0) {
1088 @files = ($compose_filename . ".final", @files);
1091 # Variables we set as part of the loop over files
1092 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
1093 $needs_confirm, $message_num, $ask_default);
1095 sub extract_valid_address {
1096 my $address = shift;
1097 my $local_part_regexp = qr/[^<>"\s@]+/;
1098 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
1100 # check for a local address:
1101 return $address if ($address =~ /^($local_part_regexp)$/);
1103 $address =~ s/^\s*<(.*)>\s*$/$1/;
1104 my $have_email_valid = eval { require Email::Valid; 1 };
1105 if ($have_email_valid) {
1106 return scalar Email::Valid->address($address);
1109 # less robust/correct than the monster regexp in Email::Valid,
1110 # but still does a 99% job, and one less dependency
1111 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1112 return;
1115 sub extract_valid_address_or_die {
1116 my $address = shift;
1117 my $valid_address = extract_valid_address($address);
1118 die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1119 if !$valid_address;
1120 return $valid_address;
1123 sub validate_address {
1124 my $address = shift;
1125 while (!extract_valid_address($address)) {
1126 printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1127 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1128 # translation. The program will only accept English input
1129 # at this point.
1130 $_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1131 valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1132 default => 'q');
1133 if (/^d/i) {
1134 return undef;
1135 } elsif (/^q/i) {
1136 cleanup_compose_files();
1137 exit(0);
1139 $address = ask("$to_whom ",
1140 default => "",
1141 valid_re => qr/\@.*\./, confirm_only => 1);
1143 return $address;
1146 sub validate_address_list {
1147 return (grep { defined $_ }
1148 map { validate_address($_) } @_);
1151 # Usually don't need to change anything below here.
1153 # we make a "fake" message id by taking the current number
1154 # of seconds since the beginning of Unix time and tacking on
1155 # a random number to the end, in case we are called quicker than
1156 # 1 second since the last time we were called.
1158 # We'll setup a template for the message id, using the "from" address:
1160 my ($message_id_stamp, $message_id_serial);
1161 sub make_message_id {
1162 my $uniq;
1163 if (!defined $message_id_stamp) {
1164 require POSIX;
1165 $message_id_stamp = POSIX::strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1166 $message_id_serial = 0;
1168 $message_id_serial++;
1169 $uniq = "$message_id_stamp-$message_id_serial";
1171 my $du_part;
1172 for ($sender, $repocommitter->(), $repoauthor->()) {
1173 $du_part = extract_valid_address(sanitize_address($_));
1174 last if (defined $du_part and $du_part ne '');
1176 if (not defined $du_part or $du_part eq '') {
1177 require Sys::Hostname;
1178 $du_part = 'user@' . Sys::Hostname::hostname();
1180 my $message_id_template = "<%s-%s>";
1181 $message_id = sprintf($message_id_template, $uniq, $du_part);
1182 #print "new message id = $message_id\n"; # Was useful for debugging
1185 sub unquote_rfc2047 {
1186 local ($_) = @_;
1187 my $charset;
1188 my $sep = qr/[ \t]+/;
1189 s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1190 my @words = split $sep, $&;
1191 foreach (@words) {
1192 m/$re_encoded_word/;
1193 $charset = $1;
1194 my $encoding = $2;
1195 my $text = $3;
1196 if ($encoding eq 'q' || $encoding eq 'Q') {
1197 $_ = $text;
1198 s/_/ /g;
1199 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1200 } else {
1201 # other encodings not supported yet
1204 join '', @words;
1205 }eg;
1206 return wantarray ? ($_, $charset) : $_;
1209 sub quote_rfc2047 {
1210 local $_ = shift;
1211 my $encoding = shift || 'UTF-8';
1212 s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1213 s/(.*)/=\?$encoding\?q\?$1\?=/;
1214 return $_;
1217 sub is_rfc2047_quoted {
1218 my $s = shift;
1219 length($s) <= 75 &&
1220 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1223 sub subject_needs_rfc2047_quoting {
1224 my $s = shift;
1226 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1229 sub quote_subject {
1230 local $subject = shift;
1231 my $encoding = shift || 'UTF-8';
1233 if (subject_needs_rfc2047_quoting($subject)) {
1234 return quote_rfc2047($subject, $encoding);
1236 return $subject;
1239 # use the simplest quoting being able to handle the recipient
1240 sub sanitize_address {
1241 my ($recipient) = @_;
1243 # remove garbage after email address
1244 $recipient =~ s/(.*>).*$/$1/;
1246 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1248 if (not $recipient_name) {
1249 return $recipient;
1252 # if recipient_name is already quoted, do nothing
1253 if (is_rfc2047_quoted($recipient_name)) {
1254 return $recipient;
1257 # remove non-escaped quotes
1258 $recipient_name =~ s/(^|[^\\])"/$1/g;
1260 # rfc2047 is needed if a non-ascii char is included
1261 if ($recipient_name =~ /[^[:ascii:]]/) {
1262 $recipient_name = quote_rfc2047($recipient_name);
1265 # double quotes are needed if specials or CTLs are included
1266 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1267 $recipient_name =~ s/([\\\r])/\\$1/g;
1268 $recipient_name = qq["$recipient_name"];
1271 return "$recipient_name $recipient_addr";
1275 sub strip_garbage_one_address {
1276 my ($addr) = @_;
1277 chomp $addr;
1278 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1279 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1280 # Foo Bar <foobar@example.com> [possibly garbage here]
1281 return $1;
1283 if ($addr =~ /^(<[^>]*>).*/) {
1284 # <foo@example.com> [possibly garbage here]
1285 # if garbage contains other addresses, they are ignored.
1286 return $1;
1288 if ($addr =~ /^([^"#,\s]*)/) {
1289 # address without quoting: remove anything after the address
1290 return $1;
1292 return $addr;
1295 sub sanitize_address_list {
1296 return (map { sanitize_address($_) } @_);
1299 sub process_address_list {
1300 my @addr_list = map { parse_address_line($_) } @_;
1301 @addr_list = expand_aliases(@addr_list);
1302 @addr_list = sanitize_address_list(@addr_list);
1303 @addr_list = validate_address_list(@addr_list);
1304 return @addr_list;
1307 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1309 # Tightly configured MTAa require that a caller sends a real DNS
1310 # domain name that corresponds the IP address in the HELO/EHLO
1311 # handshake. This is used to verify the connection and prevent
1312 # spammers from trying to hide their identity. If the DNS and IP don't
1313 # match, the receiving MTA may deny the connection.
1315 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1317 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1318 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1320 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1321 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1323 sub valid_fqdn {
1324 my $domain = shift;
1325 return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1328 sub maildomain_net {
1329 my $maildomain;
1331 require Net::Domain;
1332 my $domain = Net::Domain::domainname();
1333 $maildomain = $domain if valid_fqdn($domain);
1335 return $maildomain;
1338 sub maildomain_mta {
1339 my $maildomain;
1341 for my $host (qw(mailhost localhost)) {
1342 require Net::SMTP;
1343 my $smtp = Net::SMTP->new($host);
1344 if (defined $smtp) {
1345 my $domain = $smtp->domain;
1346 $smtp->quit;
1348 $maildomain = $domain if valid_fqdn($domain);
1350 last if $maildomain;
1354 return $maildomain;
1357 sub maildomain {
1358 return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1361 sub smtp_host_string {
1362 if (defined $smtp_server_port) {
1363 return "$smtp_server:$smtp_server_port";
1364 } else {
1365 return $smtp_server;
1369 # Returns 1 if authentication succeeded or was not necessary
1370 # (smtp_user was not specified), and 0 otherwise.
1372 sub smtp_auth_maybe {
1373 if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1374 return 1;
1377 # Workaround AUTH PLAIN/LOGIN interaction defect
1378 # with Authen::SASL::Cyrus
1379 eval {
1380 require Authen::SASL;
1381 Authen::SASL->import(qw(Perl));
1384 # Check mechanism naming as defined in:
1385 # https://tools.ietf.org/html/rfc4422#page-8
1386 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1387 die "invalid smtp auth: '${smtp_auth}'";
1390 # TODO: Authentication may fail not because credentials were
1391 # invalid but due to other reasons, in which we should not
1392 # reject credentials.
1393 $auth = Git::credential({
1394 'protocol' => 'smtp',
1395 'host' => smtp_host_string(),
1396 'username' => $smtp_authuser,
1397 # if there's no password, "git credential fill" will
1398 # give us one, otherwise it'll just pass this one.
1399 'password' => $smtp_authpass
1400 }, sub {
1401 my $cred = shift;
1403 if ($smtp_auth) {
1404 my $sasl = Authen::SASL->new(
1405 mechanism => $smtp_auth,
1406 callback => {
1407 user => $cred->{'username'},
1408 pass => $cred->{'password'},
1409 authname => $cred->{'username'},
1413 return !!$smtp->auth($sasl);
1416 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1419 return $auth;
1422 sub ssl_verify_params {
1423 eval {
1424 require IO::Socket::SSL;
1425 IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1427 if ($@) {
1428 print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1429 return;
1432 if (!defined $smtp_ssl_cert_path) {
1433 # use the OpenSSL defaults
1434 return (SSL_verify_mode => SSL_VERIFY_PEER());
1437 if ($smtp_ssl_cert_path eq "") {
1438 return (SSL_verify_mode => SSL_VERIFY_NONE());
1439 } elsif (-d $smtp_ssl_cert_path) {
1440 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1441 SSL_ca_path => $smtp_ssl_cert_path);
1442 } elsif (-f $smtp_ssl_cert_path) {
1443 return (SSL_verify_mode => SSL_VERIFY_PEER(),
1444 SSL_ca_file => $smtp_ssl_cert_path);
1445 } else {
1446 die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1450 sub file_name_is_absolute {
1451 my ($path) = @_;
1453 # msys does not grok DOS drive-prefixes
1454 if ($^O eq 'msys') {
1455 return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1458 require File::Spec::Functions;
1459 return File::Spec::Functions::file_name_is_absolute($path);
1462 sub gen_header {
1463 my @recipients = unique_email_list(@to);
1464 @cc = (grep { my $cc = extract_valid_address_or_die($_);
1465 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1467 @cc);
1468 my $to = join (",\n\t", @recipients);
1469 @recipients = unique_email_list(@recipients,@cc,@initial_bcc);
1470 @recipients = (map { extract_valid_address_or_die($_) } @recipients);
1471 my $date = format_2822_time($time++);
1472 my $gitversion = '@@GIT_VERSION@@';
1473 if ($gitversion =~ m/..GIT_VERSION../) {
1474 $gitversion = Git::version();
1477 my $cc = join(",\n\t", unique_email_list(@cc));
1478 my $ccline = "";
1479 if ($cc ne '') {
1480 $ccline = "\nCc: $cc";
1482 make_message_id() unless defined($message_id);
1484 my $header = "From: $sender
1485 To: $to${ccline}
1486 Subject: $subject
1487 Date: $date
1488 Message-ID: $message_id
1490 if ($use_xmailer) {
1491 $header .= "X-Mailer: git-send-email $gitversion\n";
1493 if ($in_reply_to) {
1495 $header .= "In-Reply-To: $in_reply_to\n";
1496 $header .= "References: $references\n";
1498 if ($reply_to) {
1499 $header .= "Reply-To: $reply_to\n";
1501 if (@xh) {
1502 $header .= join("\n", @xh) . "\n";
1504 my $recipients_ref = \@recipients;
1505 return ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header);
1508 # Prepares the email, then asks the user what to do.
1510 # If the user chooses to send the email, it's sent and 1 is returned.
1511 # If the user chooses not to send the email, 0 is returned.
1512 # If the user decides they want to make further edits, -1 is returned and the
1513 # caller is expected to call send_message again after the edits are performed.
1515 # If an error occurs sending the email, this just dies.
1517 sub send_message {
1518 my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
1519 my @recipients = @$recipients_ref;
1521 my @sendmail_parameters = ('-i', @recipients);
1522 my $raw_from = $sender;
1523 if (defined $envelope_sender && $envelope_sender ne "auto") {
1524 $raw_from = $envelope_sender;
1526 $raw_from = extract_valid_address($raw_from);
1527 unshift (@sendmail_parameters,
1528 '-f', $raw_from) if(defined $envelope_sender);
1530 if ($needs_confirm && !$dry_run) {
1531 print "\n$header\n";
1532 if ($needs_confirm eq "inform") {
1533 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1534 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1535 print __ <<EOF ;
1536 The Cc list above has been expanded by additional
1537 addresses found in the patch commit message. By default
1538 send-email prompts before sending whenever this occurs.
1539 This behavior is controlled by the sendemail.confirm
1540 configuration setting.
1542 For additional information, run 'git send-email --help'.
1543 To retain the current behavior, but squelch this message,
1544 run 'git config --global sendemail.confirm auto'.
1548 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1549 # translation. The program will only accept English input
1550 # at this point.
1551 $_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1552 valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1553 default => $ask_default);
1554 die __("Send this email reply required") unless defined $_;
1555 if (/^n/i) {
1556 return 0;
1557 } elsif (/^e/i) {
1558 return -1;
1559 } elsif (/^q/i) {
1560 cleanup_compose_files();
1561 exit(0);
1562 } elsif (/^a/i) {
1563 $confirm = 'never';
1567 unshift (@sendmail_parameters, @smtp_server_options);
1569 if ($dry_run) {
1570 # We don't want to send the email.
1571 } elsif (defined $sendmail_cmd || file_name_is_absolute($smtp_server)) {
1572 my $pid = open my $sm, '|-';
1573 defined $pid or die $!;
1574 if (!$pid) {
1575 if (defined $sendmail_cmd) {
1576 exec ("sh", "-c", "$sendmail_cmd \"\$@\"", "-", @sendmail_parameters)
1577 or die $!;
1578 } else {
1579 exec ($smtp_server, @sendmail_parameters)
1580 or die $!;
1583 print $sm "$header\n$message";
1584 close $sm or die $!;
1585 } else {
1587 if (!defined $smtp_server) {
1588 die __("The required SMTP server is not properly defined.")
1591 require Net::SMTP;
1592 my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1593 $smtp_domain ||= maildomain();
1595 if ($smtp_encryption eq 'ssl') {
1596 $smtp_server_port ||= 465; # ssmtp
1597 require IO::Socket::SSL;
1599 # Suppress "variable accessed once" warning.
1601 no warnings 'once';
1602 $IO::Socket::SSL::DEBUG = 1;
1605 # Net::SMTP::SSL->new() does not forward any SSL options
1606 IO::Socket::SSL::set_client_defaults(
1607 ssl_verify_params());
1609 if ($use_net_smtp_ssl) {
1610 require Net::SMTP::SSL;
1611 $smtp ||= Net::SMTP::SSL->new($smtp_server,
1612 Hello => $smtp_domain,
1613 Port => $smtp_server_port,
1614 Debug => $debug_net_smtp);
1616 else {
1617 $smtp ||= Net::SMTP->new($smtp_server,
1618 Hello => $smtp_domain,
1619 Port => $smtp_server_port,
1620 Debug => $debug_net_smtp,
1621 SSL => 1);
1624 elsif (!$smtp) {
1625 $smtp_server_port ||= 25;
1626 $smtp ||= Net::SMTP->new($smtp_server,
1627 Hello => $smtp_domain,
1628 Debug => $debug_net_smtp,
1629 Port => $smtp_server_port);
1630 if ($smtp_encryption eq 'tls' && $smtp) {
1631 if ($use_net_smtp_ssl) {
1632 $smtp->command('STARTTLS');
1633 $smtp->response();
1634 if ($smtp->code != 220) {
1635 die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1637 require Net::SMTP::SSL;
1638 $smtp = Net::SMTP::SSL->start_SSL($smtp,
1639 ssl_verify_params())
1640 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1642 else {
1643 $smtp->starttls(ssl_verify_params())
1644 or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1646 # Send EHLO again to receive fresh
1647 # supported commands
1648 $smtp->hello($smtp_domain);
1652 if (!$smtp) {
1653 die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1654 " VALUES: server=$smtp_server ",
1655 "encryption=$smtp_encryption ",
1656 "hello=$smtp_domain",
1657 defined $smtp_server_port ? " port=$smtp_server_port" : "";
1660 smtp_auth_maybe or die $smtp->message;
1662 $smtp->mail( $raw_from ) or die $smtp->message;
1663 $smtp->to( @recipients ) or die $smtp->message;
1664 $smtp->data or die $smtp->message;
1665 $smtp->datasend("$header\n") or die $smtp->message;
1666 my @lines = split /^/, $message;
1667 foreach my $line (@lines) {
1668 $smtp->datasend("$line") or die $smtp->message;
1670 $smtp->dataend() or die $smtp->message;
1671 $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1673 if ($quiet) {
1674 printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
1675 } else {
1676 print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
1677 if (!defined $sendmail_cmd && !file_name_is_absolute($smtp_server)) {
1678 print "Server: $smtp_server\n";
1679 print "MAIL FROM:<$raw_from>\n";
1680 foreach my $entry (@recipients) {
1681 print "RCPT TO:<$entry>\n";
1683 } else {
1684 my $sm;
1685 if (defined $sendmail_cmd) {
1686 $sm = $sendmail_cmd;
1687 } else {
1688 $sm = $smtp_server;
1691 print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1693 print $header, "\n";
1694 if ($smtp) {
1695 print __("Result: "), $smtp->code, ' ',
1696 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1697 } else {
1698 print __("Result: OK\n");
1702 return 1;
1705 sub pre_process_file {
1706 my ($t, $quiet) = @_;
1708 open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1710 my $author = undef;
1711 my $sauthor = undef;
1712 my $author_encoding;
1713 my $has_content_type;
1714 my $body_encoding;
1715 my $xfer_encoding;
1716 my $has_mime_version;
1717 @to = ();
1718 @cc = ();
1719 @xh = ();
1720 my $input_format = undef;
1721 my @header = ();
1722 $subject = $initial_subject;
1723 $message = "";
1724 $message_num++;
1725 undef $message_id;
1726 # Retrieve and unfold header fields.
1727 my @header_lines = ();
1728 while(<$fh>) {
1729 last if /^\s*$/;
1730 push(@header_lines, $_);
1732 @header = unfold_headers(@header_lines);
1733 # Add computed headers, if applicable.
1734 unless ($no_header_cmd || ! $header_cmd) {
1735 push @header, invoke_header_cmd($header_cmd, $t);
1737 # Now parse the header
1738 foreach(@header) {
1739 if (/^From /) {
1740 $input_format = 'mbox';
1741 next;
1743 chomp;
1744 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1745 $input_format = 'mbox';
1748 if (defined $input_format && $input_format eq 'mbox') {
1749 if (/^Subject:\s+(.*)$/i) {
1750 $subject = $1;
1752 elsif (/^From:\s+(.*)$/i) {
1753 ($author, $author_encoding) = unquote_rfc2047($1);
1754 $sauthor = sanitize_address($author);
1755 next if $suppress_cc{'author'};
1756 next if $suppress_cc{'self'} and $sauthor eq $sender;
1757 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1758 $1, $_) unless $quiet;
1759 push @cc, $1;
1761 elsif (/^To:\s+(.*)$/i) {
1762 foreach my $addr (parse_address_line($1)) {
1763 printf(__("(mbox) Adding to: %s from line '%s'\n"),
1764 $addr, $_) unless $quiet;
1765 push @to, $addr;
1768 elsif (/^Cc:\s+(.*)$/i) {
1769 foreach my $addr (parse_address_line($1)) {
1770 my $qaddr = unquote_rfc2047($addr);
1771 my $saddr = sanitize_address($qaddr);
1772 if ($saddr eq $sender) {
1773 next if ($suppress_cc{'self'});
1774 } else {
1775 next if ($suppress_cc{'cc'});
1777 printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1778 $addr, $_) unless $quiet;
1779 push @cc, $addr;
1782 elsif (/^Content-type:/i) {
1783 $has_content_type = 1;
1784 if (/charset="?([^ "]+)/) {
1785 $body_encoding = $1;
1787 push @xh, $_;
1789 elsif (/^MIME-Version/i) {
1790 $has_mime_version = 1;
1791 push @xh, $_;
1793 elsif (/^Message-ID: (.*)/i) {
1794 $message_id = $1;
1796 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1797 $xfer_encoding = $1 if not defined $xfer_encoding;
1799 elsif (/^In-Reply-To: (.*)/i) {
1800 if (!$initial_in_reply_to || $thread) {
1801 $in_reply_to = $1;
1804 elsif (/^References: (.*)/i) {
1805 if (!$initial_in_reply_to || $thread) {
1806 $references = $1;
1809 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1810 push @xh, $_;
1812 } else {
1813 # In the traditional
1814 # "send lots of email" format,
1815 # line 1 = cc
1816 # line 2 = subject
1817 # So let's support that, too.
1818 $input_format = 'lots';
1819 if (@cc == 0 && !$suppress_cc{'cc'}) {
1820 printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1821 $_, $_) unless $quiet;
1822 push @cc, $_;
1823 } elsif (!defined $subject) {
1824 $subject = $_;
1828 # Now parse the message body
1829 while(<$fh>) {
1830 $message .= $_;
1831 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1832 chomp;
1833 my ($what, $c) = ($1, $2);
1834 # strip garbage for the address we'll use:
1835 $c = strip_garbage_one_address($c);
1836 # sanitize a bit more to decide whether to suppress the address:
1837 my $sc = sanitize_address($c);
1838 if ($sc eq $sender) {
1839 next if ($suppress_cc{'self'});
1840 } else {
1841 if ($what =~ /^Signed-off-by$/i) {
1842 next if $suppress_cc{'sob'};
1843 } elsif ($what =~ /-by$/i) {
1844 next if $suppress_cc{'misc-by'};
1845 } elsif ($what =~ /Cc/i) {
1846 next if $suppress_cc{'bodycc'};
1849 if ($c !~ /.+@.+|<.+>/) {
1850 printf("(body) Ignoring %s from line '%s'\n",
1851 $what, $_) unless $quiet;
1852 next;
1854 push @cc, $c;
1855 printf(__("(body) Adding cc: %s from line '%s'\n"),
1856 $c, $_) unless $quiet;
1859 close $fh;
1861 push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t, $quiet)
1862 if defined $to_cmd;
1863 push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1864 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1866 if ($broken_encoding{$t} && !$has_content_type) {
1867 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1868 $has_content_type = 1;
1869 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1870 $body_encoding = $auto_8bit_encoding;
1873 if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1874 $subject = quote_subject($subject, $auto_8bit_encoding);
1877 if (defined $sauthor and $sauthor ne $sender) {
1878 $message = "From: $author\n\n$message";
1879 if (defined $author_encoding) {
1880 if ($has_content_type) {
1881 if ($body_encoding eq $author_encoding) {
1882 # ok, we already have the right encoding
1884 else {
1885 # uh oh, we should re-encode
1888 else {
1889 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1890 $has_content_type = 1;
1891 push @xh,
1892 "Content-Type: text/plain; charset=$author_encoding";
1896 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1897 ($message, $xfer_encoding) = apply_transfer_encoding(
1898 $message, $xfer_encoding, $target_xfer_encoding);
1899 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1900 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1902 $needs_confirm = (
1903 $confirm eq "always" or
1904 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1905 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1906 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1908 @to = process_address_list(@to);
1909 @cc = process_address_list(@cc);
1911 @to = (@initial_to, @to);
1912 @cc = (@initial_cc, @cc);
1914 if ($message_num == 1) {
1915 if (defined $cover_cc and $cover_cc) {
1916 @initial_cc = @cc;
1918 if (defined $cover_to and $cover_to) {
1919 @initial_to = @to;
1924 # Prepares the email, prompts the user, and sends it out
1925 # Returns 0 if an edit was done and the function should be called again, or 1
1926 # on the email being successfully sent out.
1927 sub process_file {
1928 my ($t) = @_;
1930 pre_process_file($t, $quiet);
1932 my $message_was_sent = send_message();
1933 if ($message_was_sent == -1) {
1934 do_edit($t);
1935 return 0;
1938 # set up for the next message
1939 if ($thread) {
1940 if ($message_was_sent &&
1941 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1942 $message_num == 1)) {
1943 $in_reply_to = $message_id;
1944 if (length $references > 0) {
1945 $references .= "\n $message_id";
1946 } else {
1947 $references = "$message_id";
1950 } elsif (!defined $initial_in_reply_to) {
1951 # --thread and --in-reply-to manage the "In-Reply-To" header and by
1952 # extension the "References" header. If these commands are not used, reset
1953 # the header values to their defaults.
1954 $in_reply_to = undef;
1955 $references = '';
1957 $message_id = undef;
1958 $num_sent++;
1959 if (defined $batch_size && $num_sent == $batch_size) {
1960 $num_sent = 0;
1961 $smtp->quit if defined $smtp;
1962 undef $smtp;
1963 undef $auth;
1964 sleep($relogin_delay) if defined $relogin_delay;
1967 return 1;
1970 sub initialize_modified_loop_vars {
1971 $in_reply_to = $initial_in_reply_to;
1972 $references = $initial_in_reply_to || '';
1973 $message_num = 0;
1976 if ($validate) {
1977 # FIFOs can only be read once, exclude them from validation.
1978 my @real_files = ();
1979 foreach my $f (@files) {
1980 unless (-p $f) {
1981 push(@real_files, $f);
1985 # Run the loop once again to avoid gaps in the counter due to FIFO
1986 # arguments provided by the user.
1987 my $num = 1;
1988 my $num_files = scalar @real_files;
1989 $ENV{GIT_SENDEMAIL_FILE_TOTAL} = "$num_files";
1990 initialize_modified_loop_vars();
1991 foreach my $r (@real_files) {
1992 $ENV{GIT_SENDEMAIL_FILE_COUNTER} = "$num";
1993 pre_process_file($r, 1);
1994 validate_patch($r, $target_xfer_encoding);
1995 $num += 1;
1997 delete $ENV{GIT_SENDEMAIL_FILE_COUNTER};
1998 delete $ENV{GIT_SENDEMAIL_FILE_TOTAL};
2001 initialize_modified_loop_vars();
2002 foreach my $t (@files) {
2003 while (!process_file($t)) {
2004 # user edited the file
2008 # Execute a command and return its output lines as an array. Blank
2009 # lines which do not appear at the end of the output are reported as
2010 # errors.
2011 sub execute_cmd {
2012 my ($prefix, $cmd, $file) = @_;
2013 my @lines = ();
2014 my $seen_blank_line = 0;
2015 open my $fh, "-|", "$cmd \Q$file\E"
2016 or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
2017 while (my $line = <$fh>) {
2018 die sprintf(__("(%s) Malformed output from '%s'"), $prefix, $cmd)
2019 if $seen_blank_line;
2020 if ($line =~ /^$/) {
2021 $seen_blank_line = $line =~ /^$/;
2022 next;
2024 push @lines, $line;
2026 close $fh
2027 or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2028 return @lines;
2031 # Process headers lines, unfolding multiline headers as defined by RFC
2032 # 2822.
2033 sub unfold_headers {
2034 my @headers;
2035 foreach(@_) {
2036 last if /^\s*$/;
2037 if (/^\s+\S/ and @headers) {
2038 chomp($headers[$#headers]);
2039 s/^\s+/ /;
2040 $headers[$#headers] .= $_;
2041 } else {
2042 push(@headers, $_);
2045 return @headers;
2048 # Invoke the provided CMD with FILE as an argument, which should
2049 # output RFC 2822 email headers. Fold multiline headers and return the
2050 # headers as an array.
2051 sub invoke_header_cmd {
2052 my ($cmd, $file) = @_;
2053 my @lines = execute_cmd("header-cmd", $header_cmd, $file);
2054 return unfold_headers(@lines);
2057 # Execute a command (e.g. $to_cmd) to get a list of email addresses
2058 # and return a results array
2059 sub recipients_cmd {
2060 my ($prefix, $what, $cmd, $file, $quiet) = @_;
2061 my @lines = ();
2062 my @addresses = ();
2064 @lines = execute_cmd($prefix, $cmd, $file);
2065 for my $address (@lines) {
2066 $address =~ s/^\s*//g;
2067 $address =~ s/\s*$//g;
2068 $address = sanitize_address($address);
2069 next if ($address eq $sender and $suppress_cc{'self'});
2070 push @addresses, $address;
2071 printf(__("(%s) Adding %s: %s from: '%s'\n"),
2072 $prefix, $what, $address, $cmd) unless $quiet;
2074 return @addresses;
2077 cleanup_compose_files();
2079 sub cleanup_compose_files {
2080 unlink($compose_filename, $compose_filename . ".final") if $compose;
2083 $smtp->quit if $smtp;
2085 sub apply_transfer_encoding {
2086 my $message = shift;
2087 my $from = shift;
2088 my $to = shift;
2090 return ($message, $to) if ($from eq $to and $from ne '7bit');
2092 require MIME::QuotedPrint;
2093 require MIME::Base64;
2095 $message = MIME::QuotedPrint::decode($message)
2096 if ($from eq 'quoted-printable');
2097 $message = MIME::Base64::decode($message)
2098 if ($from eq 'base64');
2100 $to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2101 if $to eq 'auto';
2103 die __("cannot send message as 7bit")
2104 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2105 return ($message, $to)
2106 if ($to eq '7bit' or $to eq '8bit');
2107 return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2108 if ($to eq 'quoted-printable');
2109 return (MIME::Base64::encode($message, "\n"), $to)
2110 if ($to eq 'base64');
2111 die __("invalid transfer encoding");
2114 sub unique_email_list {
2115 my %seen;
2116 my @emails;
2118 foreach my $entry (@_) {
2119 my $clean = extract_valid_address_or_die($entry);
2120 $seen{$clean} ||= 0;
2121 next if $seen{$clean}++;
2122 push @emails, $entry;
2124 return @emails;
2127 sub validate_patch {
2128 my ($fn, $xfer_encoding) = @_;
2130 if ($repo) {
2131 my $hook_name = 'sendemail-validate';
2132 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2133 require File::Spec;
2134 my $validate_hook = File::Spec->catfile($hooks_path, $hook_name);
2135 my $hook_error;
2136 if (-x $validate_hook) {
2137 require Cwd;
2138 my $target = Cwd::abs_path($fn);
2139 # The hook needs a correct cwd and GIT_DIR.
2140 my $cwd_save = Cwd::getcwd();
2141 chdir($repo->wc_path() or $repo->repo_path())
2142 or die("chdir: $!");
2143 local $ENV{"GIT_DIR"} = $repo->repo_path();
2145 my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
2147 require File::Temp;
2148 my ($header_filehandle, $header_filename) = File::Temp::tempfile(
2149 TEMPLATE => ".gitsendemail.header.XXXXXX",
2150 DIR => $repo->repo_path(),
2151 UNLINK => 1,
2153 print $header_filehandle $header;
2155 my @cmd = ("git", "hook", "run", "--ignore-missing",
2156 $hook_name, "--");
2157 my @cmd_msg = (@cmd, "<patch>", "<header>");
2158 my @cmd_run = (@cmd, $target, $header_filename);
2159 $hook_error = system_or_msg(\@cmd_run, undef, "@cmd_msg");
2160 chdir($cwd_save) or die("chdir: $!");
2162 if ($hook_error) {
2163 $hook_error = sprintf(
2164 __("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2165 $fn, $hook_name, $hook_error);
2166 die $hook_error;
2170 # Any long lines will be automatically fixed if we use a suitable transfer
2171 # encoding.
2172 unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2173 open(my $fh, '<', $fn)
2174 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2175 while (my $line = <$fh>) {
2176 if (length($line) > 998) {
2177 die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2178 "warning: no patches were sent\n"), $fn, $.);
2182 return;
2185 sub handle_backup {
2186 my ($last, $lastlen, $file, $known_suffix) = @_;
2187 my ($suffix, $skip);
2189 $skip = 0;
2190 if (defined $last &&
2191 ($lastlen < length($file)) &&
2192 (substr($file, 0, $lastlen) eq $last) &&
2193 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2194 if (defined $known_suffix && $suffix eq $known_suffix) {
2195 printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2196 $skip = 1;
2197 } else {
2198 # TRANSLATORS: please keep "[y|N]" as is.
2199 my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2200 valid_re => qr/^(?:y|n)/i,
2201 default => 'n');
2202 $skip = ($answer ne 'y');
2203 if ($skip) {
2204 $known_suffix = $suffix;
2208 return ($skip, $known_suffix);
2211 sub handle_backup_files {
2212 my @file = @_;
2213 my ($last, $lastlen, $known_suffix, $skip, @result);
2214 for my $file (@file) {
2215 ($skip, $known_suffix) = handle_backup($last, $lastlen,
2216 $file, $known_suffix);
2217 push @result, $file unless $skip;
2218 $last = $file;
2219 $lastlen = length($file);
2221 return @result;
2224 sub file_has_nonascii {
2225 my $fn = shift;
2226 open(my $fh, '<', $fn)
2227 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2228 while (my $line = <$fh>) {
2229 return 1 if $line =~ /[^[:ascii:]]/;
2231 return 0;
2234 sub body_or_subject_has_nonascii {
2235 my $fn = shift;
2236 open(my $fh, '<', $fn)
2237 or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2238 while (my $line = <$fh>) {
2239 last if $line =~ /^$/;
2240 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2242 while (my $line = <$fh>) {
2243 return 1 if $line =~ /[^[:ascii:]]/;
2245 return 0;