-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
git-svn: move Git::SVN::Prompt into its own file
git-svn.perl is very long (around 6500 lines) and although it is nicely split into modules, some new readers do not even notice --- it is too distracting to see all this functionality collected in a single file. Splitting it into multiple files would make it easier for people to read individual modules straight through and to experiment with components separately. Let's start with Git::SVN::Prompt. For simplicity, we install this as a module in the standard search path, just like the existing Git and Git::I18N modules. In the process, add a manpage explaining its interface and that it is not likely to be useful for other projects to avoid confusion. Signed-off-by: Jonathan Nieder <jrnieder@gmail.com> Signed-off-by: Eric Wong <normalperson@yhbt.net>
- Loading branch information
Jonathan Nieder
authored and
Eric Wong
committed
May 29, 2012
1 parent
befc5ed
commit c102f4c
Showing
3 changed files
with
204 additions
and
144 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,202 @@ | ||
| package Git::SVN::Prompt; | ||
| use strict; | ||
| use warnings; | ||
| 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: | ||
| print STDERR $may_save ? | ||
| "(R)eject, accept (t)emporarily or accept (p)ermanently? " : | ||
| "(R)eject or accept (t)emporarily? "; | ||
| STDERR->flush; | ||
| $choice = lc(substr(<STDIN> || 'R', 0, 1)); | ||
| if ($choice =~ /^t$/i) { | ||
| $cred->may_save(undef); | ||
| } elsif ($choice =~ /^r$/i) { | ||
| return -1; | ||
| } elsif ($may_save && $choice =~ /^p$/i) { | ||
| $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 { | ||
| print STDERR "Username: "; | ||
| STDERR->flush; | ||
| chomp($username = <STDIN>); | ||
| } | ||
| $cred->username($username); | ||
| $cred->may_save($may_save); | ||
| $SVN::_Core::SVN_NO_ERROR; | ||
| } | ||
|
|
||
| sub _read_password { | ||
| my ($prompt, $realm) = @_; | ||
| my $password = ''; | ||
| if (exists $ENV{GIT_ASKPASS}) { | ||
| open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt); | ||
| $password = <PH>; | ||
| $password =~ s/[\012\015]//; # \n\r | ||
| close(PH); | ||
| } else { | ||
| print STDERR $prompt; | ||
| STDERR->flush; | ||
| require Term::ReadKey; | ||
| Term::ReadKey::ReadMode('noecho'); | ||
| while (defined(my $key = Term::ReadKey::ReadKey(0))) { | ||
| last if $key =~ /[\012\015]/; # \n\r | ||
| $password .= $key; | ||
| } | ||
| Term::ReadKey::ReadMode('restore'); | ||
| print STDERR "\n"; | ||
| STDERR->flush; | ||
| } | ||
| $password; | ||
| } | ||
|
|
||
| 1; | ||
| __END__ | ||
| 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. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters