|
| 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 | + print STDERR $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(<STDIN> || 'R', 0, 1)); |
| 70 | + if ($choice =~ /^t$/i) { |
| 71 | + $cred->may_save(undef); |
| 72 | + } elsif ($choice =~ /^r$/i) { |
| 73 | + return -1; |
| 74 | + } elsif ($may_save && $choice =~ /^p$/i) { |
| 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 | + print STDERR "Username: "; |
| 113 | + STDERR->flush; |
| 114 | + chomp($username = <STDIN>); |
| 115 | + } |
| 116 | + $cred->username($username); |
| 117 | + $cred->may_save($may_save); |
| 118 | + $SVN::_Core::SVN_NO_ERROR; |
| 119 | +} |
| 120 | + |
| 121 | +sub _read_password { |
| 122 | + my ($prompt, $realm) = @_; |
| 123 | + my $password = ''; |
| 124 | + if (exists $ENV{GIT_ASKPASS}) { |
| 125 | + open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt); |
| 126 | + |
| 127 | + $password =~ s/[\012\015]//; # \n\r |
| 128 | + close(PH); |
| 129 | + } else { |
| 130 | + print STDERR $prompt; |
| 131 | + STDERR->flush; |
| 132 | + require Term::ReadKey; |
| 133 | + Term::ReadKey::ReadMode('noecho'); |
| 134 | + while (defined(my $key = Term::ReadKey::ReadKey(0))) { |
| 135 | + last if $key =~ /[\012\015]/; # \n\r |
| 136 | + $password .= $key; |
| 137 | + } |
| 138 | + Term::ReadKey::ReadMode('restore'); |
| 139 | + print STDERR "\n"; |
| 140 | + STDERR->flush; |
| 141 | + } |
| 142 | + $password; |
| 143 | +} |
| 144 | + |
| 145 | +1; |
| 146 | +__END__ |
| 147 | +
|
| 148 | +Git::SVN::Prompt - authentication callbacks for git-svn |
| 149 | +
|
| 150 | +=head1 SYNOPSIS |
| 151 | +
|
| 152 | + use Git::SVN::Prompt qw(simple ssl_client_cert ssl_client_cert_pw |
| 153 | + ssl_server_trust username); |
| 154 | + use SVN::Client (); |
| 155 | +
|
| 156 | + my $cached_simple = SVN::Client::get_simple_provider(); |
| 157 | + my $git_simple = SVN::Client::get_simple_prompt_provider(\&simple, 2); |
| 158 | + my $cached_ssl = SVN::Client::get_ssl_server_trust_file_provider(); |
| 159 | + my $git_ssl = SVN::Client::get_ssl_server_trust_prompt_provider( |
| 160 | + \&ssl_server_trust); |
| 161 | + my $cached_cert = SVN::Client::get_ssl_client_cert_file_provider(); |
| 162 | + my $git_cert = SVN::Client::get_ssl_client_cert_prompt_provider( |
| 163 | + \&ssl_client_cert, 2); |
| 164 | + my $cached_cert_pw = SVN::Client::get_ssl_client_cert_pw_file_provider(); |
| 165 | + my $git_cert_pw = SVN::Client::get_ssl_client_cert_pw_prompt_provider( |
| 166 | + \&ssl_client_cert_pw, 2); |
| 167 | + my $cached_username = SVN::Client::get_username_provider(); |
| 168 | + my $git_username = SVN::Client::get_username_prompt_provider( |
| 169 | + \&username, 2); |
| 170 | +
|
| 171 | + my $ctx = new SVN::Client( |
| 172 | + auth => [ |
| 173 | + $cached_simple, $git_simple, |
| 174 | + $cached_ssl, $git_ssl, |
| 175 | + $cached_cert, $git_cert, |
| 176 | + $cached_cert_pw, $git_cert_pw, |
| 177 | + $cached_username, $git_username |
| 178 | + ]); |
| 179 | +
|
| 180 | +=head1 DESCRIPTION |
| 181 | +
|
| 182 | +This module is an implementation detail of the "git svn" command. |
| 183 | +It implements git-svn's authentication policy. Do not use it unless |
| 184 | +you are developing git-svn. |
| 185 | +
|
| 186 | +The interface will change as git-svn evolves. |
| 187 | +
|
| 188 | +=head1 DEPENDENCIES |
| 189 | +
|
| 190 | +L<SVN::Core>. |
| 191 | +
|
| 192 | +=head1 SEE ALSO |
| 193 | +
|
| 194 | +L<SVN::Client>. |
| 195 | +
|
| 196 | +=head1 INCOMPATIBILITIES |
| 197 | +
|
| 198 | +None reported. |
| 199 | +
|
| 200 | +=head1 BUGS |
| 201 | +
|
| 202 | +None. |
0 commit comments