1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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.
|
