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