progress: simplify "delayed" progress API
[gitweb.git] / git-send-email.perl
index 00d234e11476f75c5f7ce4e99bd0ac7f6344ad79..fa6526986ed40143a12ffcd6563fd52b49d209e7 100755 (executable)
@@ -25,8 +25,9 @@
 use Text::ParseWords;
 use Term::ANSIColor;
 use File::Temp qw/ tempdir tempfile /;
-use File::Spec::Functions qw(catfile);
+use File::Spec::Functions qw(catdir catfile);
 use Error qw(:try);
+use Cwd qw(abs_path cwd);
 use Git;
 use Git::I18N;
 
@@ -81,6 +82,10 @@ sub usage {
                                      This setting forces to use one of the listed mechanisms.
     --smtp-debug            <0|1>  * Disable, enable Net::SMTP debug.
 
+    --batch-size            <int>  * send max <int> message per connection.
+    --relogin-delay         <int>  * delay <int> seconds between two successive login.
+                                     This option can only be used with --batch-size
+
   Automating:
     --identity              <str>  * Use the sendemail.<id> options.
     --to-cmd                <str>  * Email To: via `<str> \$patch_path`
@@ -153,6 +158,7 @@ sub format_2822_time {
 my $have_mail_address = eval { require Mail::Address; 1 };
 my $smtp;
 my $auth;
+my $num_sent = 0;
 
 # Regexes for RFC 2047 productions.
 my $re_token = qr/[^][()<>@,;:\\"\/?.= \000-\037\177-\377]+/;
@@ -216,6 +222,7 @@ sub do_edit {
 my ($to_cmd, $cc_cmd);
 my ($smtp_server, $smtp_server_port, @smtp_server_options);
 my ($smtp_authuser, $smtp_encryption, $smtp_ssl_cert_path);
+my ($batch_size, $relogin_delay);
 my ($identity, $aliasfiletype, @alias_files, $smtp_domain, $smtp_auth);
 my ($validate, $confirm);
 my (@suppress_cc);
@@ -247,6 +254,8 @@ sub do_edit {
     "smtppass" => \$smtp_authpass,
     "smtpdomain" => \$smtp_domain,
     "smtpauth" => \$smtp_auth,
+    "smtpbatchsize" => \$batch_size,
+    "smtprelogindelay" => \$relogin_delay,
     "to" => \@initial_to,
     "tocmd" => \$to_cmd,
     "cc" => \@initial_cc,
@@ -279,10 +288,13 @@ sub signal_handler {
        # tmp files from --compose
        if (defined $compose_filename) {
                if (-e $compose_filename) {
-                       print "'$compose_filename' contains an intermediate version of the email you were composing.\n";
+                       printf __("'%s' contains an intermediate version ".
+                                 "of the email you were composing.\n"),
+                                 $compose_filename;
                }
                if (-e ($compose_filename . ".final")) {
-                       print "'$compose_filename.final' contains the composed email.\n"
+                       printf __("'%s.final' contains the composed email.\n"),
+                                 $compose_filename;
                }
        }
 
@@ -355,6 +367,8 @@ sub signal_handler {
                    "force" => \$force,
                    "xmailer!" => \$use_xmailer,
                    "no-xmailer" => sub {$use_xmailer = 0},
+                   "batch-size=i" => \$batch_size,
+                   "relogin-delay=i" => \$relogin_delay,
         );
 
 usage() if $help;
@@ -431,7 +445,7 @@ sub read_config {
 my(%suppress_cc);
 if (@suppress_cc) {
        foreach my $entry (@suppress_cc) {
-               die "Unknown --suppress-cc field: '$entry'\n"
+               die sprintf(__("Unknown --suppress-cc field: '%s'\n"), $entry)
                        unless $entry =~ /^(?:all|cccmd|cc|author|self|sob|body|bodycc)$/;
                $suppress_cc{$entry} = 1;
        }
@@ -460,7 +474,7 @@ sub read_config {
 if ($confirm_unconfigured) {
        $confirm = scalar %suppress_cc ? 'compose' : 'auto';
 };
-die "Unknown --confirm setting: '$confirm'\n"
+die sprintf(__("Unknown --confirm setting: '%s'\n"), $confirm)
        unless $confirm =~ /^(?:auto|cc|compose|always|never)/;
 
 # Debugging, print out the suppressions.
@@ -492,16 +506,16 @@ sub split_addrs {
 sub parse_sendmail_alias {
        local $_ = shift;
        if (/"/) {
-               print STDERR "warning: sendmail alias with quotes is not supported: $_\n";
+               printf STDERR __("warning: sendmail alias with quotes is not supported: %s\n"), $_;
        } elsif (/:include:/) {
-               print STDERR "warning: `:include:` not supported: $_\n";
+               printf STDERR __("warning: `:include:` not supported: %s\n"), $_;
        } elsif (/[\/|]/) {
-               print STDERR "warning: `/file` or `|pipe` redirection not supported: $_\n";
+               printf STDERR __("warning: `/file` or `|pipe` redirection not supported: %s\n"), $_;
        } elsif (/^(\S+?)\s*:\s*(.+)$/) {
                my ($alias, $addr) = ($1, $2);
                $aliases{$alias} = [ split_addrs($addr) ];
        } else {
-               print STDERR "warning: sendmail line is not recognized: $_\n";
+               printf STDERR __("warning: sendmail line is not recognized: %s\n"), $_;
        }
 }
 
@@ -582,11 +596,11 @@ sub is_format_patch_arg {
                if (defined($format_patch)) {
                        return $format_patch;
                }
-               die(<<EOF);
-File '$f' exists but it could also be the range of commits
+               die sprintf(__ <<EOF, $f, $f);
+File '%s' exists but it could also be the range of commits
 to produce patches for.  Please disambiguate by...
 
-    * Saying "./$f" if you mean a file; or
+    * Saying "./%s" if you mean a file; or
     * Giving --format-patch option if you mean a range.
 EOF
        } catch Git::Error::Command with {
@@ -604,7 +618,7 @@ sub is_format_patch_arg {
                @ARGV = ();
        } elsif (-d $f and !is_format_patch_arg($f)) {
                opendir my $dh, $f
-                       or die "Failed to opendir $f: $!";
+                       or die sprintf(__("Failed to opendir %s: %s"), $f, $!);
 
                push @files, grep { -f $_ } map { catfile($f, $_) }
                                sort readdir $dh;
@@ -628,7 +642,8 @@ sub is_format_patch_arg {
        foreach my $f (@files) {
                unless (-p $f) {
                        my $error = validate_patch($f);
-                       $error and die "fatal: $f: $error\nwarning: no patches were sent\n";
+                       $error and die sprintf(__("fatal: %s: %s\nwarning: no patches were sent\n"),
+                                                 $f, $error);
                }
        }
 }
@@ -651,7 +666,7 @@ sub get_patch_subject {
                return "GIT: $1\n";
        }
        close $fh;
-       die "No subject line in $fn ?";
+       die sprintf(__("No subject line in %s?"), $fn);
 }
 
 if ($compose) {
@@ -661,25 +676,27 @@ sub get_patch_subject {
                tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) :
                tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1];
        open my $c, ">", $compose_filename
-               or die "Failed to open for writing $compose_filename: $!";
+               or die sprintf(__("Failed to open for writing %s: %s"), $compose_filename, $!);
 
 
        my $tpl_sender = $sender || $repoauthor || $repocommitter || '';
        my $tpl_subject = $initial_subject || '';
        my $tpl_reply_to = $initial_reply_to || '';
 
-       print $c <<EOT;
+       print $c <<EOT1, Git::prefix_lines("GIT: ", __ <<EOT2), <<EOT3;
 From $tpl_sender # This line is ignored.
-GIT: Lines beginning in "GIT:" will be removed.
-GIT: Consider including an overall diffstat or table of contents
-GIT: for the patch you are writing.
-GIT:
-GIT: Clear the body content if you don't wish to send a summary.
+EOT1
+Lines beginning in "GIT:" will be removed.
+Consider including an overall diffstat or table of contents
+for the patch you are writing.
+
+Clear the body content if you don't wish to send a summary.
+EOT2
 From: $tpl_sender
 Subject: $tpl_subject
 In-Reply-To: $tpl_reply_to
 
-EOT
+EOT3
        for my $f (@files) {
                print $c get_patch_subject($f);
        }
@@ -692,10 +709,10 @@ sub get_patch_subject {
        }
 
        open my $c2, ">", $compose_filename . ".final"
-               or die "Failed to open $compose_filename.final : " . $!;
+               or die sprintf(__("Failed to open %s.final: %s"), $compose_filename, $!);
 
        open $c, "<", $compose_filename
-               or die "Failed to open $compose_filename : " . $!;
+               or die sprintf(__("Failed to open %s: %s"), $compose_filename, $!);
 
        my $need_8bit_cte = file_has_nonascii($compose_filename);
        my $in_body = 0;
@@ -769,7 +786,9 @@ sub ask {
                        return $resp;
                }
                if ($confirm_only) {
-                       my $yesno = $term->readline("Are you sure you want to use <$resp> [y/N]? ");
+                       my $yesno = $term->readline(
+                               # TRANSLATORS: please keep [y/N] as is.
+                               sprintf(__("Are you sure you want to use <%s> [y/N]? "), $resp));
                        if (defined $yesno && $yesno =~ /y/i) {
                                return $resp;
                        }
@@ -811,9 +830,9 @@ sub file_declares_8bit_cte {
 if (!$force) {
        for my $f (@files) {
                if (get_patch_subject($f) =~ /\Q*** SUBJECT HERE ***\E/) {
-                       die "Refusing to send because the patch\n\t$f\n"
+                       die sprintf(__("Refusing to send because the patch\n\t%s\n"
                                . "has the template subject '*** SUBJECT HERE ***'. "
-                               . "Pass --force if you really want to send.\n";
+                               . "Pass --force if you really want to send.\n"), $f);
                }
        }
 }
@@ -848,7 +867,7 @@ sub expand_aliases {
 sub expand_one_alias {
        my $alias = shift;
        if ($EXPANDED_ALIASES{$alias}) {
-               die "fatal: alias '$alias' expands to itself\n";
+               die sprintf(__("fatal: alias '%s' expands to itself\n"), $alias);
        }
        local $EXPANDED_ALIASES{$alias} = 1;
        return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias;
@@ -910,7 +929,7 @@ sub extract_valid_address {
 sub extract_valid_address_or_die {
        my $address = shift;
        $address = extract_valid_address($address);
-       die "error: unable to extract a valid address from: $address\n"
+       die sprintf(__("error: unable to extract a valid address from: %s\n"), $address)
                if !$address;
        return $address;
 }
@@ -918,7 +937,7 @@ sub extract_valid_address_or_die {
 sub validate_address {
        my $address = shift;
        while (!extract_valid_address($address)) {
-               print STDERR "error: unable to extract a valid address from: $address\n";
+               printf STDERR __("error: unable to extract a valid address from: %s\n"), $address;
                # TRANSLATORS: Make sure to include [q] [d] [e] in your
                # translation. The program will only accept English input
                # at this point.
@@ -1223,7 +1242,7 @@ sub ssl_verify_params {
                return (SSL_verify_mode => SSL_VERIFY_PEER(),
                        SSL_ca_file => $smtp_ssl_cert_path);
        } else {
-               die "CA path \"$smtp_ssl_cert_path\" does not exist";
+               die sprintf(__("CA path \"%s\" does not exist"), $smtp_ssl_cert_path);
        }
 }
 
@@ -1345,10 +1364,12 @@ sub send_message {
                        die __("The required SMTP server is not properly defined.")
                }
 
+               require Net::SMTP;
+               my $use_net_smtp_ssl = version->parse($Net::SMTP::VERSION) < version->parse("2.34");
+               $smtp_domain ||= maildomain();
+
                if ($smtp_encryption eq 'ssl') {
                        $smtp_server_port ||= 465; # ssmtp
-                       require Net::SMTP::SSL;
-                       $smtp_domain ||= maildomain();
                        require IO::Socket::SSL;
 
                        # Suppress "variable accessed once" warning.
@@ -1360,40 +1381,54 @@ sub send_message {
                        # Net::SMTP::SSL->new() does not forward any SSL options
                        IO::Socket::SSL::set_client_defaults(
                                ssl_verify_params());
-                       $smtp ||= Net::SMTP::SSL->new($smtp_server,
-                                                     Hello => $smtp_domain,
-                                                     Port => $smtp_server_port,
-                                                     Debug => $debug_net_smtp);
+
+                       if ($use_net_smtp_ssl) {
+                               require Net::SMTP::SSL;
+                               $smtp ||= Net::SMTP::SSL->new($smtp_server,
+                                                             Hello => $smtp_domain,
+                                                             Port => $smtp_server_port,
+                                                             Debug => $debug_net_smtp);
+                       }
+                       else {
+                               $smtp ||= Net::SMTP->new($smtp_server,
+                                                        Hello => $smtp_domain,
+                                                        Port => $smtp_server_port,
+                                                        Debug => $debug_net_smtp,
+                                                        SSL => 1);
+                       }
                }
                else {
-                       require Net::SMTP;
-                       $smtp_domain ||= maildomain();
                        $smtp_server_port ||= 25;
                        $smtp ||= Net::SMTP->new($smtp_server,
                                                 Hello => $smtp_domain,
                                                 Debug => $debug_net_smtp,
                                                 Port => $smtp_server_port);
                        if ($smtp_encryption eq 'tls' && $smtp) {
-                               require Net::SMTP::SSL;
-                               $smtp->command('STARTTLS');
-                               $smtp->response();
-                               if ($smtp->code == 220) {
+                               if ($use_net_smtp_ssl) {
+                                       $smtp->command('STARTTLS');
+                                       $smtp->response();
+                                       if ($smtp->code != 220) {
+                                               die sprintf(__("Server does not support STARTTLS! %s"), $smtp->message);
+                                       }
+                                       require Net::SMTP::SSL;
                                        $smtp = Net::SMTP::SSL->start_SSL($smtp,
                                                                          ssl_verify_params())
-                                               or die "STARTTLS failed! ".IO::Socket::SSL::errstr();
-                                       $smtp_encryption = '';
-                                       # Send EHLO again to receive fresh
-                                       # supported commands
-                                       $smtp->hello($smtp_domain);
-                               } else {
-                                       die "Server does not support STARTTLS! ".$smtp->message;
+                                               or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
                                }
+                               else {
+                                       $smtp->starttls(ssl_verify_params())
+                                               or die sprintf(__("STARTTLS failed! %s"), IO::Socket::SSL::errstr());
+                               }
+                               $smtp_encryption = '';
+                               # Send EHLO again to receive fresh
+                               # supported commands
+                               $smtp->hello($smtp_domain);
                        }
                }
 
                if (!$smtp) {
-                       die "Unable to initialize SMTP properly. Check config and use --smtp-debug. ",
-                           "VALUES: server=$smtp_server ",
+                       die __("Unable to initialize SMTP properly. Check config and use --smtp-debug."),
+                           " VALUES: server=$smtp_server ",
                            "encryption=$smtp_encryption ",
                            "hello=$smtp_domain",
                            defined $smtp_server_port ? " port=$smtp_server_port" : "";
@@ -1410,10 +1445,10 @@ sub send_message {
                        $smtp->datasend("$line") or die $smtp->message;
                }
                $smtp->dataend() or die $smtp->message;
-               $smtp->code =~ /250|200/ or die "Failed to send $subject\n".$smtp->message;
+               $smtp->code =~ /250|200/ or die sprintf(__("Failed to send %s\n"), $subject).$smtp->message;
        }
        if ($quiet) {
-               printf (($dry_run ? "Dry-" : "")."Sent %s\n", $subject);
+               printf($dry_run ? __("Dry-Sent %s\n") : __("Sent %s\n"), $subject);
        } else {
                print($dry_run ? __("Dry-OK. Log says:\n") : __("OK. Log says:\n"));
                if (!file_name_is_absolute($smtp_server)) {
@@ -1443,7 +1478,7 @@ sub send_message {
 $message_num = 0;
 
 foreach my $t (@files) {
-       open my $fh, "<", $t or die "can't open file $t";
+       open my $fh, "<", $t or die sprintf(__("can't open file %s"), $t);
 
        my $author = undef;
        my $sauthor = undef;
@@ -1555,7 +1590,7 @@ sub send_message {
        # Now parse the message body
        while(<$fh>) {
                $message .=  $_;
-               if (/^(Signed-off-by|Cc): (.*)$/i) {
+               if (/^(Signed-off-by|Cc): ([^>]*>?)/i) {
                        chomp;
                        my ($what, $c) = ($1, $2);
                        chomp $c;
@@ -1656,6 +1691,14 @@ sub send_message {
                }
        }
        $message_id = undef;
+       $num_sent++;
+       if (defined $batch_size && $num_sent == $batch_size) {
+               $num_sent = 0;
+               $smtp->quit if defined $smtp;
+               undef $smtp;
+               undef $auth;
+               sleep($relogin_delay) if defined $relogin_delay;
+       }
 }
 
 # Execute a command (e.g. $to_cmd) to get a list of email addresses
@@ -1665,18 +1708,18 @@ sub recipients_cmd {
 
        my @addresses = ();
        open my $fh, "-|", "$cmd \Q$file\E"
-           or die "($prefix) Could not execute '$cmd'";
+           or die sprintf(__("(%s) Could not execute '%s'"), $prefix, $cmd);
        while (my $address = <$fh>) {
                $address =~ s/^\s*//g;
                $address =~ s/\s*$//g;
                $address = sanitize_address($address);
                next if ($address eq $sender and $suppress_cc{'self'});
                push @addresses, $address;
-               printf("($prefix) Adding %s: %s from: '%s'\n",
-                      $what, $address, $cmd) unless $quiet;
+               printf(__("(%s) Adding %s: %s from: '%s'\n"),
+                      $prefix, $what, $address, $cmd) unless $quiet;
                }
        close $fh
-           or die "($prefix) failed to close pipe to '$cmd'";
+           or die sprintf(__("(%s) failed to close pipe to '%s'"), $prefix, $cmd);
        return @addresses;
 }
 
@@ -1729,11 +1772,30 @@ sub unique_email_list {
 
 sub validate_patch {
        my $fn = shift;
+
+       if ($repo) {
+               my $validate_hook = catfile(catdir($repo->repo_path(), 'hooks'),
+                                           'sendemail-validate');
+               my $hook_error;
+               if (-x $validate_hook) {
+                       my $target = abs_path($fn);
+                       # The hook needs a correct cwd and GIT_DIR.
+                       my $cwd_save = cwd();
+                       chdir($repo->wc_path() or $repo->repo_path())
+                               or die("chdir: $!");
+                       local $ENV{"GIT_DIR"} = $repo->repo_path();
+                       $hook_error = "rejected by sendemail-validate hook"
+                               if system($validate_hook, $target);
+                       chdir($cwd_save) or die("chdir: $!");
+               }
+               return $hook_error if $hook_error;
+       }
+
        open(my $fh, '<', $fn)
-               or die "unable to open $fn: $!\n";
+               or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
        while (my $line = <$fh>) {
                if (length($line) > 998) {
-                       return "$.: patch contains a line longer than 998 characters";
+                       return sprintf(__("%s: patch contains a line longer than 998 characters"), $.);
                }
        }
        return;
@@ -1749,10 +1811,11 @@ sub handle_backup {
            (substr($file, 0, $lastlen) eq $last) &&
            ($suffix = substr($file, $lastlen)) !~ /^[a-z0-9]/i) {
                if (defined $known_suffix && $suffix eq $known_suffix) {
-                       print "Skipping $file with backup suffix '$known_suffix'.\n";
+                       printf(__("Skipping %s with backup suffix '%s'.\n"), $file, $known_suffix);
                        $skip = 1;
                } else {
-                       my $answer = ask("Do you really want to send $file? (y|N): ",
+                       # TRANSLATORS: please keep "[y|N]" as is.
+                       my $answer = ask(sprintf(__("Do you really want to send %s? [y|N]: "), $file),
                                         valid_re => qr/^(?:y|n)/i,
                                         default => 'n');
                        $skip = ($answer ne 'y');
@@ -1780,7 +1843,7 @@ sub handle_backup_files {
 sub file_has_nonascii {
        my $fn = shift;
        open(my $fh, '<', $fn)
-               or die "unable to open $fn: $!\n";
+               or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
        while (my $line = <$fh>) {
                return 1 if $line =~ /[^[:ascii:]]/;
        }
@@ -1790,7 +1853,7 @@ sub file_has_nonascii {
 sub body_or_subject_has_nonascii {
        my $fn = shift;
        open(my $fh, '<', $fn)
-               or die "unable to open $fn: $!\n";
+               or die sprintf(__("unable to open %s: %s\n"), $fn, $!);
        while (my $line = <$fh>) {
                last if $line =~ /^$/;
                return 1 if $line =~ /^Subject.*[^[:ascii:]]/;