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