home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / KeyboardInt.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-03  |  3.3 KB  |  119 lines
  1. # $Id: KeyboardInt.pm,v 1.6 2003/12/03 15:35:21 autarch Exp $
  2.  
  3. package Net::SSH::Perl::Auth::KeyboardInt;
  4.  
  5. use strict;
  6.  
  7. use Net::SSH::Perl::Util qw( _prompt );
  8. use Net::SSH::Perl::Constants qw(
  9.     SSH2_MSG_USERAUTH_REQUEST
  10.     SSH2_MSG_USERAUTH_FAILURE
  11.     SSH2_MSG_USERAUTH_INFO_REQUEST
  12.     SSH2_MSG_USERAUTH_INFO_RESPONSE );
  13.  
  14. use Carp qw( croak );
  15.  
  16. use Net::SSH::Perl::Auth;
  17. use base qw( Net::SSH::Perl::Auth );
  18.  
  19. use Scalar::Util qw(weaken);
  20.  
  21. sub new {
  22.     my $class = shift;
  23.     my $ssh = shift;
  24.     my $auth = bless { ssh => $ssh }, $class;
  25.     weaken $auth->{ssh};
  26.     $auth->enabled( $ssh->config->get('auth_kbd_interactive') &&
  27.                     $ssh->config->get('interactive') );
  28.     $auth;
  29. }
  30.  
  31. sub enabled {
  32.     my $auth = shift;
  33.     $auth->{enabled} = shift if @_;
  34.     $auth->{enabled};
  35. }
  36.  
  37. sub authenticate {
  38.     my $auth = shift;
  39.     my $ssh = $auth->{ssh};
  40.     my($packet);
  41.  
  42.     $packet = $ssh->packet_start(SSH2_MSG_USERAUTH_REQUEST);
  43.     $packet->put_str($ssh->config->get('user'));
  44.     $packet->put_str("ssh-connection");
  45.     $packet->put_str("keyboard-interactive");
  46.     $packet->put_str("");   ## language
  47.     $packet->put_str("");   ## devices
  48.     $packet->send;
  49.  
  50.     $auth->mgr->register_handler(SSH2_MSG_USERAUTH_INFO_REQUEST, sub {
  51.         my $amgr = shift;
  52.         my($packet) = @_;
  53.         my $name = $packet->get_str;
  54.         my $instructions = $packet->get_str;
  55.         $packet->get_str;    ## language
  56.  
  57.         print $name, "\n" if $name;
  58.         print $instructions, "\n" if $instructions;
  59.  
  60.         my $prompts = $packet->get_int32;
  61.         my $pres = $ssh->packet_start(SSH2_MSG_USERAUTH_INFO_RESPONSE);
  62.         $pres->put_int32($prompts);
  63.         for (1..$prompts) {
  64.             my $res = _prompt($packet->get_str, undef, $packet->get_int8);
  65.             $pres->put_str($res);
  66.         }
  67.         $pres->send;
  68.     });
  69.  
  70.     return 1;
  71. }
  72.  
  73. 1;
  74. __END__
  75.  
  76. =head1 NAME
  77.  
  78. Net::SSH::Perl::Auth::KeyboardInt - Keyboard-interactive auth plugin
  79.  
  80. =head1 SYNOPSIS
  81.  
  82.     use Net::SSH::Perl::Auth;
  83.     my $auth = Net::SSH::Perl::Auth->new('KeyboardInt', $ssh);
  84.     $auth->authenticate;
  85.  
  86. =head1 DESCRIPTION
  87.  
  88. I<Net::SSH::Perl::Auth::KeyboardInt> performs keyboard-interactive
  89. authentication with a remote sshd server. This plugin is only
  90. usable when using the SSH2 protocol, and you generally never
  91. need to use it manually; the client and server will perform
  92. authentication negotiation in order to log in the user, a step
  93. which happens automatically.
  94.  
  95. When you create a new authentication object, you give it a
  96. I<Net::SSH::Perl::SSH2> object I<$ssh>, which should contain an
  97. open connection to an ssh daemon, as well as the data that the
  98. authentication module needs to proceed.
  99.  
  100. The I<authenticate> method will enter into a dialog with the
  101. server. For keyboard-interactive authentication, this entails
  102. sending a request to authenticate the user using this form
  103. of authentication, then waiting for any number of prompts for
  104. authentication. These prompts are then presented to the user,
  105. who enters his/her responses; the responses are then sent
  106. back to the server, which either allows or denies the user's
  107. credentials.
  108.  
  109. The fact that this authentication method requires responses to
  110. interactive prompts requires that you only use this method
  111. in an interactive SSH connection.
  112.  
  113. =head1 AUTHOR & COPYRIGHTS
  114.  
  115. Please see the Net::SSH::Perl manpage for author, copyright,
  116. and license information.
  117.  
  118. =cut
  119.