git

1
#!/usr/bin/perl
2
#
3
# Copyright 2002,2005 Greg Kroah-Hartman <greg@kroah.com>
4
# Copyright 2005 Ryan Anderson <ryan@michonline.com>
5
#
6
# GPL v2 (See COPYING)
7
#
8
# Ported to support git "mbox" format files by Ryan Anderson <ryan@michonline.com>
9
#
10
# Sends a collection of emails to the given email addresses, disturbingly fast.
11
#
12
# Supports two formats:
13
# 1. mbox format files (ignoring most headers and MIME formatting - this is designed for sending patches)
14
# 2. The original format support by Greg's script:
15
#    first line of the message is who to CC,
16
#    and second line is the subject of the message.
17
#
18

19
use 5.008001;
20
use strict;
21
use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
22
use Getopt::Long;
23
use Git::LoadCPAN::Error qw(:try);
24
use Git;
25
use Git::I18N;
26

27
Getopt::Long::Configure qw/ pass_through /;
28

29
sub usage {
30
	print <<EOT;
31
git send-email [<options>] <file|directory>
32
git send-email [<options>] <format-patch options>
33
git send-email --dump-aliases
34
git 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-]xmailer                 * Add "X-Mailer:" header (default).
45
    --[no-]annotate                * Review each patch that will be sent in an editor.
46
    --compose                      * Open an editor for introduction.
47
    --compose-encoding      <str>  * Encoding to assume for introduction.
48
    --8bit-encoding         <str>  * Encoding to assume 8bit mails if undeclared
49
    --transfer-encoding     <str>  * Transfer encoding to use (quoted-printable, 8bit, base64)
50

51
  Sending:
52
    --envelope-sender       <str>  * Email envelope sender.
53
    --sendmail-cmd          <str>  * Command to run to send email.
54
    --smtp-server       <str:int>  * Outgoing SMTP server to use. The port
55
                                     is optional. Default 'localhost'.
56
    --smtp-server-option    <str>  * Outgoing SMTP server option to use.
57
    --smtp-server-port      <int>  * Outgoing SMTP server port.
58
    --smtp-user             <str>  * Username for SMTP-AUTH.
59
    --smtp-pass             <str>  * Password for SMTP-AUTH; not necessary.
60
    --smtp-encryption       <str>  * tls or ssl; anything else disables.
61
    --smtp-ssl                     * Deprecated. Use '--smtp-encryption ssl'.
62
    --smtp-ssl-cert-path    <str>  * Path to ca-certificates (either directory or file).
63
                                     Pass an empty string to disable certificate
64
                                     verification.
65
    --smtp-domain           <str>  * The domain name sent to HELO/EHLO handshake
66
    --smtp-auth             <str>  * Space-separated list of allowed AUTH mechanisms, or
67
                                     "none" to disable authentication.
68
                                     This setting forces to use one of the listed mechanisms.
69
    --no-smtp-auth                   Disable SMTP authentication. Shorthand for
70
                                     `--smtp-auth=none`
71
    --smtp-debug            <0|1>  * Disable, enable Net::SMTP debug.
72

73
    --batch-size            <int>  * send max <int> message per connection.
74
    --relogin-delay         <int>  * delay <int> seconds between two successive login.
75
                                     This option can only be used with --batch-size
76

77
  Automating:
78
    --identity              <str>  * Use the sendemail.<id> options.
79
    --to-cmd                <str>  * Email To: via `<str> \$patch_path`.
80
    --cc-cmd                <str>  * Email Cc: via `<str> \$patch_path`.
81
    --header-cmd            <str>  * Add headers via `<str> \$patch_path`.
82
    --no-header-cmd                * Disable any header command in use.
83
    --suppress-cc           <str>  * author, self, sob, cc, cccmd, body, bodycc, misc-by, all.
84
    --[no-]cc-cover                * Email Cc: addresses in the cover letter.
85
    --[no-]to-cover                * Email To: addresses in the cover letter.
86
    --[no-]signed-off-by-cc        * Send to Signed-off-by: addresses. Default on.
87
    --[no-]suppress-from           * Send to self. Default off.
88
    --[no-]chain-reply-to          * Chain In-Reply-To: fields. Default off.
89
    --[no-]thread                  * Use In-Reply-To: field. Default on.
90

91
  Administering:
92
    --confirm               <str>  * Confirm recipients before sending;
93
                                     auto, cc, compose, always, or never.
94
    --quiet                        * Output one line of info per email.
95
    --dry-run                      * Don't actually send the emails.
96
    --[no-]validate                * Perform patch sanity checks. Default on.
97
    --[no-]format-patch            * understand any non optional arguments as
98
                                     `git format-patch` ones.
99
    --force                        * Send even if safety checks would prevent it.
100

101
  Information:
102
    --dump-aliases                 * Dump configured aliases and exit.
103
    --translate-aliases            * Translate aliases read from standard
104
                                     input according to the configured email
105
                                     alias file(s), outputting the result to
106
                                     standard output.
107

108
EOT
109
	exit(1);
110
}
111

112
sub uniq {
113
	my %seen;
114
	grep !$seen{$_}++, @_;
115
}
116

117
sub completion_helper {
118
	my ($original_opts) = @_;
119
	my %not_for_completion = (
120
		"git-completion-helper" => undef,
121
		"h" => undef,
122
	);
123
	my @send_email_opts = ();
124

125
	foreach my $key (keys %$original_opts) {
126
		unless (exists $not_for_completion{$key}) {
127
			my $negatable = ($key =~ s/!$//);
128

129
			if ($key =~ /[:=][si]$/) {
130
				$key =~ s/[:=][si]$//;
131
				push (@send_email_opts, "--$_=") foreach (split (/\|/, $key));
132
			} else {
133
				push (@send_email_opts, "--$_") foreach (split (/\|/, $key));
134
				if ($negatable) {
135
					push (@send_email_opts, "--no-$_") foreach (split (/\|/, $key));
136
				}
137
			}
138
		}
139
	}
140

141
	my @format_patch_opts = split(/ /, Git::command('format-patch', '--git-completion-helper'));
142
	my @opts = (@send_email_opts, @format_patch_opts);
143
	@opts = uniq (grep !/^$/, @opts);
144
	# There's an implicit '\n' here already, no need to add an explicit one.
145
	print "@opts";
146
	exit(0);
147
}
148

149
# most mail servers generate the Date: header, but not all...
150
sub format_2822_time {
151
	my ($time) = @_;
152
	my @localtm = localtime($time);
153
	my @gmttm = gmtime($time);
154
	my $localmin = $localtm[1] + $localtm[2] * 60;
155
	my $gmtmin = $gmttm[1] + $gmttm[2] * 60;
156
	if ($localtm[0] != $gmttm[0]) {
157
		die __("local zone differs from GMT by a non-minute interval\n");
158
	}
159
	if ((($gmttm[6] + 1) % 7) == $localtm[6]) {
160
		$localmin += 1440;
161
	} elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) {
162
		$localmin -= 1440;
163
	} elsif ($gmttm[6] != $localtm[6]) {
164
		die __("local time offset greater than or equal to 24 hours\n");
165
	}
166
	my $offset = $localmin - $gmtmin;
167
	my $offhour = $offset / 60;
168
	my $offmin = abs($offset % 60);
169
	if (abs($offhour) >= 24) {
170
		die __("local time offset greater than or equal to 24 hours\n");
171
	}
172

173
	return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d",
174
		       qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]],
175
		       $localtm[3],
176
		       qw(Jan Feb Mar Apr May Jun
177
			  Jul Aug Sep Oct Nov Dec)[$localtm[4]],
178
		       $localtm[5]+1900,
179
		       $localtm[2],
180
		       $localtm[1],
181
		       $localtm[0],
182
		       ($offset >= 0) ? '+' : '-',
183
		       abs($offhour),
184
		       $offmin,
185
		       );
186
}
187

188
my $smtp;
189
my $auth;
190
my $num_sent = 0;
191

192
# Regexes for RFC 2047 productions.
193
my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
194
my $re_encoded_text = qr/[^? \000-\037\177-\377]+/;
195
my $re_encoded_word = qr/=\?($re_token)\?($re_token)\?($re_encoded_text)\?=/;
196

197
# Variables we fill in automatically, or via prompting:
198
my (@to,@cc,@xh,$envelope_sender,
199
	$initial_in_reply_to,$reply_to,$initial_subject,@files,
200
	$author,$sender,$smtp_authpass,$annotate,$compose,$time);
201
# Things we either get from config, *or* are overridden on the
202
# command-line.
203
my ($no_cc, $no_to, $no_bcc, $no_identity, $no_header_cmd);
204
my (@config_to, @getopt_to);
205
my (@config_cc, @getopt_cc);
206
my (@config_bcc, @getopt_bcc);
207

208
# Example reply to:
209
#$initial_in_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
210

211
my $repo = eval { Git->repository() };
212
my @repo = $repo ? ($repo) : ();
213

214
# Behavior modification variables
215
my ($quiet, $dry_run) = (0, 0);
216
my $format_patch;
217
my $compose_filename;
218
my $force = 0;
219
my $dump_aliases = 0;
220
my $translate_aliases = 0;
221

222
# Variables to prevent short format-patch options from being captured
223
# as abbreviated send-email options
224
my $reroll_count;
225

226
# Handle interactive edition of files.
227
my $multiedit;
228
my $editor;
229

230
sub system_or_msg {
231
	my ($args, $msg, $cmd_name) = @_;
232
	system(@$args);
233
	my $signalled = $? & 127;
234
	my $exit_code = $? >> 8;
235
	return unless $signalled or $exit_code;
236

237
	my @sprintf_args = ($cmd_name ? $cmd_name : $args->[0], $exit_code);
238
	if (defined $msg) {
239
		# Quiet the 'redundant' warning category, except we
240
		# need to support down to Perl 5.8.1, so we can't do a
241
		# "no warnings 'redundant'", since that category was
242
		# introduced in perl 5.22, and asking for it will die
243
		# on older perls.
244
		no warnings;
245
		return sprintf($msg, @sprintf_args);
246
	}
247
	return sprintf(__("fatal: command '%s' died with exit code %d"),
248
		       @sprintf_args);
249
}
250

251
sub system_or_die {
252
	my $msg = system_or_msg(@_);
253
	die $msg if $msg;
254
}
255

256
sub do_edit {
257
	if (!defined($editor)) {
258
		$editor = Git::command_oneline('var', 'GIT_EDITOR');
259
	}
260
	my $die_msg = __("the editor exited uncleanly, aborting everything");
261
	if (defined($multiedit) && !$multiedit) {
262
		system_or_die(['sh', '-c', $editor.' "$@"', $editor, $_], $die_msg) for @_;
263
	} else {
264
		system_or_die(['sh', '-c', $editor.' "$@"', $editor, @_], $die_msg);
265
	}
266
}
267

268
# Variables with corresponding config settings
269
my ($suppress_from, $signed_off_by_cc);
270
my ($cover_cc, $cover_to);
271
my ($to_cmd, $cc_cmd, $header_cmd);
272
my ($smtp_server, $smtp_server_port, @smtp_server_options);
273
my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
274
my ($batch_size, $relogin_delay);
275
my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
276
my ($confirm);
277
my (@suppress_cc);
278
my ($auto_8bit_encoding);
279
my ($compose_encoding);
280
my ($sendmail_cmd);
281
# Variables with corresponding config settings & hardcoded defaults
282
my ($debug_net_smtp) = 0;		# Net::SMTP, see send_message()
283
my $thread = 1;
284
my $chain_reply_to = 0;
285
my $use_xmailer = 1;
286
my $validate = 1;
287
my $target_xfer_encoding = 'auto';
288
my $forbid_sendmail_variables = 1;
289

290
my %config_bool_settings = (
291
    "thread" => \$thread,
292
    "chainreplyto" => \$chain_reply_to,
293
    "suppressfrom" => \$suppress_from,
294
    "signedoffbycc" => \$signed_off_by_cc,
295
    "cccover" => \$cover_cc,
296
    "tocover" => \$cover_to,
297
    "signedoffcc" => \$signed_off_by_cc,
298
    "validate" => \$validate,
299
    "multiedit" => \$multiedit,
300
    "annotate" => \$annotate,
301
    "xmailer" => \$use_xmailer,
302
    "forbidsendmailvariables" => \$forbid_sendmail_variables,
303
);
304

305
my %config_settings = (
306
    "smtpencryption" => \$smtp_encryption,
307
    "smtpserver" => \$smtp_server,
308
    "smtpserverport" => \$smtp_server_port,
309
    "smtpserveroption" => \@smtp_server_options,
310
    "smtpuser" => \$smtp_authuser,
311
    "smtppass" => \$smtp_authpass,
312
    "smtpdomain" => \$smtp_domain,
313
    "smtpauth" => \$smtp_auth,
314
    "smtpbatchsize" => \$batch_size,
315
    "smtprelogindelay" => \$relogin_delay,
316
    "to" => \@config_to,
317
    "tocmd" => \$to_cmd,
318
    "cc" => \@config_cc,
319
    "cccmd" => \$cc_cmd,
320
    "headercmd" => \$header_cmd,
321
    "aliasfiletype" => \$aliasfiletype,
322
    "bcc" => \@config_bcc,
323
    "suppresscc" => \@suppress_cc,
324
    "envelopesender" => \$envelope_sender,
325
    "confirm"   => \$confirm,
326
    "from" => \$sender,
327
    "assume8bitencoding" => \$auto_8bit_encoding,
328
    "composeencoding" => \$compose_encoding,
329
    "transferencoding" => \$target_xfer_encoding,
330
    "sendmailcmd" => \$sendmail_cmd,
331
);
332

333
my %config_path_settings = (
334
    "aliasesfile" => \@alias_files,
335
    "smtpsslcertpath" => \$smtp_ssl_cert_path,
336
);
337

338
# Handle Uncouth Termination
339
sub signal_handler {
340
	# Make text normal
341
	require Term::ANSIColor;
342
	print Term::ANSIColor::color("reset"), "\n";
343

344
	# SMTP password masked
345
	system "stty echo";
346

347
	# tmp files from --compose
348
	if (defined $compose_filename) {
349
		if (-e $compose_filename) {
350
			printf __("'%s' contains an intermediate version ".
351
				  "of the email you were composing.\n"),
352
				  $compose_filename;
353
		}
354
		if (-e ($compose_filename . ".final")) {
355
			printf __("'%s.final' contains the composed email.\n"),
356
				  $compose_filename;
357
		}
358
	}
359

360
	exit;
361
};
362

363
$SIG{TERM} = \&signal_handler;
364
$SIG{INT}  = \&signal_handler;
365

366
# Read our sendemail.* config
367
sub read_config {
368
	my ($known_keys, $configured, $prefix) = @_;
369

370
	foreach my $setting (keys %config_bool_settings) {
371
		my $target = $config_bool_settings{$setting};
372
		my $key = "$prefix.$setting";
373
		next unless exists $known_keys->{$key};
374
		my $v = (@{$known_keys->{$key}} == 1 &&
375
			 (defined $known_keys->{$key}->[0] &&
376
			  $known_keys->{$key}->[0] =~ /^(?:true|false)$/s))
377
			? $known_keys->{$key}->[0] eq 'true'
378
			: Git::config_bool(@repo, $key);
379
		next unless defined $v;
380
		next if $configured->{$setting}++;
381
		$$target = $v;
382
	}
383

384
	foreach my $setting (keys %config_path_settings) {
385
		my $target = $config_path_settings{$setting};
386
		my $key = "$prefix.$setting";
387
		next unless exists $known_keys->{$key};
388
		if (ref($target) eq "ARRAY") {
389
			my @values = Git::config_path(@repo, $key);
390
			next unless @values;
391
			next if $configured->{$setting}++;
392
			@$target = @values;
393
		}
394
		else {
395
			my $v = Git::config_path(@repo, "$prefix.$setting");
396
			next unless defined $v;
397
			next if $configured->{$setting}++;
398
			$$target = $v;
399
		}
400
	}
401

402
	foreach my $setting (keys %config_settings) {
403
		my $target = $config_settings{$setting};
404
		my $key = "$prefix.$setting";
405
		next unless exists $known_keys->{$key};
406
		if (ref($target) eq "ARRAY") {
407
			my @values = @{$known_keys->{$key}};
408
			@values = grep { defined } @values;
409
			next if $configured->{$setting}++;
410
			@$target = @values;
411
		}
412
		else {
413
			my $v = $known_keys->{$key}->[-1];
414
			next unless defined $v;
415
			next if $configured->{$setting}++;
416
			$$target = $v;
417
		}
418
	}
419
}
420

421
sub config_regexp {
422
	my ($regex) = @_;
423
	my @ret;
424
	eval {
425
		my $ret = Git::command(
426
			'config',
427
			'--null',
428
			'--get-regexp',
429
			$regex,
430
		);
431
		@ret = map {
432
			# We must always return ($k, $v) here, since
433
			# empty config values will be just "key\0",
434
			# not "key\nvalue\0".
435
			my ($k, $v) = split /\n/, $_, 2;
436
			($k, $v);
437
		} split /\0/, $ret;
438
		1;
439
	} or do {
440
		# If we have no keys we're OK, otherwise re-throw
441
		die $@ if $@->value != 1;
442
	};
443
	return @ret;
444
}
445

446
# Save ourselves a lot of work of shelling out to 'git config' (it
447
# parses 'bool' etc.) by only doing so for config keys that exist.
448
my %known_config_keys;
449
{
450
	my @kv = config_regexp("^sende?mail[.]");
451
	while (my ($k, $v) = splice @kv, 0, 2) {
452
		push @{$known_config_keys{$k}} => $v;
453
	}
454
}
455

456
# sendemail.identity yields to --identity. We must parse this
457
# special-case first before the rest of the config is read.
458
{
459
	my $key = "sendemail.identity";
460
	$identity = Git::config(@repo, $key) if exists $known_config_keys{$key};
461
}
462
my %identity_options = (
463
	"identity=s" => \$identity,
464
	"no-identity" => \$no_identity,
465
);
466
my $rc = GetOptions(%identity_options);
467
usage() unless $rc;
468
undef $identity if $no_identity;
469

470
# Now we know enough to read the config
471
{
472
    my %configured;
473
    read_config(\%known_config_keys, \%configured, "sendemail.$identity") if defined $identity;
474
    read_config(\%known_config_keys, \%configured, "sendemail");
475
}
476

477
# Begin by accumulating all the variables (defined above), that we will end up
478
# needing, first, from the command line:
479

480
my $help;
481
my $git_completion_helper;
482
my %dump_aliases_options = (
483
	"h" => \$help,
484
	"dump-aliases" => \$dump_aliases,
485
	"translate-aliases" => \$translate_aliases,
486
);
487
$rc = GetOptions(%dump_aliases_options);
488
usage() unless $rc;
489
die __("--dump-aliases incompatible with other options\n")
490
    if !$help and ($dump_aliases or $translate_aliases) and @ARGV;
491
die __("--dump-aliases and --translate-aliases are mutually exclusive\n")
492
    if !$help and $dump_aliases and $translate_aliases;
493
my %options = (
494
		    "sender|from=s" => \$sender,
495
		    "in-reply-to=s" => \$initial_in_reply_to,
496
		    "reply-to=s" => \$reply_to,
497
		    "subject=s" => \$initial_subject,
498
		    "to=s" => \@getopt_to,
499
		    "to-cmd=s" => \$to_cmd,
500
		    "no-to" => \$no_to,
501
		    "cc=s" => \@getopt_cc,
502
		    "no-cc" => \$no_cc,
503
		    "bcc=s" => \@getopt_bcc,
504
		    "no-bcc" => \$no_bcc,
505
		    "chain-reply-to!" => \$chain_reply_to,
506
		    "sendmail-cmd=s" => \$sendmail_cmd,
507
		    "smtp-server=s" => \$smtp_server,
508
		    "smtp-server-option=s" => \@smtp_server_options,
509
		    "smtp-server-port=s" => \$smtp_server_port,
510
		    "smtp-user=s" => \$smtp_authuser,
511
		    "smtp-pass:s" => \$smtp_authpass,
512
		    "smtp-ssl" => sub { $smtp_encryption = 'ssl' },
513
		    "smtp-encryption=s" => \$smtp_encryption,
514
		    "smtp-ssl-cert-path=s" => \$smtp_ssl_cert_path,
515
		    "smtp-debug:i" => \$debug_net_smtp,
516
		    "smtp-domain:s" => \$smtp_domain,
517
		    "smtp-auth=s" => \$smtp_auth,
518
		    "no-smtp-auth" => sub {$smtp_auth = 'none'},
519
		    "annotate!" => \$annotate,
520
		    "compose" => \$compose,
521
		    "quiet" => \$quiet,
522
		    "cc-cmd=s" => \$cc_cmd,
523
		    "header-cmd=s" => \$header_cmd,
524
		    "no-header-cmd" => \$no_header_cmd,
525
		    "suppress-from!" => \$suppress_from,
526
		    "suppress-cc=s" => \@suppress_cc,
527
		    "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc,
528
		    "cc-cover!" => \$cover_cc,
529
		    "to-cover!" => \$cover_to,
530
		    "confirm=s" => \$confirm,
531
		    "dry-run" => \$dry_run,
532
		    "envelope-sender=s" => \$envelope_sender,
533
		    "thread!" => \$thread,
534
		    "validate!" => \$validate,
535
		    "transfer-encoding=s" => \$target_xfer_encoding,
536
		    "format-patch!" => \$format_patch,
537
		    "8bit-encoding=s" => \$auto_8bit_encoding,
538
		    "compose-encoding=s" => \$compose_encoding,
539
		    "force" => \$force,
540
		    "xmailer!" => \$use_xmailer,
541
		    "batch-size=i" => \$batch_size,
542
		    "relogin-delay=i" => \$relogin_delay,
543
		    "git-completion-helper" => \$git_completion_helper,
544
		    "v=s" => \$reroll_count,
545
);
546
$rc = GetOptions(%options);
547

548
# Munge any "either config or getopt, not both" variables
549
my @initial_to = @getopt_to ? @getopt_to : ($no_to ? () : @config_to);
550
my @initial_cc = @getopt_cc ? @getopt_cc : ($no_cc ? () : @config_cc);
551
my @initial_bcc = @getopt_bcc ? @getopt_bcc : ($no_bcc ? () : @config_bcc);
552

553
usage() if $help;
554
my %all_options = (%options, %dump_aliases_options, %identity_options);
555
completion_helper(\%all_options) if $git_completion_helper;
556
unless ($rc) {
557
    usage();
558
}
559

560
if ($forbid_sendmail_variables && grep { /^sendmail/s } keys %known_config_keys) {
561
	die __("fatal: found configuration options for 'sendmail'\n" .
562
		"git-send-email is configured with the sendemail.* options - note the 'e'.\n" .
563
		"Set sendemail.forbidSendmailVariables to false to disable this check.\n");
564
}
565

566
die __("Cannot run git format-patch from outside a repository\n")
567
	if $format_patch and not $repo;
568

569
die __("`batch-size` and `relogin` must be specified together " .
570
	"(via command-line or configuration option)\n")
571
	if defined $relogin_delay and not defined $batch_size;
572

573
# 'default' encryption is none -- this only prevents a warning
574
$smtp_encryption = '' unless (defined $smtp_encryption);
575

576
# Set CC suppressions
577
my(%suppress_cc);
578
if (@suppress_cc) {
579
	foreach my $entry (@suppress_cc) {
580
		# Please update $__git_send_email_suppresscc_options
581
		# in git-completion.bash when you add new options.
582
		die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
583
			unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc|misc-by)$/;
584
		$suppress_cc{$entry} = 1;
585
	}
586
}
587

588
if ($suppress_cc{'all'}) {
589
	foreach my $entry (qw (cccmd cc author self sob body bodycc misc-by)) {
590
		$suppress_cc{$entry} = 1;
591
	}
592
	delete $suppress_cc{'all'};
593
}
594

595
# If explicit old-style ones are specified, they trump --suppress-cc.
596
$suppress_cc{'self'} = $suppress_from if defined $suppress_from;
597
$suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc;
598

599
if ($suppress_cc{'body'}) {
600
	foreach my $entry (qw (sob bodycc misc-by)) {
601
		$suppress_cc{$entry} = 1;
602
	}
603
	delete $suppress_cc{'body'};
604
}
605

606
# Set confirm's default value
607
my $confirm_unconfigured = !defined $confirm;
608
if ($confirm_unconfigured) {
609
	$confirm = scalar %suppress_cc ? 'compose' : 'auto';
610
};
611
# Please update $__git_send_email_confirm_options in
612
# git-completion.bash when you add new options.
613
die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
614
	unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
615

616
# Debugging, print out the suppressions.
617
if (0) {
618
	print "suppressions:\n";
619
	foreach my $entry (keys %suppress_cc) {
620
		printf "  %-5s -> $suppress_cc{$entry}\n", $entry;
621
	}
622
}
623

624
my ($repoauthor, $repocommitter);
625
{
626
	my %cache;
627
	my ($author, $committer);
628
	my $common = sub {
629
		my ($what) = @_;
630
		return $cache{$what} if exists $cache{$what};
631
		($cache{$what}) = Git::ident_person(@repo, $what);
632
		return $cache{$what};
633
	};
634
	$repoauthor = sub { $common->('author') };
635
	$repocommitter = sub { $common->('committer') };
636
}
637

638
sub parse_address_line {
639
	require Git::LoadCPAN::Mail::Address;
640
	return map { $_->format } Mail::Address->parse($_[0]);
641
}
642

643
sub split_addrs {
644
	require Text::ParseWords;
645
	return Text::ParseWords::quotewords('\s*,\s*', 1, @_);
646
}
647

648
my %aliases;
649

650
sub parse_sendmail_alias {
651
	local $_ = shift;
652
	if (/"/) {
653
		printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
654
	} elsif (/:include:/) {
655
		printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
656
	} elsif (/[\/|]/) {
657
		printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
658
	} elsif (/^(\S+?)\s*:\s*(.+)$/) {
659
		my ($alias, $addr) = ($1, $2);
660
		$aliases{$alias} = [ split_addrs($addr) ];
661
	} else {
662
		printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
663
	}
664
}
665

666
sub parse_sendmail_aliases {
667
	my $fh = shift;
668
	my $s = '';
669
	while (<$fh>) {
670
		chomp;
671
		next if /^\s*$/ || /^\s*#/;
672
		$s .= $_, next if $s =~ s/\\$// || s/^\s+//;
673
		parse_sendmail_alias($s) if $s;
674
		$s = $_;
675
	}
676
	$s =~ s/\\$//; # silently tolerate stray '\' on last line
677
	parse_sendmail_alias($s) if $s;
678
}
679

680
my %parse_alias = (
681
	# multiline formats can be supported in the future
682
	mutt => sub { my $fh = shift; while (<$fh>) {
683
		if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) {
684
			my ($alias, $addr) = ($1, $2);
685
			$addr =~ s/#.*$//; # mutt allows # comments
686
			# commas delimit multiple addresses
687
			my @addr = split_addrs($addr);
688

689
			# quotes may be escaped in the file,
690
			# unescape them so we do not double-escape them later.
691
			s/\\"/"/g foreach @addr;
692
			$aliases{$alias} = \@addr
693
		}}},
694
	mailrc => sub {	my $fh = shift; while (<$fh>) {
695
		if (/^alias\s+(\S+)\s+(.*?)\s*$/) {
696
			require Text::ParseWords;
697
			# spaces delimit multiple addresses
698
			$aliases{$1} = [ Text::ParseWords::quotewords('\s+', 0, $2) ];
699
		}}},
700
	pine => sub { my $fh = shift; my $f='\t[^\t]*';
701
	        for (my $x = ''; defined($x); $x = $_) {
702
			chomp $x;
703
		        $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/);
704
			$x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next;
705
			$aliases{$1} = [ split_addrs($2) ];
706
		}},
707
	elm => sub  { my $fh = shift;
708
		      while (<$fh>) {
709
			  if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) {
710
			      my ($alias, $addr) = ($1, $2);
711
			       $aliases{$alias} = [ split_addrs($addr) ];
712
			  }
713
		      } },
714
	sendmail => \&parse_sendmail_aliases,
715
	gnus => sub { my $fh = shift; while (<$fh>) {
716
		if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) {
717
			$aliases{$1} = [ $2 ];
718
		}}}
719
	# Please update _git_config() in git-completion.bash when you
720
	# add new MUAs.
721
);
722

723
if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
724
	foreach my $file (@alias_files) {
725
		open my $fh, '<', $file or die "opening $file: $!\n";
726
		$parse_alias{$aliasfiletype}->($fh);
727
		close $fh;
728
	}
729
}
730

731
if ($dump_aliases) {
732
    print "$_\n" for (sort keys %aliases);
733
    exit(0);
734
}
735

736
if ($translate_aliases) {
737
	while (<STDIN>) {
738
		my @addr_list = parse_address_line($_);
739
		@addr_list = expand_aliases(@addr_list);
740
		@addr_list = sanitize_address_list(@addr_list);
741
		print "$_\n" for @addr_list;
742
	}
743
	exit(0);
744
}
745

746
# is_format_patch_arg($f) returns 0 if $f names a patch, or 1 if
747
# $f is a revision list specification to be passed to format-patch.
748
sub is_format_patch_arg {
749
	return unless $repo;
750
	my $f = shift;
751
	try {
752
		$repo->command('rev-parse', '--verify', '--quiet', $f);
753
		if (defined($format_patch)) {
754
			return $format_patch;
755
		}
756
		die sprintf(__(<<EOF), $f, $f);
757
File '%s' exists but it could also be the range of commits
758
to produce patches for.  Please disambiguate by...
759

760
    * Saying "./%s" if you mean a file; or
761
    * Giving --format-patch option if you mean a range.
762
EOF
763
	} catch Git::Error::Command with {
764
		# Not a valid revision.  Treat it as a filename.
765
		return 0;
766
	}
767
}
768

769
# Now that all the defaults are set, process the rest of the command line
770
# arguments and collect up the files that need to be processed.
771
my @rev_list_opts;
772
while (defined(my $f = shift @ARGV)) {
773
	if ($f eq "--") {
774
		push @rev_list_opts, "--", @ARGV;
775
		@ARGV = ();
776
	} elsif (-d $f and !is_format_patch_arg($f)) {
777
		opendir my $dh, $f
778
			or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
779

780
		require File::Spec;
781
		push @files, grep { -f $_ } map { File::Spec->catfile($f, $_) }
782
				sort readdir $dh;
783
		closedir $dh;
784
	} elsif ((-f $f or -p $f) and !is_format_patch_arg($f)) {
785
		push @files, $f;
786
	} else {
787
		push @rev_list_opts, $f;
788
	}
789
}
790

791
if (@rev_list_opts) {
792
	die __("Cannot run git format-patch from outside a repository\n")
793
		unless $repo;
794
	require File::Temp;
795
	push @files, $repo->command('format-patch', '-o', File::Temp::tempdir(CLEANUP => 1),
796
				    defined $reroll_count ? ('-v', $reroll_count) : (),
797
				    @rev_list_opts);
798
}
799

800
if (defined $sender) {
801
	$sender =~ s/^\s+|\s+$//g;
802
	($sender) = expand_aliases($sender);
803
} else {
804
	$sender = $repoauthor->() || $repocommitter->() || '';
805
}
806

807
# $sender could be an already sanitized address
808
# (e.g. sendemail.from could be manually sanitized by user).
809
# But it's a no-op to run sanitize_address on an already sanitized address.
810
$sender = sanitize_address($sender);
811

812
$time = time - scalar $#files;
813

814
@files = handle_backup_files(@files);
815

816
if (@files) {
817
	unless ($quiet) {
818
		print $_,"\n" for (@files);
819
	}
820
} else {
821
	print STDERR __("\nNo patch files specified!\n\n");
822
	usage();
823
}
824

825
sub get_patch_subject {
826
	my $fn = shift;
827
	open (my $fh, '<', $fn);
828
	while (my $line = <$fh>) {
829
		next unless ($line =~ /^Subject: (.*)$/);
830
		close $fh;
831
		return "GIT: $1\n";
832
	}
833
	close $fh;
834
	die sprintf(__("No subject line in %s?"), $fn);
835
}
836

837
if ($compose) {
838
	# Note that this does not need to be secure, but we will make a small
839
	# effort to have it be unique
840
	require File::Temp;
841
	$compose_filename = ($repo ?
842
		File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
843
		File::Temp::tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
844
	open my $c, ">", $compose_filename
845
		or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
846

847

848
	my $tpl_sender = $sender || $repoauthor->() || $repocommitter->() || '';
849
	my $tpl_subject = $initial_subject || '';
850
	my $tpl_in_reply_to = $initial_in_reply_to || '';
851
	my $tpl_reply_to = $reply_to || '';
852
	my $tpl_to = join(',', @initial_to);
853
	my $tpl_cc = join(',', @initial_cc);
854
	my $tpl_bcc = join(', ', @initial_bcc);
855

856
	print $c <<EOT1, Git::prefix_lines("GIT: ", __(<<EOT2)), <<EOT3;
857
From $tpl_sender # This line is ignored.
858
EOT1
859
Lines beginning in "GIT:" will be removed.
860
Consider including an overall diffstat or table of contents
861
for the patch you are writing.
862

863
Clear the body content if you don't wish to send a summary.
864
EOT2
865
From: $tpl_sender
866
To: $tpl_to
867
Cc: $tpl_cc
868
Bcc: $tpl_bcc
869
Reply-To: $tpl_reply_to
870
Subject: $tpl_subject
871
In-Reply-To: $tpl_in_reply_to
872

873
EOT3
874
	for my $f (@files) {
875
		print $c get_patch_subject($f);
876
	}
877
	close $c;
878

879
	if ($annotate) {
880
		do_edit($compose_filename, @files);
881
	} else {
882
		do_edit($compose_filename);
883
	}
884

885
	open my $c2, ">", $compose_filename . ".final"
886
		or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
887

888
	open $c, "<", $compose_filename
889
		or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
890

891
	my $need_8bit_cte = file_has_nonascii($compose_filename);
892
	my $in_body = 0;
893
	my $summary_empty = 1;
894
	if (!defined $compose_encoding) {
895
		$compose_encoding = "UTF-8";
896
	}
897
	while(<$c>) {
898
		next if m/^GIT:/;
899
		if ($in_body) {
900
			$summary_empty = 0 unless (/^\n$/);
901
		} elsif (/^\n$/) {
902
			$in_body = 1;
903
			if ($need_8bit_cte) {
904
				print $c2 "MIME-Version: 1.0\n",
905
					 "Content-Type: text/plain; ",
906
					   "charset=$compose_encoding\n",
907
					 "Content-Transfer-Encoding: 8bit\n";
908
			}
909
		} elsif (/^MIME-Version:/i) {
910
			$need_8bit_cte = 0;
911
		} elsif (/^Subject:\s*(.+)\s*$/i) {
912
			$initial_subject = $1;
913
			my $subject = $initial_subject;
914
			$_ = "Subject: " .
915
				quote_subject($subject, $compose_encoding) .
916
				"\n";
917
		} elsif (/^In-Reply-To:\s*(.+)\s*$/i) {
918
			$initial_in_reply_to = $1;
919
			next;
920
		} elsif (/^Reply-To:\s*(.+)\s*$/i) {
921
			$reply_to = $1;
922
		} elsif (/^From:\s*(.+)\s*$/i) {
923
			$sender = $1;
924
			next;
925
		} elsif (/^To:\s*(.+)\s*$/i) {
926
			@initial_to = parse_address_line($1);
927
			next;
928
		} elsif (/^Cc:\s*(.+)\s*$/i) {
929
			@initial_cc = parse_address_line($1);
930
			next;
931
		} elsif (/^Bcc:/i) {
932
			@initial_bcc = parse_address_line($1);
933
			next;
934
		}
935
		print $c2 $_;
936
	}
937
	close $c;
938
	close $c2;
939

940
	if ($summary_empty) {
941
		print __("Summary email is empty, skipping it\n");
942
		$compose = -1;
943
	}
944
} elsif ($annotate) {
945
	do_edit(@files);
946
}
947

948
{
949
	# Only instantiate one $term per program run, since some
950
	# Term::ReadLine providers refuse to create a second instance.
951
	my $term;
952
	sub term {
953
		require Term::ReadLine;
954
		if (!defined $term) {
955
			$term = $ENV{"GIT_SEND_EMAIL_NOTTY"}
956
				? Term::ReadLine->new('git-send-email', \*STDIN, \*STDOUT)
957
				: Term::ReadLine->new('git-send-email');
958
		}
959
		return $term;
960
	}
961
}
962

963
sub ask {
964
	my ($prompt, %arg) = @_;
965
	my $valid_re = $arg{valid_re};
966
	my $default = $arg{default};
967
	my $confirm_only = $arg{confirm_only};
968
	my $resp;
969
	my $i = 0;
970
	my $term = term();
971
	return defined $default ? $default : undef
972
		unless defined $term->IN and defined fileno($term->IN) and
973
		       defined $term->OUT and defined fileno($term->OUT);
974
	while ($i++ < 10) {
975
		$resp = $term->readline($prompt);
976
		if (!defined $resp) { # EOF
977
			print "\n";
978
			return defined $default ? $default : undef;
979
		}
980
		if ($resp eq '' and defined $default) {
981
			return $default;
982
		}
983
		if (!defined $valid_re or $resp =~ /$valid_re/) {
984
			return $resp;
985
		}
986
		if ($confirm_only) {
987
			my $yesno = $term->readline(
988
				# TRANSLATORS: please keep [y/N] as is.
989
				sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
990
			if (defined $yesno && $yesno =~ /y/i) {
991
				return $resp;
992
			}
993
		}
994
	}
995
	return;
996
}
997

998
my %broken_encoding;
999

1000
sub file_declares_8bit_cte {
1001
	my $fn = shift;
1002
	open (my $fh, '<', $fn);
1003
	while (my $line = <$fh>) {
1004
		last if ($line =~ /^$/);
1005
		return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/);
1006
	}
1007
	close $fh;
1008
	return 0;
1009
}
1010

1011
foreach my $f (@files) {
1012
	next unless (body_or_subject_has_nonascii($f)
1013
		     && !file_declares_8bit_cte($f));
1014
	$broken_encoding{$f} = 1;
1015
}
1016

1017
if (!defined $auto_8bit_encoding && scalar %broken_encoding) {
1018
	print __("The following files are 8bit, but do not declare " .
1019
		 "a Content-Transfer-Encoding.\n");
1020
	foreach my $f (sort keys %broken_encoding) {
1021
		print "    $f\n";
1022
	}
1023
	$auto_8bit_encoding = ask(__("Which 8bit encoding should I declare [UTF-8]? "),
1024
				  valid_re => qr/.{4}/, confirm_only => 1,
1025
				  default => "UTF-8");
1026
}
1027

1028
if (!$force) {
1029
	for my $f (@files) {
1030
		if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
1031
			die sprintf(__("Refusing to send because the patch\n\t%s\n"
1032
				. "has the template subject '*** SUBJECT HERE ***'. "
1033
				. "Pass --force if you really want to send.\n"), $f);
1034
		}
1035
	}
1036
}
1037

1038
my $to_whom = __("To whom should the emails be sent (if anyone)?");
1039
my $prompting = 0;
1040
if (!@initial_to && !defined $to_cmd) {
1041
	my $to = ask("$to_whom ",
1042
		     default => "",
1043
		     valid_re => qr/\@.*\./, confirm_only => 1);
1044
	push @initial_to, parse_address_line($to) if defined $to; # sanitized/validated later
1045
	$prompting++;
1046
}
1047

1048
sub expand_aliases {
1049
	return map { expand_one_alias($_) } @_;
1050
}
1051

1052
my %EXPANDED_ALIASES;
1053
sub expand_one_alias {
1054
	my $alias = shift;
1055
	if ($EXPANDED_ALIASES{$alias}) {
1056
		die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
1057
	}
1058
	local $EXPANDED_ALIASES{$alias} = 1;
1059
	return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
1060
}
1061

1062
@initial_to = process_address_list(@initial_to);
1063
@initial_cc = process_address_list(@initial_cc);
1064
@initial_bcc = process_address_list(@initial_bcc);
1065

1066
if ($thread && !defined $initial_in_reply_to && $prompting) {
1067
	$initial_in_reply_to = ask(
1068
		__("Message-ID to be used as In-Reply-To for the first email (if any)? "),
1069
		default => "",
1070
		valid_re => qr/\@.*\./, confirm_only => 1);
1071
}
1072
if (defined $initial_in_reply_to) {
1073
	$initial_in_reply_to =~ s/^\s*<?//;
1074
	$initial_in_reply_to =~ s/>?\s*$//;
1075
	$initial_in_reply_to = "<$initial_in_reply_to>" if $initial_in_reply_to ne '';
1076
}
1077

1078
if (defined $reply_to) {
1079
	$reply_to =~ s/^\s+|\s+$//g;
1080
	($reply_to) = expand_aliases($reply_to);
1081
	$reply_to = sanitize_address($reply_to);
1082
}
1083

1084
if (!defined $sendmail_cmd && !defined $smtp_server) {
1085
	my @sendmail_paths = qw( /usr/sbin/sendmail /usr/lib/sendmail );
1086
	push @sendmail_paths, map {"$_/sendmail"} split /:/, $ENV{PATH};
1087
	foreach (@sendmail_paths) {
1088
		if (-x $_) {
1089
			$sendmail_cmd = $_;
1090
			last;
1091
		}
1092
	}
1093

1094
	if (!defined $sendmail_cmd) {
1095
		$smtp_server = 'localhost'; # could be 127.0.0.1, too... *shrug*
1096
	}
1097
}
1098

1099
if ($compose && $compose > 0) {
1100
	@files = ($compose_filename . ".final", @files);
1101
}
1102

1103
# Variables we set as part of the loop over files
1104
our ($message_id, %mail, $subject, $in_reply_to, $references, $message,
1105
	$needs_confirm, $message_num, $ask_default);
1106

1107
sub extract_valid_address {
1108
	my $address = shift;
1109
	my $local_part_regexp = qr/[^<>"\s@]+/;
1110
	my $domain_regexp = qr/[^.<>"\s@]+(?:\.[^.<>"\s@]+)+/;
1111

1112
	# check for a local address:
1113
	return $address if ($address =~ /^($local_part_regexp)$/);
1114

1115
	$address =~ s/^\s*<(.*)>\s*$/$1/;
1116
	my $have_email_valid = eval { require Email::Valid; 1 };
1117
	if ($have_email_valid) {
1118
		return scalar Email::Valid->address($address);
1119
	}
1120

1121
	# less robust/correct than the monster regexp in Email::Valid,
1122
	# but still does a 99% job, and one less dependency
1123
	return $1 if $address =~ /($local_part_regexp\@$domain_regexp)/;
1124
	return;
1125
}
1126

1127
sub extract_valid_address_or_die {
1128
	my $address = shift;
1129
	my $valid_address = extract_valid_address($address);
1130
	die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
1131
		if !$valid_address;
1132
	return $valid_address;
1133
}
1134

1135
sub validate_address {
1136
	my $address = shift;
1137
	while (!extract_valid_address($address)) {
1138
		printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
1139
		# TRANSLATORS: Make sure to include [q] [d] [e] in your
1140
		# translation. The program will only accept English input
1141
		# at this point.
1142
		$_ = ask(__("What to do with this address? ([q]uit|[d]rop|[e]dit): "),
1143
			valid_re => qr/^(?:quit|q|drop|d|edit|e)/i,
1144
			default => 'q');
1145
		if (/^d/i) {
1146
			return undef;
1147
		} elsif (/^q/i) {
1148
			cleanup_compose_files();
1149
			exit(0);
1150
		}
1151
		$address = ask("$to_whom ",
1152
			default => "",
1153
			valid_re => qr/\@.*\./, confirm_only => 1);
1154
	}
1155
	return $address;
1156
}
1157

1158
sub validate_address_list {
1159
	return (grep { defined $_ }
1160
		map { validate_address($_) } @_);
1161
}
1162

1163
# Usually don't need to change anything below here.
1164

1165
# we make a "fake" message id by taking the current number
1166
# of seconds since the beginning of Unix time and tacking on
1167
# a random number to the end, in case we are called quicker than
1168
# 1 second since the last time we were called.
1169

1170
# We'll setup a template for the message id, using the "from" address:
1171

1172
my ($message_id_stamp, $message_id_serial);
1173
sub make_message_id {
1174
	my $uniq;
1175
	if (!defined $message_id_stamp) {
1176
		require POSIX;
1177
		$message_id_stamp = POSIX::strftime("%Y%m%d%H%M%S.$$", gmtime(time));
1178
		$message_id_serial = 0;
1179
	}
1180
	$message_id_serial++;
1181
	$uniq = "$message_id_stamp-$message_id_serial";
1182

1183
	my $du_part;
1184
	for ($sender, $repocommitter->(), $repoauthor->()) {
1185
		$du_part = extract_valid_address(sanitize_address($_));
1186
		last if (defined $du_part and $du_part ne '');
1187
	}
1188
	if (not defined $du_part or $du_part eq '') {
1189
		require Sys::Hostname;
1190
		$du_part = 'user@' . Sys::Hostname::hostname();
1191
	}
1192
	my $message_id_template = "<%s-%s>";
1193
	$message_id = sprintf($message_id_template, $uniq, $du_part);
1194
	#print "new message id = $message_id\n"; # Was useful for debugging
1195
}
1196

1197
sub unquote_rfc2047 {
1198
	local ($_) = @_;
1199
	my $charset;
1200
	my $sep = qr/[ \t]+/;
1201
	s{$re_encoded_word(?:$sep$re_encoded_word)*}{
1202
		my @words = split $sep, $&;
1203
		foreach (@words) {
1204
			m/$re_encoded_word/;
1205
			$charset = $1;
1206
			my $encoding = $2;
1207
			my $text = $3;
1208
			if ($encoding eq 'q' || $encoding eq 'Q') {
1209
				$_ = $text;
1210
				s/_/ /g;
1211
				s/=([0-9A-F]{2})/chr(hex($1))/egi;
1212
			} else {
1213
				# other encodings not supported yet
1214
			}
1215
		}
1216
		join '', @words;
1217
	}eg;
1218
	return wantarray ? ($_, $charset) : $_;
1219
}
1220

1221
sub quote_rfc2047 {
1222
	local $_ = shift;
1223
	my $encoding = shift || 'UTF-8';
1224
	s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg;
1225
	s/(.*)/=\?$encoding\?q\?$1\?=/;
1226
	return $_;
1227
}
1228

1229
sub is_rfc2047_quoted {
1230
	my $s = shift;
1231
	length($s) <= 75 &&
1232
	$s =~ m/^(?:"[[:ascii:]]*"|$re_encoded_word)$/o;
1233
}
1234

1235
sub subject_needs_rfc2047_quoting {
1236
	my $s = shift;
1237

1238
	return ($s =~ /[^[:ascii:]]/) || ($s =~ /=\?/);
1239
}
1240

1241
sub quote_subject {
1242
	local $subject = shift;
1243
	my $encoding = shift || 'UTF-8';
1244

1245
	if (subject_needs_rfc2047_quoting($subject)) {
1246
		return quote_rfc2047($subject, $encoding);
1247
	}
1248
	return $subject;
1249
}
1250

1251
# use the simplest quoting being able to handle the recipient
1252
sub sanitize_address {
1253
	my ($recipient) = @_;
1254

1255
	# remove garbage after email address
1256
	$recipient =~ s/(.*>).*$/$1/;
1257

1258
	my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/);
1259

1260
	if (not $recipient_name) {
1261
		return $recipient;
1262
	}
1263

1264
	# if recipient_name is already quoted, do nothing
1265
	if (is_rfc2047_quoted($recipient_name)) {
1266
		return $recipient;
1267
	}
1268

1269
	# remove non-escaped quotes
1270
	$recipient_name =~ s/(^|[^\\])"/$1/g;
1271

1272
	# rfc2047 is needed if a non-ascii char is included
1273
	if ($recipient_name =~ /[^[:ascii:]]/) {
1274
		$recipient_name = quote_rfc2047($recipient_name);
1275
	}
1276

1277
	# double quotes are needed if specials or CTLs are included
1278
	elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) {
1279
		$recipient_name =~ s/([\\\r])/\\$1/g;
1280
		$recipient_name = qq["$recipient_name"];
1281
	}
1282

1283
	return "$recipient_name $recipient_addr";
1284

1285
}
1286

1287
sub strip_garbage_one_address {
1288
	my ($addr) = @_;
1289
	chomp $addr;
1290
	if ($addr =~ /^(("[^"]*"|[^"<]*)? *<[^>]*>).*/) {
1291
		# "Foo Bar" <foobar@example.com> [possibly garbage here]
1292
		# Foo Bar <foobar@example.com> [possibly garbage here]
1293
		return $1;
1294
	}
1295
	if ($addr =~ /^(<[^>]*>).*/) {
1296
		# <foo@example.com> [possibly garbage here]
1297
		# if garbage contains other addresses, they are ignored.
1298
		return $1;
1299
	}
1300
	if ($addr =~ /^([^"#,\s]*)/) {
1301
		# address without quoting: remove anything after the address
1302
		return $1;
1303
	}
1304
	return $addr;
1305
}
1306

1307
sub sanitize_address_list {
1308
	return (map { sanitize_address($_) } @_);
1309
}
1310

1311
sub process_address_list {
1312
	my @addr_list = map { parse_address_line($_) } @_;
1313
	@addr_list = expand_aliases(@addr_list);
1314
	@addr_list = sanitize_address_list(@addr_list);
1315
	@addr_list = validate_address_list(@addr_list);
1316
	return @addr_list;
1317
}
1318

1319
# Returns the local Fully Qualified Domain Name (FQDN) if available.
1320
#
1321
# Tightly configured MTAa require that a caller sends a real DNS
1322
# domain name that corresponds the IP address in the HELO/EHLO
1323
# handshake. This is used to verify the connection and prevent
1324
# spammers from trying to hide their identity. If the DNS and IP don't
1325
# match, the receiving MTA may deny the connection.
1326
#
1327
# Here is a deny example of Net::SMTP with the default "localhost.localdomain"
1328
#
1329
# Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain
1330
# Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host
1331
#
1332
# This maildomain*() code is based on ideas in Perl library Test::Reporter
1333
# /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain ()
1334

1335
sub valid_fqdn {
1336
	my $domain = shift;
1337
	return defined $domain && !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./;
1338
}
1339

1340
sub maildomain_net {
1341
	my $maildomain;
1342

1343
	require Net::Domain;
1344
	my $domain = Net::Domain::domainname();
1345
	$maildomain = $domain if valid_fqdn($domain);
1346

1347
	return $maildomain;
1348
}
1349

1350
sub maildomain_mta {
1351
	my $maildomain;
1352

1353
	for my $host (qw(mailhost localhost)) {
1354
		require Net::SMTP;
1355
		my $smtp = Net::SMTP->new($host);
1356
		if (defined $smtp) {
1357
			my $domain = $smtp->domain;
1358
			$smtp->quit;
1359

1360
			$maildomain = $domain if valid_fqdn($domain);
1361

1362
			last if $maildomain;
1363
		}
1364
	}
1365

1366
	return $maildomain;
1367
}
1368

1369
sub maildomain {
1370
	return maildomain_net() || maildomain_mta() || 'localhost.localdomain';
1371
}
1372

1373
sub smtp_host_string {
1374
	if (defined $smtp_server_port) {
1375
		return "$smtp_server:$smtp_server_port";
1376
	} else {
1377
		return $smtp_server;
1378
	}
1379
}
1380

1381
# Returns 1 if authentication succeeded or was not necessary
1382
# (smtp_user was not specified), and 0 otherwise.
1383

1384
sub smtp_auth_maybe {
1385
	if (!defined $smtp_authuser || $auth || (defined $smtp_auth && $smtp_auth eq "none")) {
1386
		return 1;
1387
	}
1388

1389
	# Workaround AUTH PLAIN/LOGIN interaction defect
1390
	# with Authen::SASL::Cyrus
1391
	eval {
1392
		require Authen::SASL;
1393
		Authen::SASL->import(qw(Perl));
1394
	};
1395

1396
	# Check mechanism naming as defined in:
1397
	# https://tools.ietf.org/html/rfc4422#page-8
1398
	if ($smtp_auth && $smtp_auth !~ /^(\b[A-Z0-9-_]{1,20}\s*)*$/) {
1399
		die "invalid smtp auth: '${smtp_auth}'";
1400
	}
1401

1402
	# TODO: Authentication may fail not because credentials were
1403
	# invalid but due to other reasons, in which we should not
1404
	# reject credentials.
1405
	$auth = Git::credential({
1406
		'protocol' => 'smtp',
1407
		'host' => smtp_host_string(),
1408
		'username' => $smtp_authuser,
1409
		# if there's no password, "git credential fill" will
1410
		# give us one, otherwise it'll just pass this one.
1411
		'password' => $smtp_authpass
1412
	}, sub {
1413
		my $cred = shift;
1414

1415
		if ($smtp_auth) {
1416
			my $sasl = Authen::SASL->new(
1417
				mechanism => $smtp_auth,
1418
				callback => {
1419
					user => $cred->{'username'},
1420
					pass => $cred->{'password'},
1421
					authname => $cred->{'username'},
1422
				}
1423
			);
1424

1425
			return !!$smtp->auth($sasl);
1426
		}
1427

1428
		return !!$smtp->auth($cred->{'username'}, $cred->{'password'});
1429
	});
1430

1431
	return $auth;
1432
}
1433

1434
sub ssl_verify_params {
1435
	eval {
1436
		require IO::Socket::SSL;
1437
		IO::Socket::SSL->import(qw/SSL_VERIFY_PEER SSL_VERIFY_NONE/);
1438
	};
1439
	if ($@) {
1440
		print STDERR "Not using SSL_VERIFY_PEER due to out-of-date IO::Socket::SSL.\n";
1441
		return;
1442
	}
1443

1444
	if (!defined $smtp_ssl_cert_path) {
1445
		# use the OpenSSL defaults
1446
		return (SSL_verify_mode => SSL_VERIFY_PEER());
1447
	}
1448

1449
	if ($smtp_ssl_cert_path eq "") {
1450
		return (SSL_verify_mode => SSL_VERIFY_NONE());
1451
	} elsif (-d $smtp_ssl_cert_path) {
1452
		return (SSL_verify_mode => SSL_VERIFY_PEER(),
1453
			SSL_ca_path => $smtp_ssl_cert_path);
1454
	} elsif (-f $smtp_ssl_cert_path) {
1455
		return (SSL_verify_mode => SSL_VERIFY_PEER(),
1456
			SSL_ca_file => $smtp_ssl_cert_path);
1457
	} else {
1458
		die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
1459
	}
1460
}
1461

1462
sub file_name_is_absolute {
1463
	my ($path) = @_;
1464

1465
	# msys does not grok DOS drive-prefixes
1466
	if ($^O eq 'msys') {
1467
		return ($path =~ m#^/# || $path =~ m#^[a-zA-Z]\:#)
1468
	}
1469

1470
	require File::Spec::Functions;
1471
	return File::Spec::Functions::file_name_is_absolute($path);
1472
}
1473

1474
sub gen_header {
1475
	my @recipients = unique_email_list(@to);
1476
	@cc = (grep { my $cc = extract_valid_address_or_die($_);
1477
		      not grep { $cc eq $_ || $_ =~ /<\Q${cc}\E>$/ } @recipients
1478
		    }
1479
	       @cc);
1480
	my $to = join (",\n\t", @recipients);
1481
	@recipients = unique_email_list(@recipients,@cc,@initial_bcc);
1482
	@recipients = (map { extract_valid_address_or_die($_) } @recipients);
1483
	my $date = format_2822_time($time++);
1484
	my $gitversion = '@@GIT_VERSION@@';
1485
	if ($gitversion =~ m/..GIT_VERSION../) {
1486
	    $gitversion = Git::version();
1487
	}
1488

1489
	my $cc = join(",\n\t", unique_email_list(@cc));
1490
	my $ccline = "";
1491
	if ($cc ne '') {
1492
		$ccline = "\nCc: $cc";
1493
	}
1494
	make_message_id() unless defined($message_id);
1495

1496
	my $header = "From: $sender
1497
To: $to${ccline}
1498
Subject: $subject
1499
Date: $date
1500
Message-ID: $message_id
1501
";
1502
	if ($use_xmailer) {
1503
		$header .= "X-Mailer: git-send-email $gitversion\n";
1504
	}
1505
	if ($in_reply_to) {
1506

1507
		$header .= "In-Reply-To: $in_reply_to\n";
1508
		$header .= "References: $references\n";
1509
	}
1510
	if ($reply_to) {
1511
		$header .= "Reply-To: $reply_to\n";
1512
	}
1513
	if (@xh) {
1514
		$header .= join("\n", @xh) . "\n";
1515
	}
1516
	my $recipients_ref = \@recipients;
1517
	return ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header);
1518
}
1519

1520
# Prepares the email, then asks the user what to do.
1521
#
1522
# If the user chooses to send the email, it's sent and 1 is returned.
1523
# If the user chooses not to send the email, 0 is returned.
1524
# If the user decides they want to make further edits, -1 is returned and the
1525
# caller is expected to call send_message again after the edits are performed.
1526
#
1527
# If an error occurs sending the email, this just dies.
1528

1529
sub send_message {
1530
	my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
1531
	my @recipients = @$recipients_ref;
1532

1533
	my @sendmail_parameters = ('-i', @recipients);
1534
	my $raw_from = $sender;
1535
	if (defined $envelope_sender && $envelope_sender ne "auto") {
1536
		$raw_from = $envelope_sender;
1537
	}
1538
	$raw_from = extract_valid_address($raw_from);
1539
	unshift (@sendmail_parameters,
1540
			'-f', $raw_from) if(defined $envelope_sender);
1541

1542
	if ($needs_confirm && !$dry_run) {
1543
		print "\n$header\n";
1544
		if ($needs_confirm eq "inform") {
1545
			$confirm_unconfigured = 0; # squelch this message for the rest of this run
1546
			$ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation
1547
			print __ <<EOF ;
1548
    The Cc list above has been expanded by additional
1549
    addresses found in the patch commit message. By default
1550
    send-email prompts before sending whenever this occurs.
1551
    This behavior is controlled by the sendemail.confirm
1552
    configuration setting.
1553

1554
    For additional information, run 'git send-email --help'.
1555
    To retain the current behavior, but squelch this message,
1556
    run 'git config --global sendemail.confirm auto'.
1557

1558
EOF
1559
		}
1560
		# TRANSLATORS: Make sure to include [y] [n] [e] [q] [a] in your
1561
		# translation. The program will only accept English input
1562
		# at this point.
1563
		$_ = ask(__("Send this email? ([y]es|[n]o|[e]dit|[q]uit|[a]ll): "),
1564
		         valid_re => qr/^(?:yes|y|no|n|edit|e|quit|q|all|a)/i,
1565
		         default => $ask_default);
1566
		die __("Send this email reply required") unless defined $_;
1567
		if (/^n/i) {
1568
			return 0;
1569
		} elsif (/^e/i) {
1570
			return -1;
1571
		} elsif (/^q/i) {
1572
			cleanup_compose_files();
1573
			exit(0);
1574
		} elsif (/^a/i) {
1575
			$confirm = 'never';
1576
		}
1577
	}
1578

1579
	unshift (@sendmail_parameters, @smtp_server_options);
1580

1581
	if ($dry_run) {
1582
		# We don't want to send the email.
1583
	} elsif (defined $sendmail_cmd || file_name_is_absolute($smtp_server)) {
1584
		my $pid = open my $sm, '|-';
1585
		defined $pid or die $!;
1586
		if (!$pid) {
1587
			if (defined $sendmail_cmd) {
1588
				exec ("sh", "-c", "$sendmail_cmd \"\$@\"", "-", @sendmail_parameters)
1589
					or die $!;
1590
			} else {
1591
				exec ($smtp_server, @sendmail_parameters)
1592
					or die $!;
1593
			}
1594
		}
1595
		print $sm "$header\n$message";
1596
		close $sm or die $!;
1597
	} else {
1598

1599
		if (!defined $smtp_server) {
1600
			die __("The required SMTP server is not properly defined.")
1601
		}
1602

1603
		require Net::SMTP;
1604
		my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
1605
		$smtp_domain ||= maildomain();
1606

1607
		if ($smtp_encryption eq 'ssl') {
1608
			$smtp_server_port ||= 465; # ssmtp
1609
			require IO::Socket::SSL;
1610

1611
			# Suppress "variable accessed once" warning.
1612
			{
1613
				no warnings 'once';
1614
				$IO::Socket::SSL::DEBUG = 1;
1615
			}
1616

1617
			# Net::SMTP::SSL->new() does not forward any SSL options
1618
			IO::Socket::SSL::set_client_defaults(
1619
				ssl_verify_params());
1620

1621
			if ($use_net_smtp_ssl) {
1622
				require Net::SMTP::SSL;
1623
				$smtp ||= Net::SMTP::SSL->new($smtp_server,
1624
							      Hello => $smtp_domain,
1625
							      Port => $smtp_server_port,
1626
							      Debug => $debug_net_smtp);
1627
			}
1628
			else {
1629
				$smtp ||= Net::SMTP->new($smtp_server,
1630
							 Hello => $smtp_domain,
1631
							 Port => $smtp_server_port,
1632
							 Debug => $debug_net_smtp,
1633
							 SSL => 1);
1634
			}
1635
		}
1636
		elsif (!$smtp) {
1637
			$smtp_server_port ||= 25;
1638
			$smtp ||= Net::SMTP->new($smtp_server,
1639
						 Hello => $smtp_domain,
1640
						 Debug => $debug_net_smtp,
1641
						 Port => $smtp_server_port);
1642
			if ($smtp_encryption eq 'tls' && $smtp) {
1643
				if ($use_net_smtp_ssl) {
1644
					$smtp->command('STARTTLS');
1645
					$smtp->response();
1646
					if ($smtp->code != 220) {
1647
						die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
1648
					}
1649
					require Net::SMTP::SSL;
1650
					$smtp = Net::SMTP::SSL->start_SSL($smtp,
1651
									  ssl_verify_params())
1652
						or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1653
				}
1654
				else {
1655
					$smtp->starttls(ssl_verify_params())
1656
						or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
1657
				}
1658
				# Send EHLO again to receive fresh
1659
				# supported commands
1660
				$smtp->hello($smtp_domain);
1661
			}
1662
		}
1663

1664
		if (!$smtp) {
1665
			die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
1666
			    " VALUES: server=$smtp_server ",
1667
			    "encryption=$smtp_encryption ",
1668
			    "hello=$smtp_domain",
1669
			    defined $smtp_server_port ? " port=$smtp_server_port" : "";
1670
		}
1671

1672
		smtp_auth_maybe or die $smtp->message;
1673

1674
		$smtp->mail( $raw_from ) or die $smtp->message;
1675
		$smtp->to( @recipients ) or die $smtp->message;
1676
		$smtp->data or die $smtp->message;
1677
		$smtp->datasend("$header\n") or die $smtp->message;
1678
		my @lines = split /^/, $message;
1679
		foreach my $line (@lines) {
1680
			$smtp->datasend("$line") or die $smtp->message;
1681
		}
1682
		$smtp->dataend() or die $smtp->message;
1683
		$smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
1684
	}
1685
	if ($quiet) {
1686
		printf($dry_run ? __("Dry-Sent %s") : __("Sent %s"), $subject);
1687
		print "\n";
1688
	} else {
1689
		print($dry_run ? __("Dry-OK. Log says:") : __("OK. Log says:"));
1690
		print "\n";
1691
		if (!defined $sendmail_cmd && !file_name_is_absolute($smtp_server)) {
1692
			print "Server: $smtp_server\n";
1693
			print "MAIL FROM:<$raw_from>\n";
1694
			foreach my $entry (@recipients) {
1695
			    print "RCPT TO:<$entry>\n";
1696
			}
1697
		} else {
1698
			my $sm;
1699
			if (defined $sendmail_cmd) {
1700
				$sm = $sendmail_cmd;
1701
			} else {
1702
				$sm = $smtp_server;
1703
			}
1704

1705
			print "Sendmail: $sm ".join(' ',@sendmail_parameters)."\n";
1706
		}
1707
		print $header, "\n";
1708
		if ($smtp) {
1709
			print __("Result: "), $smtp->code, ' ',
1710
				($smtp->message =~ /\n([^\n]+\n)$/s);
1711
		} else {
1712
			print __("Result: OK");
1713
		}
1714
		print "\n";
1715
	}
1716

1717
	return 1;
1718
}
1719

1720
sub pre_process_file {
1721
	my ($t, $quiet) = @_;
1722

1723
	open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
1724

1725
	my $author = undef;
1726
	my $sauthor = undef;
1727
	my $author_encoding;
1728
	my $has_content_type;
1729
	my $body_encoding;
1730
	my $xfer_encoding;
1731
	my $has_mime_version;
1732
	@to = ();
1733
	@cc = ();
1734
	@xh = ();
1735
	my $input_format = undef;
1736
	my @header = ();
1737
	$subject = $initial_subject;
1738
	$message = "";
1739
	$message_num++;
1740
	undef $message_id;
1741
	# Retrieve and unfold header fields.
1742
	my @header_lines = ();
1743
	while(<$fh>) {
1744
		last if /^\s*$/;
1745
		push(@header_lines, $_);
1746
	}
1747
	@header = unfold_headers(@header_lines);
1748
	# Add computed headers, if applicable.
1749
	unless ($no_header_cmd || ! $header_cmd) {
1750
		push @header, invoke_header_cmd($header_cmd, $t);
1751
	}
1752
	# Now parse the header
1753
	foreach(@header) {
1754
		if (/^From /) {
1755
			$input_format = 'mbox';
1756
			next;
1757
		}
1758
		chomp;
1759
		if (!defined $input_format && /^[-A-Za-z]+:\s/) {
1760
			$input_format = 'mbox';
1761
		}
1762

1763
		if (defined $input_format && $input_format eq 'mbox') {
1764
			if (/^Subject:\s+(.*)$/i) {
1765
				$subject = $1;
1766
			}
1767
			elsif (/^From:\s+(.*)$/i) {
1768
				($author, $author_encoding) = unquote_rfc2047($1);
1769
				$sauthor = sanitize_address($author);
1770
				next if $suppress_cc{'author'};
1771
				next if $suppress_cc{'self'} and $sauthor eq $sender;
1772
				printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1773
					$1, $_) unless $quiet;
1774
				push @cc, $1;
1775
			}
1776
			elsif (/^To:\s+(.*)$/i) {
1777
				foreach my $addr (parse_address_line($1)) {
1778
					printf(__("(mbox) Adding to: %s from line '%s'\n"),
1779
						$addr, $_) unless $quiet;
1780
					push @to, $addr;
1781
				}
1782
			}
1783
			elsif (/^Cc:\s+(.*)$/i) {
1784
				foreach my $addr (parse_address_line($1)) {
1785
					my $qaddr = unquote_rfc2047($addr);
1786
					my $saddr = sanitize_address($qaddr);
1787
					if ($saddr eq $sender) {
1788
						next if ($suppress_cc{'self'});
1789
					} else {
1790
						next if ($suppress_cc{'cc'});
1791
					}
1792
					printf(__("(mbox) Adding cc: %s from line '%s'\n"),
1793
						$addr, $_) unless $quiet;
1794
					push @cc, $addr;
1795
				}
1796
			}
1797
			elsif (/^Content-type:/i) {
1798
				$has_content_type = 1;
1799
				if (/charset="?([^ "]+)/) {
1800
					$body_encoding = $1;
1801
				}
1802
				push @xh, $_;
1803
			}
1804
			elsif (/^MIME-Version/i) {
1805
				$has_mime_version = 1;
1806
				push @xh, $_;
1807
			}
1808
			elsif (/^Message-ID: (.*)/i) {
1809
				$message_id = $1;
1810
			}
1811
			elsif (/^Content-Transfer-Encoding: (.*)/i) {
1812
				$xfer_encoding = $1 if not defined $xfer_encoding;
1813
			}
1814
			elsif (/^In-Reply-To: (.*)/i) {
1815
				if (!$initial_in_reply_to || $thread) {
1816
					$in_reply_to = $1;
1817
				}
1818
			}
1819
			elsif (/^References: (.*)/i) {
1820
				if (!$initial_in_reply_to || $thread) {
1821
					$references = $1;
1822
				}
1823
			}
1824
			elsif (!/^Date:\s/i && /^[-A-Za-z]+:\s+\S/) {
1825
				push @xh, $_;
1826
			}
1827
		} else {
1828
			# In the traditional
1829
			# "send lots of email" format,
1830
			# line 1 = cc
1831
			# line 2 = subject
1832
			# So let's support that, too.
1833
			$input_format = 'lots';
1834
			if (@cc == 0 && !$suppress_cc{'cc'}) {
1835
				printf(__("(non-mbox) Adding cc: %s from line '%s'\n"),
1836
					$_, $_) unless $quiet;
1837
				push @cc, $_;
1838
			} elsif (!defined $subject) {
1839
				$subject = $_;
1840
			}
1841
		}
1842
	}
1843
	# Now parse the message body
1844
	while(<$fh>) {
1845
		$message .=  $_;
1846
		if (/^([a-z][a-z-]*-by|Cc): (.*)/i) {
1847
			chomp;
1848
			my ($what, $c) = ($1, $2);
1849
			# strip garbage for the address we'll use:
1850
			$c = strip_garbage_one_address($c);
1851
			# sanitize a bit more to decide whether to suppress the address:
1852
			my $sc = sanitize_address($c);
1853
			if ($sc eq $sender) {
1854
				next if ($suppress_cc{'self'});
1855
			} else {
1856
				if ($what =~ /^Signed-off-by$/i) {
1857
					next if $suppress_cc{'sob'};
1858
				} elsif ($what =~ /-by$/i) {
1859
					next if $suppress_cc{'misc-by'};
1860
				} elsif ($what =~ /Cc/i) {
1861
					next if $suppress_cc{'bodycc'};
1862
				}
1863
			}
1864
			if ($c !~ /.+@.+|<.+>/) {
1865
				printf("(body) Ignoring %s from line '%s'\n",
1866
					$what, $_) unless $quiet;
1867
				next;
1868
			}
1869
			push @cc, $sc;
1870
			printf(__("(body) Adding cc: %s from line '%s'\n"),
1871
				$sc, $_) unless $quiet;
1872
		}
1873
	}
1874
	close $fh;
1875

1876
	push @to, recipients_cmd("to-cmd", "to", $to_cmd, $t, $quiet)
1877
		if defined $to_cmd;
1878
	push @cc, recipients_cmd("cc-cmd", "cc", $cc_cmd, $t, $quiet)
1879
		if defined $cc_cmd && !$suppress_cc{'cccmd'};
1880

1881
	if ($broken_encoding{$t} && !$has_content_type) {
1882
		$xfer_encoding = '8bit' if not defined $xfer_encoding;
1883
		$has_content_type = 1;
1884
		push @xh, "Content-Type: text/plain; charset=$auto_8bit_encoding";
1885
		$body_encoding = $auto_8bit_encoding;
1886
	}
1887

1888
	if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) {
1889
		$subject = quote_subject($subject, $auto_8bit_encoding);
1890
	}
1891

1892
	if (defined $sauthor and $sauthor ne $sender) {
1893
		$message = "From: $author\n\n$message";
1894
		if (defined $author_encoding) {
1895
			if ($has_content_type) {
1896
				if ($body_encoding eq $author_encoding) {
1897
					# ok, we already have the right encoding
1898
				}
1899
				else {
1900
					# uh oh, we should re-encode
1901
				}
1902
			}
1903
			else {
1904
				$xfer_encoding = '8bit' if not defined $xfer_encoding;
1905
				$has_content_type = 1;
1906
				push @xh,
1907
				  "Content-Type: text/plain; charset=$author_encoding";
1908
			}
1909
		}
1910
	}
1911
	$xfer_encoding = '8bit' if not defined $xfer_encoding;
1912
	($message, $xfer_encoding) = apply_transfer_encoding(
1913
		$message, $xfer_encoding, $target_xfer_encoding);
1914
	push @xh, "Content-Transfer-Encoding: $xfer_encoding";
1915
	unshift @xh, 'MIME-Version: 1.0' unless $has_mime_version;
1916

1917
	$needs_confirm = (
1918
		$confirm eq "always" or
1919
		($confirm =~ /^(?:auto|cc)$/ && @cc) or
1920
		($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1));
1921
	$needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc);
1922

1923
	@to = process_address_list(@to);
1924
	@cc = process_address_list(@cc);
1925

1926
	@to = (@initial_to, @to);
1927
	@cc = (@initial_cc, @cc);
1928

1929
	if ($message_num == 1) {
1930
		if (defined $cover_cc and $cover_cc) {
1931
			@initial_cc = @cc;
1932
		}
1933
		if (defined $cover_to and $cover_to) {
1934
			@initial_to = @to;
1935
		}
1936
	}
1937
}
1938

1939
# Prepares the email, prompts the user, and sends it out
1940
# Returns 0 if an edit was done and the function should be called again, or 1
1941
# on the email being successfully sent out.
1942
sub process_file {
1943
	my ($t) = @_;
1944

1945
        pre_process_file($t, $quiet);
1946

1947
	my $message_was_sent = send_message();
1948
	if ($message_was_sent == -1) {
1949
		do_edit($t);
1950
		return 0;
1951
	}
1952

1953
	# set up for the next message
1954
	if ($thread) {
1955
		if ($message_was_sent &&
1956
		  ($chain_reply_to || !defined $in_reply_to || length($in_reply_to) == 0 ||
1957
		  $message_num == 1)) {
1958
			$in_reply_to = $message_id;
1959
			if (length $references > 0) {
1960
				$references .= "\n $message_id";
1961
			} else {
1962
				$references = "$message_id";
1963
			}
1964
		}
1965
	} elsif (!defined $initial_in_reply_to) {
1966
		# --thread and --in-reply-to manage the "In-Reply-To" header and by
1967
		# extension the "References" header. If these commands are not used, reset
1968
		# the header values to their defaults.
1969
		$in_reply_to = undef;
1970
		$references = '';
1971
	}
1972
	$message_id = undef;
1973
	$num_sent++;
1974
	if (defined $batch_size && $num_sent == $batch_size) {
1975
		$num_sent = 0;
1976
		$smtp->quit if defined $smtp;
1977
		undef $smtp;
1978
		undef $auth;
1979
		sleep($relogin_delay) if defined $relogin_delay;
1980
	}
1981

1982
	return 1;
1983
}
1984

1985
sub initialize_modified_loop_vars {
1986
	$in_reply_to = $initial_in_reply_to;
1987
	$references = $initial_in_reply_to || '';
1988
	$message_num = 0;
1989
}
1990

1991
if ($validate) {
1992
	# FIFOs can only be read once, exclude them from validation.
1993
	my @real_files = ();
1994
	foreach my $f (@files) {
1995
		unless (-p $f) {
1996
			push(@real_files, $f);
1997
		}
1998
	}
1999

2000
	# Run the loop once again to avoid gaps in the counter due to FIFO
2001
	# arguments provided by the user.
2002
	my $num = 1;
2003
	my $num_files = scalar @real_files;
2004
	$ENV{GIT_SENDEMAIL_FILE_TOTAL} = "$num_files";
2005
	initialize_modified_loop_vars();
2006
	foreach my $r (@real_files) {
2007
		$ENV{GIT_SENDEMAIL_FILE_COUNTER} = "$num";
2008
		pre_process_file($r, 1);
2009
		validate_patch($r, $target_xfer_encoding);
2010
		$num += 1;
2011
	}
2012
	delete $ENV{GIT_SENDEMAIL_FILE_COUNTER};
2013
	delete $ENV{GIT_SENDEMAIL_FILE_TOTAL};
2014
}
2015

2016
initialize_modified_loop_vars();
2017
foreach my $t (@files) {
2018
	while (!process_file($t)) {
2019
		# user edited the file
2020
	}
2021
}
2022

2023
# Execute a command and return its output lines as an array.  Blank
2024
# lines which do not appear at the end of the output are reported as
2025
# errors.
2026
sub execute_cmd {
2027
	my ($prefix, $cmd, $file) = @_;
2028
	my @lines = ();
2029
	my $seen_blank_line = 0;
2030
	open my $fh, "-|", "$cmd \Q$file\E"
2031
		or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
2032
	while (my $line = <$fh>) {
2033
		die sprintf(__("(%s) Malformed output from '%s'"), $prefix, $cmd)
2034
		    if $seen_blank_line;
2035
		if ($line =~ /^$/) {
2036
			$seen_blank_line = $line =~ /^$/;
2037
			next;
2038
		}
2039
		push @lines, $line;
2040
	}
2041
	close $fh
2042
	    or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
2043
	return @lines;
2044
}
2045

2046
# Process headers lines, unfolding multiline headers as defined by RFC
2047
# 2822.
2048
sub unfold_headers {
2049
	my @headers;
2050
	foreach(@_) {
2051
		last if /^\s*$/;
2052
		if (/^\s+\S/ and @headers) {
2053
			chomp($headers[$#headers]);
2054
			s/^\s+/ /;
2055
			$headers[$#headers] .= $_;
2056
		} else {
2057
			push(@headers, $_);
2058
		}
2059
	}
2060
	return @headers;
2061
}
2062

2063
# Invoke the provided CMD with FILE as an argument, which should
2064
# output RFC 2822 email headers. Fold multiline headers and return the
2065
# headers as an array.
2066
sub invoke_header_cmd {
2067
	my ($cmd, $file) = @_;
2068
	my @lines = execute_cmd("header-cmd", $header_cmd, $file);
2069
	return unfold_headers(@lines);
2070
}
2071

2072
# Execute a command (e.g. $to_cmd) to get a list of email addresses
2073
# and return a results array
2074
sub recipients_cmd {
2075
	my ($prefix, $what, $cmd, $file, $quiet) = @_;
2076
	my @lines = ();
2077
	my @addresses = ();
2078

2079
	@lines = execute_cmd($prefix, $cmd, $file);
2080
	for my $address (@lines) {
2081
		$address =~ s/^\s*//g;
2082
		$address =~ s/\s*$//g;
2083
		$address = sanitize_address($address);
2084
		next if ($address eq $sender and $suppress_cc{'self'});
2085
		push @addresses, $address;
2086
		printf(__("(%s) Adding %s: %s from: '%s'\n"),
2087
		       $prefix, $what, $address, $cmd) unless $quiet;
2088
		}
2089
	return @addresses;
2090
}
2091

2092
cleanup_compose_files();
2093

2094
sub cleanup_compose_files {
2095
	unlink($compose_filename, $compose_filename . ".final") if $compose;
2096
}
2097

2098
$smtp->quit if $smtp;
2099

2100
sub apply_transfer_encoding {
2101
	my $message = shift;
2102
	my $from = shift;
2103
	my $to = shift;
2104

2105
	return ($message, $to) if ($from eq $to and $from ne '7bit');
2106

2107
	require MIME::QuotedPrint;
2108
	require MIME::Base64;
2109

2110
	$message = MIME::QuotedPrint::decode($message)
2111
		if ($from eq 'quoted-printable');
2112
	$message = MIME::Base64::decode($message)
2113
		if ($from eq 'base64');
2114

2115
	$to = ($message =~ /(?:.{999,}|\r)/) ? 'quoted-printable' : '8bit'
2116
		if $to eq 'auto';
2117

2118
	die __("cannot send message as 7bit")
2119
		if ($to eq '7bit' and $message =~ /[^[:ascii:]]/);
2120
	return ($message, $to)
2121
		if ($to eq '7bit' or $to eq '8bit');
2122
	return (MIME::QuotedPrint::encode($message, "\n", 0), $to)
2123
		if ($to eq 'quoted-printable');
2124
	return (MIME::Base64::encode($message, "\n"), $to)
2125
		if ($to eq 'base64');
2126
	die __("invalid transfer encoding");
2127
}
2128

2129
sub unique_email_list {
2130
	my %seen;
2131
	my @emails;
2132

2133
	foreach my $entry (@_) {
2134
		my $clean = extract_valid_address_or_die($entry);
2135
		$seen{$clean} ||= 0;
2136
		next if $seen{$clean}++;
2137
		push @emails, $entry;
2138
	}
2139
	return @emails;
2140
}
2141

2142
sub validate_patch {
2143
	my ($fn, $xfer_encoding) = @_;
2144

2145
	if ($repo) {
2146
		my $hook_name = 'sendemail-validate';
2147
		my $hooks_path = $repo->command_oneline('rev-parse', '--git-path', 'hooks');
2148
		require File::Spec;
2149
		my $validate_hook = File::Spec->catfile($hooks_path, $hook_name);
2150
		my $hook_error;
2151
		if (-x $validate_hook) {
2152
			require Cwd;
2153
			my $target = Cwd::abs_path($fn);
2154
			# The hook needs a correct cwd and GIT_DIR.
2155
			my $cwd_save = Cwd::getcwd();
2156
			chdir($repo->wc_path() or $repo->repo_path())
2157
				or die("chdir: $!");
2158
			local $ENV{"GIT_DIR"} = $repo->repo_path();
2159

2160
			my ($recipients_ref, $to, $date, $gitversion, $cc, $ccline, $header) = gen_header();
2161

2162
			require File::Temp;
2163
			my ($header_filehandle, $header_filename) = File::Temp::tempfile(
2164
                            TEMPLATE => ".gitsendemail.header.XXXXXX",
2165
                            DIR => $repo->repo_path(),
2166
                            UNLINK => 1,
2167
                        );
2168
			print $header_filehandle $header;
2169

2170
			my @cmd = ("git", "hook", "run", "--ignore-missing",
2171
				    $hook_name, "--");
2172
			my @cmd_msg = (@cmd, "<patch>", "<header>");
2173
			my @cmd_run = (@cmd, $target, $header_filename);
2174
			$hook_error = system_or_msg(\@cmd_run, undef, "@cmd_msg");
2175
			chdir($cwd_save) or die("chdir: $!");
2176
		}
2177
		if ($hook_error) {
2178
			$hook_error = sprintf(
2179
			    __("fatal: %s: rejected by %s hook\n%s\nwarning: no patches were sent\n"),
2180
			    $fn, $hook_name, $hook_error);
2181
			die $hook_error;
2182
		}
2183
	}
2184

2185
	# Any long lines will be automatically fixed if we use a suitable transfer
2186
	# encoding.
2187
	unless ($xfer_encoding =~ /^(?:auto|quoted-printable|base64)$/) {
2188
		open(my $fh, '<', $fn)
2189
			or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2190
		while (my $line = <$fh>) {
2191
			if (length($line) > 998) {
2192
				die sprintf(__("fatal: %s:%d is longer than 998 characters\n" .
2193
					       "warning: no patches were sent\n"), $fn, $.);
2194
			}
2195
		}
2196
	}
2197
	return;
2198
}
2199

2200
sub handle_backup {
2201
	my ($last, $lastlen, $file, $known_suffix) = @_;
2202
	my ($suffix, $skip);
2203

2204
	$skip = 0;
2205
	if (defined $last &&
2206
	    ($lastlen < length($file)) &&
2207
	    (substr($file, 0, $lastlen) eq $last) &&
2208
	    ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
2209
		if (defined $known_suffix && $suffix eq $known_suffix) {
2210
			printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
2211
			$skip = 1;
2212
		} else {
2213
			# TRANSLATORS: please keep "[y|N]" as is.
2214
			my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
2215
					 valid_re => qr/^(?:y|n)/i,
2216
					 default => 'n');
2217
			$skip = ($answer ne 'y');
2218
			if ($skip) {
2219
				$known_suffix = $suffix;
2220
			}
2221
		}
2222
	}
2223
	return ($skip, $known_suffix);
2224
}
2225

2226
sub handle_backup_files {
2227
	my @file = @_;
2228
	my ($last, $lastlen, $known_suffix, $skip, @result);
2229
	for my $file (@file) {
2230
		($skip, $known_suffix) = handle_backup($last, $lastlen,
2231
						       $file, $known_suffix);
2232
		push @result, $file unless $skip;
2233
		$last = $file;
2234
		$lastlen = length($file);
2235
	}
2236
	return @result;
2237
}
2238

2239
sub file_has_nonascii {
2240
	my $fn = shift;
2241
	open(my $fh, '<', $fn)
2242
		or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2243
	while (my $line = <$fh>) {
2244
		return 1 if $line =~ /[^[:ascii:]]/;
2245
	}
2246
	return 0;
2247
}
2248

2249
sub body_or_subject_has_nonascii {
2250
	my $fn = shift;
2251
	open(my $fh, '<', $fn)
2252
		or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
2253
	while (my $line = <$fh>) {
2254
		last if $line =~ /^$/;
2255
		return 1 if $line =~ /^Subject.*[^[:ascii:]]/;
2256
	}
2257
	while (my $line = <$fh>) {
2258
		return 1 if $line =~ /[^[:ascii:]]/;
2259
	}
2260
	return 0;
2261
}
2262