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