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 / Rhosts.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-03  |  2.7 KB  |  99 lines
  1. # $Id: Rhosts.pm,v 1.10 2003/12/03 15:35:21 autarch Exp $
  2.  
  3. package Net::SSH::Perl::Auth::Rhosts;
  4.  
  5. use strict;
  6.  
  7. use Net::SSH::Perl::Constants qw(
  8.     SSH_SMSG_FAILURE
  9.     SSH_SMSG_SUCCESS
  10.     SSH_CMSG_AUTH_RHOSTS );
  11.  
  12. use Net::SSH::Perl::Packet;
  13. use Net::SSH::Perl::Auth;
  14. use base qw( Net::SSH::Perl::Auth );
  15.  
  16. use Scalar::Util qw(weaken);
  17.  
  18. sub new {
  19.     my $class = shift;
  20.     my $ssh = shift;
  21.     my $auth = bless { ssh => $ssh }, $class;
  22.     weaken $auth->{ssh};
  23.     $auth;
  24. }
  25.  
  26. sub authenticate {
  27.     my $auth = shift;
  28.     my($packet);
  29.     my $ssh = $auth->{ssh};
  30.  
  31.     $ssh->debug("Rhosts authentication is disabled by the client."), return
  32.         unless $ssh->config->get('auth_rhosts');
  33.  
  34.     $ssh->debug("Trying rhosts authentication.");
  35.  
  36.     $packet = $ssh->packet_start(SSH_CMSG_AUTH_RHOSTS);
  37.     $packet->put_str($ssh->config->get('user'));
  38.     $packet->send;
  39.  
  40.     $packet = Net::SSH::Perl::Packet->read($ssh);
  41.     my $type = $packet->type;
  42.     if ($type == SSH_SMSG_SUCCESS) {
  43.         return 1;
  44.     }
  45.     elsif ($type != SSH_SMSG_FAILURE) {
  46.         $ssh->fatal_disconnect("Protocol error: got $type in response to rhosts auth");
  47.     }
  48.  
  49.     return 0;
  50. }
  51.  
  52. 1;
  53. __END__
  54.  
  55. =head1 NAME
  56.  
  57. Net::SSH::Perl::Auth::Rhosts - Perform Rhosts authentication
  58.  
  59. =head1 SYNOPSIS
  60.  
  61.     use Net::SSH::Perl::Auth;
  62.     my $auth = Net::SSH::Perl::Auth->new('Rhosts', $ssh);
  63.     print "Valid auth" if $auth->authenticate;
  64.  
  65. =head1 DESCRIPTION
  66.  
  67. I<Net::SSH::Perl::Auth::Rhosts> performs Rhosts authentication
  68. with a remote sshd server. When you create a new Rhosts auth
  69. object, you give it an I<$ssh> object, which should contain an open
  70. connection to an ssh daemon, as well as any data that the
  71. authentication module needs to proceed. In this case, the
  72. I<$ssh> object must contain the name of the user trying
  73. to open the connection.
  74.  
  75. Rhosts authentication is fairly simple from a protocol point
  76. of view. However, note that the sshd server will require
  77. your client to be running on a privileged port (below 1024);
  78. this will, in turn, likely require your client to be running
  79. as root. If your client is not running on a privileged port,
  80. the Rhosts authentication request will be denied.
  81.  
  82. If you're running as root, I<Net::SSH::Perl> should
  83. automatically detect that and try to start up on a privileged
  84. port. If for some reason that isn't happening, take a look at
  85. the I<Net::SSH::Perl> docs.
  86.  
  87. With that aside, to use Rhosts authentication the client
  88. sends a request to the server to authenticate it, including
  89. the name of the user trying to authenticate. The server uses
  90. its I<shosts.equiv>, I<hosts.equiv>, etc. files to determine
  91. whether the user/host should be allowed access.
  92.  
  93. =head1 AUTHOR & COPYRIGHTS
  94.  
  95. Please see the Net::SSH::Perl manpage for author, copyright,
  96. and license information.
  97.  
  98. =cut
  99.