Browse Source
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>maint
Jonathan Nieder
13 years ago
committed by
Eric Wong
3 changed files with 204 additions and 144 deletions
@ -0,0 +1,202 @@
@@ -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. |
||||
Loading…
Reference in new issue