git-svn: move Git::SVN::Prompt into its own file
git-svn.perl is very long (around 6500 lines) and although it is nicely split into modules, some new readers do not even notice --- it is too distracting to see all this functionality collected in a single file. Splitting it into multiple files would make it easier for people to read individual modules straight through and to experiment with components separately. Let's start with Git::SVN::Prompt. For simplicity, we install this as a module in the standard search path, just like the existing Git and Git::I18N modules. In the process, add a manpage explaining its interface and that it is not likely to be useful for other projects to avoid confusion. Signed-off-by: Jonathan Nieder <jrnieder@gmail.com> Signed-off-by: Eric Wong <normalperson@yhbt.net>
This commit is contained in:
Jonathan Nieder
Eric Wong
parent
befc5ed379
commit
c102f4cf72
145
git-svn.perl
145
git-svn.perl
@ -80,6 +80,7 @@ use File::Find;
|
|||||||
use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
|
use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
|
||||||
use IPC::Open3;
|
use IPC::Open3;
|
||||||
use Git;
|
use Git;
|
||||||
|
use Git::SVN::Prompt qw//;
|
||||||
use Memoize; # core since 5.8.0, Jul 2002
|
use Memoize; # core since 5.8.0, Jul 2002
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
@ -4327,150 +4328,6 @@ sub remove_username {
|
|||||||
$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
|
$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
|
||||||
}
|
}
|
||||||
|
|
||||||
package Git::SVN::Prompt;
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
require SVN::Core;
|
|
||||||
use vars qw/$_no_auth_cache $_username/;
|
|
||||||
|
|
||||||
sub simple {
|
|
||||||
my ($cred, $realm, $default_username, $may_save, $pool) = @_;
|
|
||||||
$may_save = undef if $_no_auth_cache;
|
|
||||||
$default_username = $_username if defined $_username;
|
|
||||||
if (defined $default_username && length $default_username) {
|
|
||||||
if (defined $realm && length $realm) {
|
|
||||||
print STDERR "Authentication realm: $realm\n";
|
|
||||||
STDERR->flush;
|
|
||||||
}
|
|
||||||
$cred->username($default_username);
|
|
||||||
} else {
|
|
||||||
username($cred, $realm, $may_save, $pool);
|
|
||||||
}
|
|
||||||
$cred->password(_read_password("Password for '" .
|
|
||||||
$cred->username . "': ", $realm));
|
|
||||||
$cred->may_save($may_save);
|
|
||||||
$SVN::_Core::SVN_NO_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ssl_server_trust {
|
|
||||||
my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
|
|
||||||
$may_save = undef if $_no_auth_cache;
|
|
||||||
print STDERR "Error validating server certificate for '$realm':\n";
|
|
||||||
{
|
|
||||||
no warnings 'once';
|
|
||||||
# All variables SVN::Auth::SSL::* are used only once,
|
|
||||||
# so we're shutting up Perl warnings about this.
|
|
||||||
if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
|
|
||||||
print STDERR " - The certificate is not issued ",
|
|
||||||
"by a trusted authority. Use the\n",
|
|
||||||
" fingerprint to validate ",
|
|
||||||
"the certificate manually!\n";
|
|
||||||
}
|
|
||||||
if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
|
|
||||||
print STDERR " - The certificate hostname ",
|
|
||||||
"does not match.\n";
|
|
||||||
}
|
|
||||||
if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
|
|
||||||
print STDERR " - The certificate is not yet valid.\n";
|
|
||||||
}
|
|
||||||
if ($failures & $SVN::Auth::SSL::EXPIRED) {
|
|
||||||
print STDERR " - The certificate has expired.\n";
|
|
||||||
}
|
|
||||||
if ($failures & $SVN::Auth::SSL::OTHER) {
|
|
||||||
print STDERR " - The certificate has ",
|
|
||||||
"an unknown error.\n";
|
|
||||||
}
|
|
||||||
} # no warnings 'once'
|
|
||||||
printf STDERR
|
|
||||||
"Certificate information:\n".
|
|
||||||
" - Hostname: %s\n".
|
|
||||||
" - Valid: from %s until %s\n".
|
|
||||||
" - Issuer: %s\n".
|
|
||||||
" - Fingerprint: %s\n",
|
|
||||||
map $cert_info->$_, qw(hostname valid_from valid_until
|
|
||||||
issuer_dname fingerprint);
|
|
||||||
my $choice;
|
|
||||||
prompt:
|
|
||||||
print STDERR $may_save ?
|
|
||||||
"(R)eject, accept (t)emporarily or accept (p)ermanently? " :
|
|
||||||
"(R)eject or accept (t)emporarily? ";
|
|
||||||
STDERR->flush;
|
|
||||||
$choice = lc(substr(<STDIN> || 'R', 0, 1));
|
|
||||||
if ($choice =~ /^t$/i) {
|
|
||||||
$cred->may_save(undef);
|
|
||||||
} elsif ($choice =~ /^r$/i) {
|
|
||||||
return -1;
|
|
||||||
} elsif ($may_save && $choice =~ /^p$/i) {
|
|
||||||
$cred->may_save($may_save);
|
|
||||||
} else {
|
|
||||||
goto prompt;
|
|
||||||
}
|
|
||||||
$cred->accepted_failures($failures);
|
|
||||||
$SVN::_Core::SVN_NO_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ssl_client_cert {
|
|
||||||
my ($cred, $realm, $may_save, $pool) = @_;
|
|
||||||
$may_save = undef if $_no_auth_cache;
|
|
||||||
print STDERR "Client certificate filename: ";
|
|
||||||
STDERR->flush;
|
|
||||||
chomp(my $filename = <STDIN>);
|
|
||||||
$cred->cert_file($filename);
|
|
||||||
$cred->may_save($may_save);
|
|
||||||
$SVN::_Core::SVN_NO_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ssl_client_cert_pw {
|
|
||||||
my ($cred, $realm, $may_save, $pool) = @_;
|
|
||||||
$may_save = undef if $_no_auth_cache;
|
|
||||||
$cred->password(_read_password("Password: ", $realm));
|
|
||||||
$cred->may_save($may_save);
|
|
||||||
$SVN::_Core::SVN_NO_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub username {
|
|
||||||
my ($cred, $realm, $may_save, $pool) = @_;
|
|
||||||
$may_save = undef if $_no_auth_cache;
|
|
||||||
if (defined $realm && length $realm) {
|
|
||||||
print STDERR "Authentication realm: $realm\n";
|
|
||||||
}
|
|
||||||
my $username;
|
|
||||||
if (defined $_username) {
|
|
||||||
$username = $_username;
|
|
||||||
} else {
|
|
||||||
print STDERR "Username: ";
|
|
||||||
STDERR->flush;
|
|
||||||
chomp($username = <STDIN>);
|
|
||||||
}
|
|
||||||
$cred->username($username);
|
|
||||||
$cred->may_save($may_save);
|
|
||||||
$SVN::_Core::SVN_NO_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub _read_password {
|
|
||||||
my ($prompt, $realm) = @_;
|
|
||||||
my $password = '';
|
|
||||||
if (exists $ENV{GIT_ASKPASS}) {
|
|
||||||
open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
|
|
||||||
$password = <PH>;
|
|
||||||
$password =~ s/[\012\015]//; # \n\r
|
|
||||||
close(PH);
|
|
||||||
} else {
|
|
||||||
print STDERR $prompt;
|
|
||||||
STDERR->flush;
|
|
||||||
require Term::ReadKey;
|
|
||||||
Term::ReadKey::ReadMode('noecho');
|
|
||||||
while (defined(my $key = Term::ReadKey::ReadKey(0))) {
|
|
||||||
last if $key =~ /[\012\015]/; # \n\r
|
|
||||||
$password .= $key;
|
|
||||||
}
|
|
||||||
Term::ReadKey::ReadMode('restore');
|
|
||||||
print STDERR "\n";
|
|
||||||
STDERR->flush;
|
|
||||||
}
|
|
||||||
$password;
|
|
||||||
}
|
|
||||||
|
|
||||||
package SVN::Git::Fetcher;
|
package SVN::Git::Fetcher;
|
||||||
use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename
|
use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename
|
||||||
@deleted_gpath %added_placeholder $repo_id/;
|
@deleted_gpath %added_placeholder $repo_id/;
|
||||||
|
|||||||
202
perl/Git/SVN/Prompt.pm
Normal file
202
perl/Git/SVN/Prompt.pm
Normal file
@ -0,0 +1,202 @@
|
|||||||
|
package Git::SVN::Prompt;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
require SVN::Core;
|
||||||
|
use vars qw/$_no_auth_cache $_username/;
|
||||||
|
|
||||||
|
sub simple {
|
||||||
|
my ($cred, $realm, $default_username, $may_save, $pool) = @_;
|
||||||
|
$may_save = undef if $_no_auth_cache;
|
||||||
|
$default_username = $_username if defined $_username;
|
||||||
|
if (defined $default_username && length $default_username) {
|
||||||
|
if (defined $realm && length $realm) {
|
||||||
|
print STDERR "Authentication realm: $realm\n";
|
||||||
|
STDERR->flush;
|
||||||
|
}
|
||||||
|
$cred->username($default_username);
|
||||||
|
} else {
|
||||||
|
username($cred, $realm, $may_save, $pool);
|
||||||
|
}
|
||||||
|
$cred->password(_read_password("Password for '" .
|
||||||
|
$cred->username . "': ", $realm));
|
||||||
|
$cred->may_save($may_save);
|
||||||
|
$SVN::_Core::SVN_NO_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub ssl_server_trust {
|
||||||
|
my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
|
||||||
|
$may_save = undef if $_no_auth_cache;
|
||||||
|
print STDERR "Error validating server certificate for '$realm':\n";
|
||||||
|
{
|
||||||
|
no warnings 'once';
|
||||||
|
# All variables SVN::Auth::SSL::* are used only once,
|
||||||
|
# so we're shutting up Perl warnings about this.
|
||||||
|
if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
|
||||||
|
print STDERR " - The certificate is not issued ",
|
||||||
|
"by a trusted authority. Use the\n",
|
||||||
|
" fingerprint to validate ",
|
||||||
|
"the certificate manually!\n";
|
||||||
|
}
|
||||||
|
if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
|
||||||
|
print STDERR " - The certificate hostname ",
|
||||||
|
"does not match.\n";
|
||||||
|
}
|
||||||
|
if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
|
||||||
|
print STDERR " - The certificate is not yet valid.\n";
|
||||||
|
}
|
||||||
|
if ($failures & $SVN::Auth::SSL::EXPIRED) {
|
||||||
|
print STDERR " - The certificate has expired.\n";
|
||||||
|
}
|
||||||
|
if ($failures & $SVN::Auth::SSL::OTHER) {
|
||||||
|
print STDERR " - The certificate has ",
|
||||||
|
"an unknown error.\n";
|
||||||
|
}
|
||||||
|
} # no warnings 'once'
|
||||||
|
printf STDERR
|
||||||
|
"Certificate information:\n".
|
||||||
|
" - Hostname: %s\n".
|
||||||
|
" - Valid: from %s until %s\n".
|
||||||
|
" - Issuer: %s\n".
|
||||||
|
" - Fingerprint: %s\n",
|
||||||
|
map $cert_info->$_, qw(hostname valid_from valid_until
|
||||||
|
issuer_dname fingerprint);
|
||||||
|
my $choice;
|
||||||
|
prompt:
|
||||||
|
print STDERR $may_save ?
|
||||||
|
"(R)eject, accept (t)emporarily or accept (p)ermanently? " :
|
||||||
|
"(R)eject or accept (t)emporarily? ";
|
||||||
|
STDERR->flush;
|
||||||
|
$choice = lc(substr(<STDIN> || 'R', 0, 1));
|
||||||
|
if ($choice =~ /^t$/i) {
|
||||||
|
$cred->may_save(undef);
|
||||||
|
} elsif ($choice =~ /^r$/i) {
|
||||||
|
return -1;
|
||||||
|
} elsif ($may_save && $choice =~ /^p$/i) {
|
||||||
|
$cred->may_save($may_save);
|
||||||
|
} else {
|
||||||
|
goto prompt;
|
||||||
|
}
|
||||||
|
$cred->accepted_failures($failures);
|
||||||
|
$SVN::_Core::SVN_NO_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub ssl_client_cert {
|
||||||
|
my ($cred, $realm, $may_save, $pool) = @_;
|
||||||
|
$may_save = undef if $_no_auth_cache;
|
||||||
|
print STDERR "Client certificate filename: ";
|
||||||
|
STDERR->flush;
|
||||||
|
chomp(my $filename = <STDIN>);
|
||||||
|
$cred->cert_file($filename);
|
||||||
|
$cred->may_save($may_save);
|
||||||
|
$SVN::_Core::SVN_NO_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub ssl_client_cert_pw {
|
||||||
|
my ($cred, $realm, $may_save, $pool) = @_;
|
||||||
|
$may_save = undef if $_no_auth_cache;
|
||||||
|
$cred->password(_read_password("Password: ", $realm));
|
||||||
|
$cred->may_save($may_save);
|
||||||
|
$SVN::_Core::SVN_NO_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub username {
|
||||||
|
my ($cred, $realm, $may_save, $pool) = @_;
|
||||||
|
$may_save = undef if $_no_auth_cache;
|
||||||
|
if (defined $realm && length $realm) {
|
||||||
|
print STDERR "Authentication realm: $realm\n";
|
||||||
|
}
|
||||||
|
my $username;
|
||||||
|
if (defined $_username) {
|
||||||
|
$username = $_username;
|
||||||
|
} else {
|
||||||
|
print STDERR "Username: ";
|
||||||
|
STDERR->flush;
|
||||||
|
chomp($username = <STDIN>);
|
||||||
|
}
|
||||||
|
$cred->username($username);
|
||||||
|
$cred->may_save($may_save);
|
||||||
|
$SVN::_Core::SVN_NO_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _read_password {
|
||||||
|
my ($prompt, $realm) = @_;
|
||||||
|
my $password = '';
|
||||||
|
if (exists $ENV{GIT_ASKPASS}) {
|
||||||
|
open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
|
||||||
|
$password = <PH>;
|
||||||
|
$password =~ s/[\012\015]//; # \n\r
|
||||||
|
close(PH);
|
||||||
|
} else {
|
||||||
|
print STDERR $prompt;
|
||||||
|
STDERR->flush;
|
||||||
|
require Term::ReadKey;
|
||||||
|
Term::ReadKey::ReadMode('noecho');
|
||||||
|
while (defined(my $key = Term::ReadKey::ReadKey(0))) {
|
||||||
|
last if $key =~ /[\012\015]/; # \n\r
|
||||||
|
$password .= $key;
|
||||||
|
}
|
||||||
|
Term::ReadKey::ReadMode('restore');
|
||||||
|
print STDERR "\n";
|
||||||
|
STDERR->flush;
|
||||||
|
}
|
||||||
|
$password;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
__END__
|
||||||
|
|
||||||
|
Git::SVN::Prompt - authentication callbacks for git-svn
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
use Git::SVN::Prompt qw(simple ssl_client_cert ssl_client_cert_pw
|
||||||
|
ssl_server_trust username);
|
||||||
|
use SVN::Client ();
|
||||||
|
|
||||||
|
my $cached_simple = SVN::Client::get_simple_provider();
|
||||||
|
my $git_simple = SVN::Client::get_simple_prompt_provider(\&simple, 2);
|
||||||
|
my $cached_ssl = SVN::Client::get_ssl_server_trust_file_provider();
|
||||||
|
my $git_ssl = SVN::Client::get_ssl_server_trust_prompt_provider(
|
||||||
|
\&ssl_server_trust);
|
||||||
|
my $cached_cert = SVN::Client::get_ssl_client_cert_file_provider();
|
||||||
|
my $git_cert = SVN::Client::get_ssl_client_cert_prompt_provider(
|
||||||
|
\&ssl_client_cert, 2);
|
||||||
|
my $cached_cert_pw = SVN::Client::get_ssl_client_cert_pw_file_provider();
|
||||||
|
my $git_cert_pw = SVN::Client::get_ssl_client_cert_pw_prompt_provider(
|
||||||
|
\&ssl_client_cert_pw, 2);
|
||||||
|
my $cached_username = SVN::Client::get_username_provider();
|
||||||
|
my $git_username = SVN::Client::get_username_prompt_provider(
|
||||||
|
\&username, 2);
|
||||||
|
|
||||||
|
my $ctx = new SVN::Client(
|
||||||
|
auth => [
|
||||||
|
$cached_simple, $git_simple,
|
||||||
|
$cached_ssl, $git_ssl,
|
||||||
|
$cached_cert, $git_cert,
|
||||||
|
$cached_cert_pw, $git_cert_pw,
|
||||||
|
$cached_username, $git_username
|
||||||
|
]);
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This module is an implementation detail of the "git svn" command.
|
||||||
|
It implements git-svn's authentication policy. Do not use it unless
|
||||||
|
you are developing git-svn.
|
||||||
|
|
||||||
|
The interface will change as git-svn evolves.
|
||||||
|
|
||||||
|
=head1 DEPENDENCIES
|
||||||
|
|
||||||
|
L<SVN::Core>.
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
L<SVN::Client>.
|
||||||
|
|
||||||
|
=head1 INCOMPATIBILITIES
|
||||||
|
|
||||||
|
None reported.
|
||||||
|
|
||||||
|
=head1 BUGS
|
||||||
|
|
||||||
|
None.
|
||||||
@ -27,6 +27,7 @@ MAKE_FRAG
|
|||||||
my %pm = (
|
my %pm = (
|
||||||
'Git.pm' => '$(INST_LIBDIR)/Git.pm',
|
'Git.pm' => '$(INST_LIBDIR)/Git.pm',
|
||||||
'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm',
|
'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm',
|
||||||
|
'Git/SVN/Prompt.pm' => '$(INST_LIBDIR)/Git/SVN/Prompt.pm',
|
||||||
);
|
);
|
||||||
|
|
||||||
# We come with our own bundled Error.pm. It's not in the set of default
|
# We come with our own bundled Error.pm. It's not in the set of default
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user