1package Git::SVN::Prompt;
2use strict;
3use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : ();
4require SVN::Core;
5use vars qw/$_no_auth_cache $_username/;
6
7sub simple {
8	my ($cred, $realm, $default_username, $may_save, $pool) = @_;
9	$may_save = undef if $_no_auth_cache;
10	$default_username = $_username if defined $_username;
11	if (defined $default_username && length $default_username) {
12		if (defined $realm && length $realm) {
13			print STDERR "Authentication realm: $realm\n";
14			STDERR->flush;
15		}
16		$cred->username($default_username);
17	} else {
18		username($cred, $realm, $may_save, $pool);
19	}
20	$cred->password(_read_password("Password for '" .
21	                               $cred->username . "': ", $realm));
22	$cred->may_save($may_save);
23	$SVN::_Core::SVN_NO_ERROR;
24}
25
26sub ssl_server_trust {
27	my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
28	$may_save = undef if $_no_auth_cache;
29	print STDERR "Error validating server certificate for '$realm':\n";
30	{
31		no warnings 'once';
32		# All variables SVN::Auth::SSL::* are used only once,
33		# so we're shutting up Perl warnings about this.
34		if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
35			print STDERR " - The certificate is not issued ",
36			    "by a trusted authority. Use the\n",
37			    "   fingerprint to validate ",
38			    "the certificate manually!\n";
39		}
40		if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
41			print STDERR " - The certificate hostname ",
42			    "does not match.\n";
43		}
44		if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
45			print STDERR " - The certificate is not yet valid.\n";
46		}
47		if ($failures & $SVN::Auth::SSL::EXPIRED) {
48			print STDERR " - The certificate has expired.\n";
49		}
50		if ($failures & $SVN::Auth::SSL::OTHER) {
51			print STDERR " - The certificate has ",
52			    "an unknown error.\n";
53		}
54	} # no warnings 'once'
55	printf STDERR
56	        "Certificate information:\n".
57	        " - Hostname: %s\n".
58	        " - Valid: from %s until %s\n".
59	        " - Issuer: %s\n".
60	        " - Fingerprint: %s\n",
61	        map $cert_info->$_, qw(hostname valid_from valid_until
62	                               issuer_dname fingerprint);
63	my $choice;
64prompt:
65	my $options = $may_save ?
66	      "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
67	      "(R)eject or accept (t)emporarily? ";
68	STDERR->flush;
69	$choice = lc(substr(Git::prompt("Certificate problem.\n" . $options) || 'R', 0, 1));
70	if ($choice eq 't') {
71		$cred->may_save(undef);
72	} elsif ($choice eq 'r') {
73		return -1;
74	} elsif ($may_save && $choice eq 'p') {
75		$cred->may_save($may_save);
76	} else {
77		goto prompt;
78	}
79	$cred->accepted_failures($failures);
80	$SVN::_Core::SVN_NO_ERROR;
81}
82
83sub ssl_client_cert {
84	my ($cred, $realm, $may_save, $pool) = @_;
85	$may_save = undef if $_no_auth_cache;
86	print STDERR "Client certificate filename: ";
87	STDERR->flush;
88	chomp(my $filename = <STDIN>);
89	$cred->cert_file($filename);
90	$cred->may_save($may_save);
91	$SVN::_Core::SVN_NO_ERROR;
92}
93
94sub ssl_client_cert_pw {
95	my ($cred, $realm, $may_save, $pool) = @_;
96	$may_save = undef if $_no_auth_cache;
97	$cred->password(_read_password("Password: ", $realm));
98	$cred->may_save($may_save);
99	$SVN::_Core::SVN_NO_ERROR;
100}
101
102sub username {
103	my ($cred, $realm, $may_save, $pool) = @_;
104	$may_save = undef if $_no_auth_cache;
105	if (defined $realm && length $realm) {
106		print STDERR "Authentication realm: $realm\n";
107	}
108	my $username;
109	if (defined $_username) {
110		$username = $_username;
111	} else {
112		$username = Git::prompt("Username: ");
113	}
114	$cred->username($username);
115	$cred->may_save($may_save);
116	$SVN::_Core::SVN_NO_ERROR;
117}
118
119sub _read_password {
120	my ($prompt, $realm) = @_;
121	my $password = Git::prompt($prompt, 1);
122	$password;
123}
124
1251;
126__END__
127
128=head1 NAME
129
130Git::SVN::Prompt - authentication callbacks for git-svn
131
132=head1 SYNOPSIS
133
134    use Git::SVN::Prompt qw(simple ssl_client_cert ssl_client_cert_pw
135                            ssl_server_trust username);
136    use SVN::Client ();
137
138    my $cached_simple = SVN::Client::get_simple_provider();
139    my $git_simple = SVN::Client::get_simple_prompt_provider(\&simple, 2);
140    my $cached_ssl = SVN::Client::get_ssl_server_trust_file_provider();
141    my $git_ssl = SVN::Client::get_ssl_server_trust_prompt_provider(
142        \&ssl_server_trust);
143    my $cached_cert = SVN::Client::get_ssl_client_cert_file_provider();
144    my $git_cert = SVN::Client::get_ssl_client_cert_prompt_provider(
145        \&ssl_client_cert, 2);
146    my $cached_cert_pw = SVN::Client::get_ssl_client_cert_pw_file_provider();
147    my $git_cert_pw = SVN::Client::get_ssl_client_cert_pw_prompt_provider(
148        \&ssl_client_cert_pw, 2);
149    my $cached_username = SVN::Client::get_username_provider();
150    my $git_username = SVN::Client::get_username_prompt_provider(
151        \&username, 2);
152
153    my $ctx = new SVN::Client(
154        auth => [
155            $cached_simple, $git_simple,
156            $cached_ssl, $git_ssl,
157            $cached_cert, $git_cert,
158            $cached_cert_pw, $git_cert_pw,
159            $cached_username, $git_username
160        ]);
161
162=head1 DESCRIPTION
163
164This module is an implementation detail of the "git svn" command.
165It implements git-svn's authentication policy.  Do not use it unless
166you are developing git-svn.
167
168The interface will change as git-svn evolves.
169
170=head1 DEPENDENCIES
171
172L<SVN::Core>.
173
174=head1 SEE ALSO
175
176L<SVN::Client>.
177
178=head1 INCOMPATIBILITIES
179
180None reported.
181
182=head1 BUGS
183
184None.
185