Adding upstream version 1:2.47.2.
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
This commit is contained in:
parent
fd5a0bafa2
commit
54102a2c29
4535 changed files with 1510258 additions and 0 deletions
184
perl/Git/SVN/Prompt.pm
Normal file
184
perl/Git/SVN/Prompt.pm
Normal file
|
@ -0,0 +1,184 @@
|
|||
package Git::SVN::Prompt;
|
||||
use strict;
|
||||
use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
|
||||
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:
|
||||
my $options = $may_save ?
|
||||
"(R)eject, accept (t)emporarily or accept (p)ermanently? " :
|
||||
"(R)eject or accept (t)emporarily? ";
|
||||
STDERR->flush;
|
||||
$choice = lc(substr(Git::prompt("Certificate problem.\n" . $options) || 'R', 0, 1));
|
||||
if ($choice eq 't') {
|
||||
$cred->may_save(undef);
|
||||
} elsif ($choice eq 'r') {
|
||||
return -1;
|
||||
} elsif ($may_save && $choice eq 'p') {
|
||||
$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 {
|
||||
$username = Git::prompt("Username: ");
|
||||
}
|
||||
$cred->username($username);
|
||||
$cred->may_save($may_save);
|
||||
$SVN::_Core::SVN_NO_ERROR;
|
||||
}
|
||||
|
||||
sub _read_password {
|
||||
my ($prompt, $realm) = @_;
|
||||
my $password = Git::prompt($prompt, 1);
|
||||
$password;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
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…
Add table
Add a link
Reference in a new issue