3 # Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4 # Copyright 2005 Ryan Anderson <ryan@michonline.com>
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.
21 use warnings
$ENV{GIT_PERL_FATAL_WARNINGS
} ?
qw(FATAL all) : ();
23 use Git
::LoadCPAN
::Error
qw(:try);
27 Getopt
::Long
::Configure qw
/ pass_through /;
31 git send-email' [<options>] <file|directory>
32 git send-email' [<options>] <format-patch options>
33 git send-email --dump-aliases
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)
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
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
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
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.
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.
101 --dump-aliases * Dump configured aliases and exit.
109 grep !$seen{$_}++, @_;
112 sub completion_helper
{
113 my ($original_opts) = @_;
114 my %not_for_completion = (
115 "git-completion-helper" => undef,
118 my @send_email_opts = ();
120 foreach my $key (keys %$original_opts) {
121 unless (exists $not_for_completion{$key}) {
124 if ($key =~ /[:=][si]$/) {
125 $key =~ s/[:=][si]$//;
126 push (@send_email_opts, "--$_=") foreach (split (/\|/, $key));
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.
141 # most mail servers generate the Date: header, but not all...
142 sub format_2822_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]) {
153 } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
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]],
168 qw(Jan Feb Mar Apr May Jun
169 Jul Aug Sep Oct Nov Dec)[$localtm[4]],
174 ($offset >= 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
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);
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);
209 my $compose_filename;
211 my $dump_aliases = 0;
213 # Variables to prevent short format-patch options from being captured
214 # as abbreviated send-email options
217 # Handle interactive edition of files.
222 my ($args, $msg, $cmd_name) = @_;
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);
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
236 return sprintf($msg, @sprintf_args);
238 return sprintf(__
("fatal: command '%s' died with exit code %d"),
243 my $msg = system_or_msg
(@_);
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 @_;
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);
269 my ($auto_8bit_encoding);
270 my ($compose_encoding);
272 # Variables with corresponding config settings & hardcoded defaults
273 my ($debug_net_smtp) = 0; # Net::SMTP, see send_message()
275 my $chain_reply_to = 0;
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,
311 "headercmd" => \
$header_cmd,
312 "aliasfiletype" => \
$aliasfiletype,
313 "bcc" => \
@config_bcc,
314 "suppresscc" => \
@suppress_cc,
315 "envelopesender" => \
$envelope_sender,
316 "confirm" => \
$confirm,
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
332 require Term
::ANSIColor
;
333 print Term
::ANSIColor
::color
("reset"), "\n";
335 # SMTP password masked
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"),
345 if (-e
($compose_filename . ".final")) {
346 printf __
("'%s.final' contains the composed email.\n"),
354 $SIG{TERM
} = \
&signal_handler
;
355 $SIG{INT
} = \
&signal_handler
;
357 # Read our sendemail.* 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}++;
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);
382 next if $configured->{$setting}++;
386 my $v = Git
::config_path
(@repo, "$prefix.$setting");
387 next unless defined $v;
388 next if $configured->{$setting}++;
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}++;
404 my $v = $known_keys->{$key}->[-1];
405 next unless defined $v;
406 next if $configured->{$setting}++;
416 my $ret = Git
::command
(
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;
431 # If we have no keys we're OK, otherwise re-throw
432 die $@
if $@
->value != 1;
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);
459 undef $identity if $no_identity;
461 # Now we know enough to read the config
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:
472 my $git_completion_helper;
473 my %dump_aliases_options = (
475 "dump-aliases" => \
$dump_aliases,
477 $rc = GetOptions
(%dump_aliases_options);
479 die __
("--dump-aliases incompatible with other options\n")
480 if !$help and $dump_aliases and @ARGV;
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,
489 "cc=s" => \
@getopt_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,
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,
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);
552 my %all_options = (%options, %dump_aliases_options, %identity_options);
553 completion_helper
(\
%all_options) if $git_completion_helper;
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
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.
616 print "suppressions:\n";
617 foreach my $entry (keys %suppress_cc) {
618 printf " %-5s -> $suppress_cc{$entry}\n", $entry;
622 my ($repoauthor, $repocommitter);
625 my ($author, $committer);
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]);
642 require Text
::ParseWords
;
643 return Text
::ParseWords
::quotewords
('\s*,\s*', 1, @_);
648 sub parse_sendmail_alias
{
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"), $_;
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) ];
660 printf STDERR __
("warning: sendmail line is not recognized: %s\n"), $_;
664 sub parse_sendmail_aliases
{
669 next if /^\s*$/ || /^\s*#/;
670 $s .= $_, next if $s =~ s/\\$// || s/^\s+//;
671 parse_sendmail_alias
($s) if $s;
674 $s =~ s/\\$//; # silently tolerate stray '\' on last line
675 parse_sendmail_alias
($s) if $s;
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
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) ];
698 pine
=> sub { my $fh = shift; my $f='\t[^\t]*';
699 for (my $x = ''; defined($x); $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;
707 if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
708 my ($alias, $addr) = ($1, $2);
709 $aliases{$alias} = [ split_addrs
($addr) ];
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
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);
730 print "$_\n" for (sort keys %aliases);
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
{
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.
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.
760 while (defined(my $f = shift @ARGV)) {
762 push @rev_list_opts, "--", @ARGV;
764 } elsif (-d
$f and !is_format_patch_arg
($f)) {
766 or die sprintf(__
("Failed to opendir %s: %s"), $f, $!);
769 push @files, grep { -f
$_ } map { File
::Spec
->catfile($f, $_) }
772 } elsif ((-f
$f or -p
$f) and !is_format_patch_arg
($f)) {
775 push @rev_list_opts, $f;
779 if (@rev_list_opts) {
780 die __
("Cannot run git format-patch from outside a repository\n")
783 push @files, $repo->command('format-patch', '-o', File
::Temp
::tempdir
(CLEANUP
=> 1),
784 defined $reroll_count ?
('-v', $reroll_count) : (),
788 if (defined $sender) {
789 $sender =~ s/^\s+|\s+$//g;
790 ($sender) = expand_aliases
($sender);
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;
803 # FIFOs can only be read once, exclude them from validation.
805 foreach my $f (@files) {
807 push(@real_files, $f);
811 # Run the loop once again to avoid gaps in the counter due to FIFO
812 # arguments provided by the user.
814 my $num_files = scalar @real_files;
815 $ENV{GIT_SENDEMAIL_FILE_TOTAL
} = "$num_files";
816 foreach my $r (@real_files) {
817 $ENV{GIT_SENDEMAIL_FILE_COUNTER
} = "$num";
818 pre_process_file
($r, 1);
819 validate_patch
($r, $target_xfer_encoding);
822 delete $ENV{GIT_SENDEMAIL_FILE_COUNTER
};
823 delete $ENV{GIT_SENDEMAIL_FILE_TOTAL
};
826 @files = handle_backup_files
(@files);
830 print $_,"\n" for (@files);
833 print STDERR __
("\nNo patch files specified!\n\n");
837 sub get_patch_subject
{
839 open (my $fh, '<', $fn);
840 while (my $line = <$fh>) {
841 next unless ($line =~ /^Subject: (.*)$/);
846 die sprintf(__
("No subject line in %s?"), $fn);
850 # Note that this does not need to be secure, but we will make a small
851 # effort to have it be unique
853 $compose_filename = ($repo ?
854 File
::Temp
::tempfile
(".gitsendemail.msg.XXXXXX", DIR
=> $repo->repo_path()) :
855 File
::Temp
::tempfile
(".gitsendemail.msg.XXXXXX", DIR
=> "."))[1];
856 open my $c, ">", $compose_filename
857 or die sprintf(__
("Failed to open for writing %s: %s"), $compose_filename, $!);
860 my $tpl_sender = $sender || $repoauthor->() || $repocommitter->() || '';
861 my $tpl_subject = $initial_subject || '';
862 my $tpl_in_reply_to = $initial_in_reply_to || '';
863 my $tpl_reply_to = $reply_to || '';
865 print $c <<EOT1, Git::prefix_lines("GIT: ", __(<<EOT2)), <<EOT3;
866 From $tpl_sender # This line is ignored.
868 Lines beginning in "GIT:" will be removed.
869 Consider including an overall diffstat or table of contents
870 for the patch you are writing.
872 Clear the body content if you don't wish to send a summary.
875 Reply-To: $tpl_reply_to
876 Subject: $tpl_subject
877 In-Reply-To: $tpl_in_reply_to
881 print $c get_patch_subject($f);
886 do_edit($compose_filename, @files);
888 do_edit($compose_filename);
891 open $c, "<", $compose_filename
892 or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
894 if (!defined $compose_encoding) {
895 $compose_encoding = "UTF-8";
899 while (my $line = <$c>) {
900 next if $line =~ m/^GIT:/;
901 parse_header_line($line, \%parsed_email);
903 $parsed_email{'body'} = filter_body($c);
908 open my $c2, ">", $compose_filename . ".final"
909 or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
912 if ($parsed_email{'From'}) {
913 $sender = delete($parsed_email{'From'});
915 if ($parsed_email{'In-Reply-To'}) {
916 $initial_in_reply_to = delete($parsed_email{'In-Reply-To'});
918 if ($parsed_email{'Reply-To'}) {
919 $reply_to = delete($parsed_email{'Reply-To'});
921 if ($parsed_email{'Subject'}) {
922 $initial_subject = delete($parsed_email{'Subject'});
923 print $c2 "Subject: " .
924 quote_subject($initial_subject, $compose_encoding) .
928 if ($parsed_email{'MIME-Version'}) {
929 print $c2 "MIME-Version: $parsed_email{'MIME-Version'}\n",
930 "Content-Type: $parsed_email{'Content-Type'};\n",
931 "Content-Transfer-Encoding: $parsed_email{'Content-Transfer-Encoding'}\n";
932 delete($parsed_email{'MIME-Version'});
933 delete($parsed_email{'Content-Type'});
934 delete($parsed_email{'Content-Transfer-Encoding'});
935 } elsif (file_has_nonascii($compose_filename)) {
936 my $content_type = (delete($parsed_email{'Content-Type'}) or
937 "text/plain; charset=$compose_encoding");
938 print $c2 "MIME-Version: 1.0\n",
939 "Content-Type: $content_type\n",
940 "Content-Transfer-Encoding: 8bit\n";
942 # Preserve unknown headers
943 foreach my $key (keys %parsed_email) {
944 next if $key eq 'body';
945 print $c2 "$key: $parsed_email{$key}";
948 if ($parsed_email{'body'}) {
949 print $c2 "\n$parsed_email{'body'}\n";
950 delete($parsed_email{'body'});
952 print __("Summary email is empty, skipping it\n");
958 } elsif ($annotate) {
963 require Term::ReadLine;
964 return $ENV{"GIT_SEND_EMAIL_NOTTY"}
965 ? Term::ReadLine->new('git-send-email', \*STDIN, \*STDOUT)
966 : Term::ReadLine->new('git-send-email');
970 my ($prompt, %arg) = @_;
971 my $valid_re = $arg{valid_re};
972 my $default = $arg{default};
973 my $confirm_only = $arg{confirm_only};
977 return defined $default ? $default : undef
978 unless defined $term->IN and defined fileno($term->IN) and
979 defined $term->OUT and defined fileno($term->OUT);
981 $resp = $term->readline($prompt);
982 if (!defined $resp) { # EOF
984 return defined $default ? $default : undef;
986 if ($resp eq '' and defined $default) {
989 if (!defined $valid_re or $resp =~ /$valid_re/) {
993 my $yesno = $term->readline(
994 # TRANSLATORS: please keep [y/N] as is.
995 sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
996 if (defined $yesno && $yesno =~ /y/i) {
1004 sub parse_header_line {
1006 my $parsed_line = shift;
1007 my $addr_pat = join "|", qw(To Cc Bcc);
1009 foreach (split(/\n/, $lines)) {
1010 if (/^($addr_pat):\s*(.+)$/i) {
1011 $parsed_line->{$1} = [ parse_address_line
($2) ];
1012 } elsif (/^([^:]*):\s*(.+)\s*$/i) {
1013 $parsed_line->{$1} = $2;
1021 while (my $body_line = <$c>) {
1022 if ($body_line !~ m/^GIT:/) {
1023 $body .= $body_line;
1030 my %broken_encoding;
1032 sub file_declares_8bit_cte
{
1034 open (my $fh, '<', $fn);
1035 while (my $line = <$fh>) {
1036 last if ($line =~ /^$/);
1037 return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
1043 foreach my $f (@files) {
1044 next unless (body_or_subject_has_nonascii
($f)
1045 && !file_declares_8bit_cte
($f));
1046 $broken_encoding{$f} = 1;
1049 if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
1050 print __
("The following files are 8bit, but do not declare " .
1051 "a Content-Transfer-Encoding.\n");
1052 foreach my $f (sort keys %broken_encoding) {
1055 $auto_8bit_encoding = ask
(__
("Which 8bit encoding should I declare [UTF-8]? "),
1056 valid_re
=> qr/.{4}/, confirm_only
=> 1,
1057 default => "UTF-8");
1061 for my $f (@files) {
1062 if (get_patch_subject
($f) =~ /\Q*** SUBJECT HERE ***\E/) {
1063 die sprintf(__
("Refusing to send because the patch\n\t%s\n"
1064 . "has the template subject '*** SUBJECT HERE ***'. "
1065 . "Pass --force if you really want to send.\n"), $f);
1070 my $to_whom = __
("To whom should the emails be sent (if anyone)?");
1072 if (!@initial_to && !defined $to_cmd) {
1073 my $to = ask
("$to_whom ",
1075 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
1076 push @initial_to, parse_address_line
($to) if defined $to; # sanitized/validated later
1080 sub expand_aliases
{
1081 return map { expand_one_alias
($_) } @_;
1084 my %EXPANDED_ALIASES;
1085 sub expand_one_alias
{
1087 if ($EXPANDED_ALIASES{$alias}) {
1088 die sprintf(__
("fatal: alias '%s' expands to itself\n"), $alias);
1090 local $EXPANDED_ALIASES{$alias} = 1;
1091 return $aliases{$alias} ? expand_aliases
(@
{$aliases{$alias}}) : $alias;
1094 @initial_to = process_address_list
(@initial_to);
1095 @initial_cc = process_address_list
(@initial_cc);
1096 @initial_bcc = process_address_list
(@initial_bcc);
1098 if ($thread && !defined $initial_in_reply_to && $prompting) {
1099 $initial_in_reply_to = ask
(
1100 __
("Message-ID to be used as In-Reply-To for the first email (if any)? "),
1102 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
1104 if (defined $initial_in_reply_to) {
1105 $initial_in_reply_to =~ s/^\s*<?//;
1106 $initial_in_reply_to =~ s/>?\s*$//;
1107 $initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
1110 if (defined $reply_to) {
1111 $reply_to =~ s/^\s+|\s+$//g;
1112 ($reply_to) = expand_aliases
($reply_to);
1113 $reply_to = sanitize_address
($reply_to);
1116 if (!defined $sendmail_cmd && !defined $smtp_server) {
1117 my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1118 push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH
};
1119 foreach (@sendmail_paths) {
1126 if (!defined $sendmail_cmd) {
1127 $smtp_server = 'localhost'; # could be 127.0.0.1, too... *shrug*
1131 if ($compose && $compose > 0) {
1132 @files = ($compose_filename . ".final", @files);
1135 # Variables we set as part of the loop over files
1136 our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
1137 $needs_confirm, $message_num, $ask_default);
1139 sub extract_valid_address
{
1140 my $address = shift;
1141 my $local_part_regexp = qr/[^<>"\s@]+/;
1142 my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
1144 # check for a local address:
1145 return $address if ($address =~ /^($local_part_regexp)$/);
1147 $address =~ s/^\s*<(.*)>\s*$/$1/;
1148 my $have_email_valid = eval { require Email
::Valid
; 1 };
1149 if ($have_email_valid) {
1150 return scalar Email
::Valid
->address($address);
1153 # less robust/correct than the monster regexp in Email::Valid,
1154 # but still does a 99% job, and one less dependency
1155 return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1159 sub extract_valid_address_or_die
{
1160 my $address = shift;
1161 $address = extract_valid_address
($address);
1162 die sprintf(__
("error: unable to extract a valid address from: %s\n"), $address)
1167 sub validate_address
{
1168 my $address = shift;
1169 while (!extract_valid_address
($address)) {
1170 printf STDERR __
("error: unable to extract a valid address from: %s\n"), $address;
1171 # TRANSLATORS: Make sure to include [q] [d] [e] in your
1172 # translation. The program will only accept English input
1174 $_ = ask
(__
("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1175 valid_re
=> qr/^(?:quit|q|drop|d|edit|e)/i,
1180 cleanup_compose_files
();
1183 $address = ask
("$to_whom ",
1185 valid_re
=> qr/\@.*\./, confirm_only
=> 1);
1190 sub validate_address_list
{
1191 return (grep { defined $_ }
1192 map { validate_address
($_) } @_);
1195 # Usually don't need to change anything below here.
1197 # we make a "fake" message id by taking the current number
1198 # of seconds since the beginning of Unix time and tacking on
1199 # a random number to the end, in case we are called quicker than
1200 # 1 second since the last time we were called.
1202 # We'll setup a template for the message id, using the "from" address:
1204 my ($message_id_stamp, $message_id_serial);
1205 sub make_message_id
{
1207 if (!defined $message_id_stamp) {
1209 $message_id_stamp = POSIX
::strftime
("%Y%m%d%H%M%S.$$", gmtime(time));
1210 $message_id_serial = 0;
1212 $message_id_serial++;
1213 $uniq = "$message_id_stamp-$message_id_serial";
1216 for ($sender, $repocommitter->(), $repoauthor->()) {
1217 $du_part = extract_valid_address
(sanitize_address
($_));
1218 last if (defined $du_part and $du_part ne '');
1220 if (not defined $du_part or $du_part eq '') {
1221 require Sys
::Hostname
;
1222 $du_part = 'user@' . Sys
::Hostname
::hostname
();
1224 my $message_id_template = "<%s-%s>";
1225 $message_id = sprintf($message_id_template, $uniq, $du_part);
1226 #print "new message id = $message_id\n"; # Was useful for debugging
1229 sub unquote_rfc2047
{
1232 my $sep = qr/[ \t]+/;
1233 s
{$re_encoded_word(?
:$sep$re_encoded_word)*}{
1234 my @words = split $sep, $&;
1236 m/$re_encoded_word/;
1240 if ($encoding eq 'q' || $encoding eq 'Q') {
1243 s/=([0-9A-F]{2})/chr(hex($1))/egi;
1245 # other encodings not supported yet
1250 return wantarray ?
($_, $charset) : $_;
1255 my $encoding = shift || 'UTF-8';
1256 s/([^-a-zA-Z0-9!*+\/])/sprintf
("=%02X", ord($1))/eg
;
1257 s/(.*)/=\?$encoding\?q\?$1\?=/;
1261 sub is_rfc2047_quoted
{
1264 $s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1267 sub subject_needs_rfc2047_quoting
{
1270 return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1274 local $subject = shift;
1275 my $encoding = shift || 'UTF-8';
1277 if (subject_needs_rfc2047_quoting
($subject)) {
1278 return quote_rfc2047
($subject, $encoding);
1283 # use the simplest quoting being able to handle the recipient
1284 sub sanitize_address
{
1285 my ($recipient) = @_;
1287 # remove garbage after email address
1288 $recipient =~ s/(.*>).*$/$1/;
1290 my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1292 if (not $recipient_name) {
1296 # if recipient_name is already quoted, do nothing
1297 if (is_rfc2047_quoted
($recipient_name)) {
1301 # remove non-escaped quotes
1302 $recipient_name =~ s/(^|[^\\])"/$1/g;
1304 # rfc2047 is needed if a non-ascii char is included
1305 if ($recipient_name =~ /[^[:ascii:]]/) {
1306 $recipient_name = quote_rfc2047
($recipient_name);
1309 # double quotes are needed if specials or CTLs are included
1310 elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1311 $recipient_name =~ s/([\\\r])/\\$1/g;
1312 $recipient_name = qq["$recipient_name"];
1315 return "$recipient_name $recipient_addr";
1319 sub strip_garbage_one_address
{
1322 if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1323 # "Foo Bar" <foobar@example.com> [possibly garbage here]
1324 # Foo Bar <foobar@example.com> [possibly garbage here]
1327 if ($addr =~ /^(<[^>]*>).*/) {
1328 # <foo@example.com> [possibly garbage here]
1329 # if garbage contains other addresses, they are ignored.
1332 if ($addr =~ /^([^"#,\s]*)/) {
1333 # address without quoting: remove anything after the address
1339 sub sanitize_address_list
{
1340 return (map { sanitize_address
($_) } @_);
1343 sub process_address_list
{
1344 my @addr_list = map { parse_address_line
($_) } @_;
1345 @addr_list = expand_aliases
(@addr_list);
1346 @addr_list = sanitize_address_list
(@addr_list);
1347 @addr_list = validate_address_list
(@addr_list);
1351 # Returns the local Fully Qualified Domain Name (FQDN) if available.
1353 # Tightly configured MTAa require that a caller sends a real DNS
1354 # domain name that corresponds the IP address in the HELO/EHLO
1355 # handshake. This is used to verify the connection and prevent
1356 # spammers from trying to hide their identity. If the DNS and IP don't
1357 # match, the receiving MTA may deny the connection.
1359 # Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1361 # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1362 # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1364 # This maildomain*() code is based on ideas in Perl library Test::Reporter
1365 # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1369 return defined $domain && !($^O
eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1372 sub maildomain_net
{
1375 require Net
::Domain
;
1376 my $domain = Net
::Domain
::domainname
();
1377 $maildomain = $domain if valid_fqdn
($domain);
1382 sub maildomain_mta
{
1385 for my $host (qw(mailhost localhost)) {
1387 my $smtp = Net
::SMTP
->new($host);
1388 if (defined $smtp) {
1389 my $domain = $smtp->domain;
1392 $maildomain = $domain if valid_fqdn
($domain);
1394 last if $maildomain;
1402 return maildomain_net
() || maildomain_mta
() || 'localhost.localdomain';
1405 sub smtp_host_string
{
1406 if (defined $smtp_server_port) {
1407 return "$smtp_server:$smtp_server_port";
1409 return $smtp_server;
1413 # Returns 1 if authentication succeeded or was not necessary
1414 # (smtp_user was not specified), and 0 otherwise.
1416 sub smtp_auth_maybe
{
1417 if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1421 # Workaround AUTH PLAIN/LOGIN interaction defect
1422 # with Authen::SASL::Cyrus
1424 require Authen
::SASL
;
1425 Authen
::SASL
->import(qw(Perl));
1428 # Check mechanism naming as defined in:
1429 # https://tools.ietf.org/html/rfc4422#page-8
1430 if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1431 die "invalid smtp auth: '${smtp_auth}'";
1434 # TODO: Authentication may fail not because credentials were
1435 # invalid but due to other reasons, in which we should not
1436 # reject credentials.
1437 $auth = Git
::credential
({
1438 'protocol' => 'smtp',
1439 'host' => smtp_host_string
(),
1440 'username' => $smtp_authuser,
1441 # if there's no password, "git credential fill" will
1442 # give us one, otherwise it'll just pass this one.
1443 'password' => $smtp_authpass
1448 my $sasl = Authen
::SASL
->new(
1449 mechanism
=> $smtp_auth,
1451 user
=> $cred->{'username'},
1452 pass
=> $cred->{'password'},
1453 authname
=> $cred->{'username'},
1457 return !!$smtp->auth($sasl);
1460 return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1466 sub ssl_verify_params
{
1468 require IO
::Socket
::SSL
;
1469 IO
::Socket
::SSL
->import(qw
/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1472 print STDERR
"Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1476 if (!defined $smtp_ssl_cert_path) {
1477 # use the OpenSSL defaults
1478 return (SSL_verify_mode
=> SSL_VERIFY_PEER
());
1481 if ($smtp_ssl_cert_path eq "") {
1482 return (SSL_verify_mode
=> SSL_VERIFY_NONE
());
1483 } elsif (-d
$smtp_ssl_cert_path) {
1484 return (SSL_verify_mode
=> SSL_VERIFY_PEER
(),
1485 SSL_ca_path
=> $smtp_ssl_cert_path);
1486 } elsif (-f
$smtp_ssl_cert_path) {
1487 return (SSL_verify_mode
=> SSL_VERIFY_PEER
(),
1488 SSL_ca_file
=> $smtp_ssl_cert_path);
1490 die sprintf(__
("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1494 sub file_name_is_absolute
{
1497 # msys does not grok DOS drive-prefixes
1498 if ($^O
eq 'msys') {
1499 return ($path =~ m
#^/# || $path =~ m#^[a-zA-Z]\:#)
1502 require File
::Spec
::Functions
;
1503 return File
::Spec
::Functions
::file_name_is_absolute
($path);
1507 my @recipients = unique_email_list
(@to);
1508 @cc = (grep { my $cc = extract_valid_address_or_die
($_);
1509 not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1512 my $to = join (",\n\t", @recipients);
1513 @recipients = unique_email_list
(@recipients,@cc,@initial_bcc);
1514 @recipients = (map { extract_valid_address_or_die
($_) } @recipients);
1515 my $date = format_2822_time
($time++);
1516 my $gitversion = '@@GIT_VERSION@@';
1517 if ($gitversion =~ m/..GIT_VERSION../) {
1518 $gitversion = Git
::version
();
1521 my $cc = join(",\n\t", unique_email_list
(@cc));
1524 $ccline = "\nCc: $cc";
1526 make_message_id
() unless defined($message_id);
1528 my $header = "From: $sender
1532 Message-ID: $message_id
1535 $header .= "X-Mailer: git-send-email $gitversion\n";
1539 $header .= "In-Reply-To: $in_reply_to\n";
1540 $header .= "References: $references\n";
1543 $header .= "Reply-To: $reply_to\n";
1546 $header .= join("\n", @xh) . "\n";
1548 my $recipients_ref = \
@recipients;
1549 return ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header);
1552 # Prepares the email, then asks the user what to do.
1554 # If the user chooses to send the email, it's sent and 1 is returned.
1555 # If the user chooses not to send the email, 0 is returned.
1556 # If the user decides they want to make further edits, -1 is returned and the
1557 # caller is expected to call send_message again after the edits are performed.
1559 # If an error occurs sending the email, this just dies.
1562 my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header
();
1563 my @recipients = @
$recipients_ref;
1565 my @sendmail_parameters = ('-i', @recipients);
1566 my $raw_from = $sender;
1567 if (defined $envelope_sender && $envelope_sender ne "auto") {
1568 $raw_from = $envelope_sender;
1570 $raw_from = extract_valid_address
($raw_from);
1571 unshift (@sendmail_parameters,
1572 '-f', $raw_from) if(defined $envelope_sender);
1574 if ($needs_confirm && !$dry_run) {
1575 print "\n$header\n";
1576 if ($needs_confirm eq "inform") {
1577 $confirm_unconfigured = 0; # squelch this message for the rest of this run
1578 $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1580 The Cc list above has been expanded by additional
1581 addresses found in the patch commit message. By default
1582 send-email prompts before sending whenever this occurs.
1583 This behavior is controlled by the sendemail.confirm
1584 configuration setting.
1586 For additional information, run 'git send-email --help'.
1587 To retain the current behavior, but squelch this message,
1588 run 'git config --global sendemail.confirm auto'.
1592 # TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1593 # translation. The program will only accept English input
1595 $_ = ask
(__
("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1596 valid_re
=> qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1597 default => $ask_default);
1598 die __
("Send this email reply required") unless defined $_;
1604 cleanup_compose_files
();
1611 unshift (@sendmail_parameters, @smtp_server_options);
1614 # We don't want to send the email.
1615 } elsif (defined $sendmail_cmd || file_name_is_absolute
($smtp_server)) {
1616 my $pid = open my $sm, '|-';
1617 defined $pid or die $!;
1619 if (defined $sendmail_cmd) {
1620 exec ("sh", "-c", "$sendmail_cmd \"\$@\"", "-", @sendmail_parameters)
1623 exec ($smtp_server, @sendmail_parameters)
1627 print $sm "$header\n$message";
1628 close $sm or die $!;
1631 if (!defined $smtp_server) {
1632 die __
("The required SMTP server is not properly defined.")
1636 my $use_net_smtp_ssl = version
->parse($Net::SMTP
::VERSION
) < version
->parse("2.34");
1637 $smtp_domain ||= maildomain
();
1639 if ($smtp_encryption eq 'ssl') {
1640 $smtp_server_port ||= 465; # ssmtp
1641 require IO
::Socket
::SSL
;
1643 # Suppress "variable accessed once" warning.
1646 $IO::Socket
::SSL
::DEBUG
= 1;
1649 # Net::SMTP::SSL->new() does not forward any SSL options
1650 IO
::Socket
::SSL
::set_client_defaults
(
1651 ssl_verify_params
());
1653 if ($use_net_smtp_ssl) {
1654 require Net
::SMTP
::SSL
;
1655 $smtp ||= Net
::SMTP
::SSL
->new($smtp_server,
1656 Hello
=> $smtp_domain,
1657 Port
=> $smtp_server_port,
1658 Debug
=> $debug_net_smtp);
1661 $smtp ||= Net
::SMTP
->new($smtp_server,
1662 Hello
=> $smtp_domain,
1663 Port
=> $smtp_server_port,
1664 Debug
=> $debug_net_smtp,
1669 $smtp_server_port ||= 25;
1670 $smtp ||= Net
::SMTP
->new($smtp_server,
1671 Hello
=> $smtp_domain,
1672 Debug
=> $debug_net_smtp,
1673 Port
=> $smtp_server_port);
1674 if ($smtp_encryption eq 'tls' && $smtp) {
1675 if ($use_net_smtp_ssl) {
1676 $smtp->command('STARTTLS');
1678 if ($smtp->code != 220) {
1679 die sprintf(__
("Server does not support STARTTLS! %s"), $smtp->message);
1681 require Net
::SMTP
::SSL
;
1682 $smtp = Net
::SMTP
::SSL
->start_SSL($smtp,
1683 ssl_verify_params
())
1684 or die sprintf(__
("STARTTLS failed! %s"), IO
::Socket
::SSL
::errstr
());
1687 $smtp->starttls(ssl_verify_params
())
1688 or die sprintf(__
("STARTTLS failed! %s"), IO
::Socket
::SSL
::errstr
());
1690 # Send EHLO again to receive fresh
1691 # supported commands
1692 $smtp->hello($smtp_domain);
1697 die __
("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1698 " VALUES: server=$smtp_server ",
1699 "encryption=$smtp_encryption ",
1700 "hello=$smtp_domain",
1701 defined $smtp_server_port ?
" port=$smtp_server_port" : "";
1704 smtp_auth_maybe
or die $smtp->message;
1706 $smtp->mail( $raw_from ) or die $smtp->message;
1707 $smtp->to( @recipients ) or die $smtp->message;
1708 $smtp->data or die $smtp->message;
1709 $smtp->datasend("$header\n") or die $smtp->message;
1710 my @lines = split /^/, $message;
1711 foreach my $line (@lines) {
1712 $smtp->datasend("$line") or die $smtp->message;
1714 $smtp->dataend() or die $smtp->message;
1715 $smtp->code =~ /250|200/ or die sprintf(__
("Failed to send %s\n"), $subject).$smtp->message;
1718 printf($dry_run ? __
("Dry-Sent %s\n") : __
("Sent %s\n"), $subject);
1720 print($dry_run ? __
("Dry-OK. Log says:\n") : __
("OK. Log says:\n"));
1721 if (!defined $sendmail_cmd && !file_name_is_absolute
($smtp_server)) {
1722 print "Server: $smtp_server\n";
1723 print "MAIL FROM:<$raw_from>\n";
1724 foreach my $entry (@recipients) {
1725 print "RCPT TO:<$entry>\n";
1729 if (defined $sendmail_cmd) {
1730 $sm = $sendmail_cmd;
1735 print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1737 print $header, "\n";
1739 print __
("Result: "), $smtp->code, ' ',
1740 ($smtp->message =~ /\n([^\n]+\n)$/s), "\n";
1742 print __
("Result: OK\n");
1749 $in_reply_to = $initial_in_reply_to;
1750 $references = $initial_in_reply_to || '';
1753 sub pre_process_file
{
1754 my ($t, $quiet) = @_;
1756 open my $fh, "<", $t or die sprintf(__
("can't open file %s"), $t);
1759 my $sauthor = undef;
1760 my $author_encoding;
1761 my $has_content_type;
1764 my $has_mime_version;
1768 my $input_format = undef;
1770 $subject = $initial_subject;
1774 # Retrieve and unfold header fields.
1775 my @header_lines = ();
1778 push(@header_lines, $_);
1780 @header = unfold_headers
(@header_lines);
1781 # Add computed headers, if applicable.
1782 unless ($no_header_cmd || ! $header_cmd) {
1783 push @header, invoke_header_cmd
($header_cmd, $t);
1785 # Now parse the header
1788 $input_format = 'mbox';
1792 if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1793 $input_format = 'mbox';
1796 if (defined $input_format && $input_format eq 'mbox') {
1797 if (/^Subject:\s+(.*)$/i) {
1800 elsif (/^From:\s+(.*)$/i) {
1801 ($author, $author_encoding) = unquote_rfc2047
($1);
1802 $sauthor = sanitize_address
($author);
1803 next if $suppress_cc{'author'};
1804 next if $suppress_cc{'self'} and $sauthor eq $sender;
1805 printf(__
("(mbox) Adding cc: %s from line '%s'\n"),
1806 $1, $_) unless $quiet;
1809 elsif (/^To:\s+(.*)$/i) {
1810 foreach my $addr (parse_address_line
($1)) {
1811 printf(__
("(mbox) Adding to: %s from line '%s'\n"),
1812 $addr, $_) unless $quiet;
1816 elsif (/^Cc:\s+(.*)$/i) {
1817 foreach my $addr (parse_address_line
($1)) {
1818 my $qaddr = unquote_rfc2047
($addr);
1819 my $saddr = sanitize_address
($qaddr);
1820 if ($saddr eq $sender) {
1821 next if ($suppress_cc{'self'});
1823 next if ($suppress_cc{'cc'});
1825 printf(__
("(mbox) Adding cc: %s from line '%s'\n"),
1826 $addr, $_) unless $quiet;
1830 elsif (/^Content-type:/i) {
1831 $has_content_type = 1;
1832 if (/charset="?([^ "]+)/) {
1833 $body_encoding = $1;
1837 elsif (/^MIME-Version/i) {
1838 $has_mime_version = 1;
1841 elsif (/^Message-ID: (.*)/i) {
1844 elsif (/^Content-Transfer-Encoding: (.*)/i) {
1845 $xfer_encoding = $1 if not defined $xfer_encoding;
1847 elsif (/^In-Reply-To: (.*)/i) {
1848 if (!$initial_in_reply_to || $thread) {
1852 elsif (/^References: (.*)/i) {
1853 if (!$initial_in_reply_to || $thread) {
1857 elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1861 # In the traditional
1862 # "send lots of email" format,
1865 # So let's support that, too.
1866 $input_format = 'lots';
1867 if (@cc == 0 && !$suppress_cc{'cc'}) {
1868 printf(__
("(non-mbox) Adding cc: %s from line '%s'\n"),
1869 $_, $_) unless $quiet;
1871 } elsif (!defined $subject) {
1876 # Now parse the message body
1879 if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1881 my ($what, $c) = ($1, $2);
1882 # strip garbage for the address we'll use:
1883 $c = strip_garbage_one_address
($c);
1884 # sanitize a bit more to decide whether to suppress the address:
1885 my $sc = sanitize_address
($c);
1886 if ($sc eq $sender) {
1887 next if ($suppress_cc{'self'});
1889 if ($what =~ /^Signed-off-by$/i) {
1890 next if $suppress_cc{'sob'};
1891 } elsif ($what =~ /-by$/i) {
1892 next if $suppress_cc{'misc-by'};
1893 } elsif ($what =~ /Cc/i) {
1894 next if $suppress_cc{'bodycc'};
1897 if ($c !~ /.+@.+|<.+>/) {
1898 printf("(body) Ignoring %s from line '%s'\n",
1899 $what, $_) unless $quiet;
1903 printf(__
("(body) Adding cc: %s from line '%s'\n"),
1904 $c, $_) unless $quiet;
1909 push @to, recipients_cmd
("to-cmd", "to", $to_cmd, $t, $quiet)
1911 push @cc, recipients_cmd
("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1912 if defined $cc_cmd && !$suppress_cc{'cccmd'};
1914 if ($broken_encoding{$t} && !$has_content_type) {
1915 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1916 $has_content_type = 1;
1917 push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1918 $body_encoding = $auto_8bit_encoding;
1921 if ($broken_encoding{$t} && !is_rfc2047_quoted
($subject)) {
1922 $subject = quote_subject
($subject, $auto_8bit_encoding);
1925 if (defined $sauthor and $sauthor ne $sender) {
1926 $message = "From: $author\n\n$message";
1927 if (defined $author_encoding) {
1928 if ($has_content_type) {
1929 if ($body_encoding eq $author_encoding) {
1930 # ok, we already have the right encoding
1933 # uh oh, we should re-encode
1937 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1938 $has_content_type = 1;
1940 "Content-Type: text/plain; charset=$author_encoding";
1944 $xfer_encoding = '8bit' if not defined $xfer_encoding;
1945 ($message, $xfer_encoding) = apply_transfer_encoding
(
1946 $message, $xfer_encoding, $target_xfer_encoding);
1947 push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1948 unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1951 $confirm eq "always" or
1952 ($confirm =~ /^(?:auto|cc)$/ && @cc) or
1953 ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1954 $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1956 @to = process_address_list
(@to);
1957 @cc = process_address_list
(@cc);
1959 @to = (@initial_to, @to);
1960 @cc = (@initial_cc, @cc);
1962 if ($message_num == 1) {
1963 if (defined $cover_cc and $cover_cc) {
1966 if (defined $cover_to and $cover_to) {
1972 # Prepares the email, prompts the user, and sends it out
1973 # Returns 0 if an edit was done and the function should be called again, or 1
1974 # on the email being successfully sent out.
1978 pre_process_file
($t, $quiet);
1980 my $message_was_sent = send_message
();
1981 if ($message_was_sent == -1) {
1986 # set up for the next message
1988 if ($message_was_sent &&
1989 ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1990 $message_num == 1)) {
1991 $in_reply_to = $message_id;
1992 if (length $references > 0) {
1993 $references .= "\n $message_id";
1995 $references = "$message_id";
1998 } elsif (!defined $initial_in_reply_to) {
1999 # --thread and --in-reply-to manage the "In-Reply-To" header and by
2000 # extension the "References" header. If these commands are not used, reset
2001 # the header values to their defaults.
2002 $in_reply_to = undef;
2005 $message_id = undef;
2007 if (defined $batch_size && $num_sent == $batch_size) {
2009 $smtp->quit if defined $smtp;
2012 sleep($relogin_delay) if defined $relogin_delay;
2018 foreach my $t (@files) {
2019 while (!process_file
($t)) {
2020 # user edited the file
2024 # Execute a command and return its output lines as an array. Blank
2025 # lines which do not appear at the end of the output are reported as
2028 my ($prefix, $cmd, $file) = @_;
2030 my $seen_blank_line = 0;
2031 open my $fh, "-|", "$cmd \Q$file\E"
2032 or die sprintf(__
("(%s) Could not execute '%s'"), $prefix, $cmd);
2033 while (my $line = <$fh>) {
2034 die sprintf(__
("(%s) Malformed output from '%s'"), $prefix, $cmd)
2035 if $seen_blank_line;
2036 if ($line =~ /^$/) {
2037 $seen_blank_line = $line =~ /^$/;
2043 or die sprintf(__
("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2047 # Process headers lines, unfolding multiline headers as defined by RFC
2049 sub unfold_headers
{
2053 if (/^\s+\S/ and @headers) {
2054 chomp($headers[$#headers]);
2056 $headers[$#headers] .= $_;
2064 # Invoke the provided CMD with FILE as an argument, which should
2065 # output RFC 2822 email headers. Fold multiline headers and return the
2066 # headers as an array.
2067 sub invoke_header_cmd
{
2068 my ($cmd, $file) = @_;
2069 my @lines = execute_cmd
("header-cmd", $header_cmd, $file);
2070 return unfold_headers
(@lines);
2073 # Execute a command (e.g. $to_cmd) to get a list of email addresses
2074 # and return a results array
2075 sub recipients_cmd
{
2076 my ($prefix, $what, $cmd, $file, $quiet) = @_;
2080 @lines = execute_cmd
($prefix, $cmd, $file);
2081 for my $address (@lines) {
2082 $address =~ s/^\s*//g;
2083 $address =~ s/\s*$//g;
2084 $address = sanitize_address
($address);
2085 next if ($address eq $sender and $suppress_cc{'self'});
2086 push @addresses, $address;
2087 printf(__
("(%s) Adding %s: %s from: '%s'\n"),
2088 $prefix, $what, $address, $cmd) unless $quiet;
2093 cleanup_compose_files
();
2095 sub cleanup_compose_files
{
2096 unlink($compose_filename, $compose_filename . ".final") if $compose;
2099 $smtp->quit if $smtp;
2101 sub apply_transfer_encoding
{
2102 my $message = shift;
2106 return ($message, $to) if ($from eq $to and $from ne '7bit');
2108 require MIME
::QuotedPrint
;
2109 require MIME
::Base64
;
2111 $message = MIME
::QuotedPrint
::decode
($message)
2112 if ($from eq 'quoted-printable');
2113 $message = MIME
::Base64
::decode
($message)
2114 if ($from eq 'base64');
2116 $to = ($message =~ /(?:.{999,}|\r)/) ?
'quoted-printable' : '8bit'
2119 die __
("cannot send message as 7bit")
2120 if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2121 return ($message, $to)
2122 if ($to eq '7bit' or $to eq '8bit');
2123 return (MIME
::QuotedPrint
::encode
($message, "\n", 0), $to)
2124 if ($to eq 'quoted-printable');
2125 return (MIME
::Base64
::encode
($message, "\n"), $to)
2126 if ($to eq 'base64');
2127 die __
("invalid transfer encoding");
2130 sub unique_email_list
{
2134 foreach my $entry (@_) {
2135 my $clean = extract_valid_address_or_die
($entry);
2136 $seen{$clean} ||= 0;
2137 next if $seen{$clean}++;
2138 push @emails, $entry;
2143 sub validate_patch
{
2144 my ($fn, $xfer_encoding) = @_;
2147 my $hook_name = 'sendemail-validate';
2148 my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2150 my $validate_hook = File
::Spec
->catfile($hooks_path, $hook_name);
2152 if (-x
$validate_hook) {
2154 my $target = Cwd
::abs_path
($fn);
2155 # The hook needs a correct cwd and GIT_DIR.
2156 my $cwd_save = Cwd
::getcwd
();
2157 chdir($repo->wc_path() or $repo->repo_path())
2158 or die("chdir: $!");
2159 local $ENV{"GIT_DIR"} = $repo->repo_path();
2161 my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header
();
2164 my ($header_filehandle, $header_filename) = File
::Temp
::tempfile
(
2165 TEMPLATE
=> ".gitsendemail.header.XXXXXX",
2166 DIR
=> $repo->repo_path(),
2169 print $header_filehandle $header;
2171 my @cmd = ("git", "hook", "run", "--ignore-missing",
2173 my @cmd_msg = (@cmd, "<patch>", "<header>");
2174 my @cmd_run = (@cmd, $target, $header_filename);
2175 $hook_error = system_or_msg
(\
@cmd_run, undef, "@cmd_msg");
2176 chdir($cwd_save) or die("chdir: $!");
2179 $hook_error = sprintf(
2180 __
("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2181 $fn, $hook_name, $hook_error);
2186 # Any long lines will be automatically fixed if we use a suitable transfer
2188 unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2189 open(my $fh, '<', $fn)
2190 or die sprintf(__
("unable to open %s: %s\n"), $fn, $!);
2191 while (my $line = <$fh>) {
2192 if (length($line) > 998) {
2193 die sprintf(__
("fatal: %s:%d is longer than 998 characters\n" .
2194 "warning: no patches were sent\n"), $fn, $.);
2202 my ($last, $lastlen, $file, $known_suffix) = @_;
2203 my ($suffix, $skip);
2206 if (defined $last &&
2207 ($lastlen < length($file)) &&
2208 (substr($file, 0, $lastlen) eq $last) &&
2209 ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2210 if (defined $known_suffix && $suffix eq $known_suffix) {
2211 printf(__
("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2214 # TRANSLATORS: please keep "[y|N]" as is.
2215 my $answer = ask
(sprintf(__
("Do you really want to send %s? [y|N]: "), $file),
2216 valid_re
=> qr/^(?:y|n)/i,
2218 $skip = ($answer ne 'y');
2220 $known_suffix = $suffix;
2224 return ($skip, $known_suffix);
2227 sub handle_backup_files
{
2229 my ($last, $lastlen, $known_suffix, $skip, @result);
2230 for my $file (@file) {
2231 ($skip, $known_suffix) = handle_backup
($last, $lastlen,
2232 $file, $known_suffix);
2233 push @result, $file unless $skip;
2235 $lastlen = length($file);
2240 sub file_has_nonascii
{
2242 open(my $fh, '<', $fn)
2243 or die sprintf(__
("unable to open %s: %s\n"), $fn, $!);
2244 while (my $line = <$fh>) {
2245 return 1 if $line =~ /[^[:ascii:]]/;
2250 sub body_or_subject_has_nonascii
{
2252 open(my $fh, '<', $fn)
2253 or die sprintf(__
("unable to open %s: %s\n"), $fn, $!);
2254 while (my $line = <$fh>) {
2255 last if $line =~ /^$/;
2256 return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2258 while (my $line = <$fh>) {
2259 return 1 if $line =~ /[^[:ascii:]]/;