Merge branch 'sb/submodule-module-list-fix'
[git] / perl / Git / SVN / Prompt.pm
1 package Git::SVN::Prompt;
2 use strict;
3 use warnings;
4 require SVN::Core;
5 use vars qw/$_no_auth_cache $_username/;
6
7 sub 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
26 sub 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;
64 prompt:
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
83 sub 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
94 sub 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
102 sub 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
119 sub _read_password {
120         my ($prompt, $realm) = @_;
121         my $password = Git::prompt($prompt, 1);
122         $password;
123 }
124
125 1;
126 __END__
127
128 =head1 NAME
129
130 Git::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
164 This module is an implementation detail of the "git svn" command.
165 It implements git-svn's authentication policy.  Do not use it unless
166 you are developing git-svn.
167
168 The interface will change as git-svn evolves.
169
170 =head1 DEPENDENCIES
171
172 L<SVN::Core>.
173
174 =head1 SEE ALSO
175
176 L<SVN::Client>.
177
178 =head1 INCOMPATIBILITIES
179
180 None reported.
181
182 =head1 BUGS
183
184 None.