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 / Password.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-03  |  4.2 KB  |  143 lines
  1. # $Id: Password.pm,v 1.14 2003/12/03 15:35:21 autarch Exp $
  2.  
  3. package Net::SSH::Perl::Auth::Password;
  4.  
  5. use strict;
  6.  
  7. use Net::SSH::Perl::Constants qw(
  8.     SSH_CMSG_AUTH_PASSWORD
  9.     SSH_SMSG_SUCCESS
  10.     SSH_SMSG_FAILURE
  11.     SSH2_MSG_USERAUTH_REQUEST
  12.     PROTOCOL_SSH2 );
  13.  
  14. use Net::SSH::Perl::Packet;
  15. use Net::SSH::Perl::Util qw( _read_passphrase );
  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_password') );
  27.     $auth;
  28. }
  29.  
  30. sub enabled {
  31.     my $auth = shift;
  32.     $auth->{enabled} = shift if @_;
  33.     $auth->{enabled};
  34. }
  35.  
  36. sub authenticate {
  37.     my $auth = shift;
  38.     my $try = shift || 0;
  39.     my($packet);
  40.  
  41.     my $ssh = $auth->{ssh};
  42.     $ssh->debug("Password authentication is disabled by the client."), return
  43.         unless $auth->enabled;
  44.  
  45.     if ($ssh->protocol == PROTOCOL_SSH2 &&
  46.         $try >= $ssh->config->get('number_of_password_prompts')) {
  47.         return;
  48.     }
  49.  
  50.     my $pass = $ssh->config->get('pass');
  51.     $ssh->debug("Trying password authentication.");
  52.     if (!$pass) {
  53.         if ($ssh->config->get('interactive')) {
  54.             my $prompt;
  55.             my($prompt_host, $prompt_login) = map $ssh->config->get($_),
  56.                 qw( password_prompt_host password_prompt_login );
  57.             if ($prompt_host && $prompt_login) {
  58.                 $prompt = sprintf "%s@%s's password: ",
  59.                     $ssh->config->get('user'), $ssh->{host};
  60.             }
  61.             elsif (!$prompt_host && !$prompt_login) {
  62.                 $prompt = "Password: ";
  63.             }
  64.             elsif ($prompt_login) {
  65.                 $prompt = sprintf "%s's password: ", $ssh->config->get('user');
  66.             }
  67.             else {
  68.                 $prompt = sprintf "%s password: ", $ssh->{host};
  69.             }
  70.             $pass = _read_passphrase($prompt);
  71.         }
  72.         else {
  73.             $ssh->debug("Will not query passphrase in batch mode.");
  74.         }
  75.     }
  76.  
  77.     if ($ssh->protocol == PROTOCOL_SSH2) {
  78.         $packet = $ssh->packet_start(SSH2_MSG_USERAUTH_REQUEST);
  79.         $packet->put_str($ssh->config->get('user'));
  80.         $packet->put_str("ssh-connection");
  81.         $packet->put_str("password");
  82.         $packet->put_int8(0);
  83.         $packet->put_str($pass);
  84.         $packet->send;
  85.         return 1;
  86.     }
  87.     else {
  88.         $packet = $ssh->packet_start(SSH_CMSG_AUTH_PASSWORD);
  89.         $packet->put_str($pass);
  90.         $packet->send;
  91.  
  92.         $packet = Net::SSH::Perl::Packet->read($ssh);
  93.         return 1 if $packet->type == SSH_SMSG_SUCCESS;
  94.  
  95.         if ($packet->type != SSH_SMSG_FAILURE) {
  96.             $ssh->fatal_disconnect(sprintf
  97.               "Protocol error: got %d in response to SSH_CMSG_AUTH_PASSWORD", $packet->type);
  98.         }
  99.     }
  100.  
  101.     return 0;
  102. }
  103.  
  104. 1;
  105. __END__
  106.  
  107. =head1 NAME
  108.  
  109. Net::SSH::Perl::Auth::Password - Password authentication plugin
  110.  
  111. =head1 SYNOPSIS
  112.  
  113.     use Net::SSH::Perl::Auth;
  114.     my $auth = Net::SSH::Perl::Auth->new('Password', $ssh);
  115.     print "Valid auth" if $auth->authenticate;
  116.  
  117. =head1 DESCRIPTION
  118.  
  119. I<Net::SSH::Perl::Auth::Password> performs password authentication
  120. with a remote sshd server. When you create a new password auth
  121. object, you give it an I<$ssh> object, which should contain an
  122. open connection to an ssh daemon, as well as the data that the
  123. authentication module needs to proceed.
  124.  
  125. The I<authenticate> method will enter into a dialog with the
  126. server. For password authentication, all that needs to be done
  127. is to send a password (encrypted by the standard SSH encryption
  128. layer) to the server, and wait for its response. If the I<$ssh>
  129. object doesn't already have a password that you've given it,
  130. I<Net::SSH::Perl::Auth::Password> will check to see if you're
  131. in an interactive session (see the docs for I<Net::SSH::Perl>),
  132. and if so will issue a prompt, asking you to enter your password.
  133. If the session is not interactive (if it's in batch mode), we
  134. send a blank password to comply with the protocol, but odds are
  135. the authentication will then fail.
  136.  
  137. =head1 AUTHOR & COPYRIGHTS
  138.  
  139. Please see the Net::SSH::Perl manpage for author, copyright,
  140. and license information.
  141.  
  142. =cut
  143.