diff options
| -rwxr-xr-x | git-svn.perl | 145 | ||||
| -rw-r--r-- | perl/Git/SVN/Prompt.pm | 202 | ||||
| -rw-r--r-- | perl/Makefile.PL | 1 |
3 files changed, 204 insertions, 144 deletions
diff --git a/git-svn.perl b/git-svn.perl index c84842ff0..73b1c4b13 100755 --- a/git-svn.perl +++ b/git-svn.perl @@ -80,6 +80,7 @@ use File::Find; use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/; use IPC::Open3; use Git; +use Git::SVN::Prompt qw//; use Memoize; # core since 5.8.0, Jul 2002 BEGIN { @@ -4327,150 +4328,6 @@ sub remove_username { $_[0] =~ s{^([^:]*://)[^@]+@}{$1}; } -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; -} - package SVN::Git::Fetcher; use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename @deleted_gpath %added_placeholder $repo_id/; diff --git a/perl/Git/SVN/Prompt.pm b/perl/Git/SVN/Prompt.pm new file mode 100644 index 000000000..3a6f8af0d --- /dev/null +++ b/perl/Git/SVN/Prompt.pm @@ -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. diff --git a/perl/Makefile.PL b/perl/Makefile.PL index 456d45bf4..4d8e31d25 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -27,6 +27,7 @@ MAKE_FRAG my %pm = ( 'Git.pm' => '$(INST_LIBDIR)/Git.pm', 'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm', + 'Git/SVN/Prompt.pm' => '$(INST_LIBDIR)/Git/SVN/Prompt.pm', ); # We come with our own bundled Error.pm. It's not in the set of default |