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 / PublicKey.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-03  |  7.3 KB  |  246 lines
  1. # $Id: PublicKey.pm,v 1.20 2003/12/03 15:35:21 autarch Exp $
  2.  
  3. package Net::SSH::Perl::Auth::PublicKey;
  4.  
  5. use strict;
  6.  
  7. use Net::SSH::Perl::Constants qw(
  8.     SSH2_MSG_USERAUTH_REQUEST
  9.     SSH2_MSG_USERAUTH_PK_OK
  10.     SSH_COMPAT_OLD_SESSIONID
  11.     SSH_COMPAT_BUG_PKAUTH );
  12.  
  13. use Net::SSH::Perl::Util qw( _read_passphrase );
  14. use Net::SSH::Perl::Buffer;
  15. use Net::SSH::Perl::Key;
  16.  
  17. use Net::SSH::Perl::Auth;
  18. use base qw( Net::SSH::Perl::Auth );
  19.  
  20. use Scalar::Util qw(weaken);
  21.  
  22. sub new {
  23.     my $class = shift;
  24.     my $ssh = shift;
  25.     my $auth = bless { ssh => $ssh }, $class;
  26.     weaken $auth->{ssh};
  27.     $auth->enabled( $ssh->config->get('auth_dsa') );
  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.  
  41.     my $sent = 0;
  42.     if (my $agent = $auth->mgr->agent) {
  43.         do {
  44.             $sent = $auth->_auth_agent;
  45.         } until $sent || $agent->num_left <= 0;
  46.     }
  47.     return $sent if $sent;
  48.  
  49.     my $if = $ssh->config->get('identity_files') || [];
  50.     my $idx = $auth->{_identity_idx} || 0;
  51.     for my $f (@$if[$idx..$#$if]) {
  52.         $auth->{_identity_idx}++;
  53.         return 1 if $auth->_auth_identity($f);
  54.     }
  55. }
  56.  
  57. sub _auth_agent {
  58.     my $auth = shift;
  59.     my $agent = $auth->mgr->agent;
  60.  
  61.     my($iter);
  62.     $iter = $auth->{_identity_iter} = $agent->identity_iterator
  63.         unless $iter = $auth->{_identity_iter};
  64.     my($key, $comment) = $iter->();
  65.     return unless $key;
  66.     $auth->{ssh}->debug("Publickey: testing agent key '$comment'");
  67.     $auth->_test_pubkey($key, \&agent_sign);
  68. }
  69.  
  70. sub _auth_identity {
  71.     my $auth = shift;
  72.     my($auth_file) = @_;
  73.     my $ssh = $auth->{ssh};
  74.     my($packet);
  75.  
  76.     return unless -e $auth_file;
  77.  
  78.     my($key);
  79.     $ssh->debug("Trying pubkey authentication with key file '$auth_file'");
  80.  
  81.     $key = Net::SSH::Perl::Key->read_private_pem($auth_file, '',
  82.         \$ssh->{datafellows});
  83.     if (!$key) {
  84.         my $passphrase = "";
  85.         if ($ssh->config->get('interactive')) {
  86.             $passphrase = _read_passphrase("Enter passphrase for keyfile '$auth_file': ");
  87.         }
  88.         else {
  89.             $ssh->debug("Will not query passphrase for '$auth_file' in batch mode.");
  90.         }
  91.  
  92.         $key = Net::SSH::Perl::Key->read_private_pem($auth_file,
  93.             $passphrase, \$ssh->{datafellows});
  94.         if (!$key) {
  95.             $ssh->debug("Loading private key failed.");
  96.             return 0;
  97.         }
  98.     }
  99.  
  100.     $auth->_sign_send_pubkey($key, \&key_sign);
  101. }
  102.  
  103. sub agent_sign { $_[0]->mgr->agent->sign($_[1], $_[2]) }
  104. sub key_sign { $_[1]->sign($_[2]) }
  105.  
  106. sub _sign_send_pubkey {
  107.     my $auth = shift;
  108.     my($key, $cb) = @_;
  109.     my $ssh = $auth->{ssh};
  110.     my($packet);
  111.  
  112.     my $b = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
  113.     if ($ssh->{datafellows} & SSH_COMPAT_OLD_SESSIONID) {
  114.         $b->append($ssh->session_id);
  115.     }
  116.     else {
  117.         $b->put_str($ssh->session_id);
  118.     }
  119.     $b->put_int8(SSH2_MSG_USERAUTH_REQUEST);
  120.     my $skip = $b->length;
  121.  
  122.     $b->put_str($ssh->config->get('user'));
  123.     $b->put_str("ssh-connection");
  124.     $b->put_str("publickey");
  125.     $b->put_int8(1);
  126.     $b->put_str( $key->ssh_name );
  127.     $b->put_str( $key->as_blob );
  128.  
  129.     my $sigblob = $cb->($auth, $key, $b->bytes);
  130.     $ssh->debug("Signature generation failed for public key."), return
  131.         unless $sigblob;
  132.     $b->put_str($sigblob);
  133.  
  134.     $b->bytes(0, $skip, '');   ## Get rid of session ID and packet type.
  135.  
  136.     $packet = $ssh->packet_start(SSH2_MSG_USERAUTH_REQUEST);
  137.     $packet->append($b->bytes);
  138.     $packet->send;
  139.  
  140.     return 1;
  141. }
  142.  
  143. sub _test_pubkey {
  144.     my $auth = shift;
  145.     my($key, $cb) = @_;
  146.     my $ssh = $auth->{ssh};
  147.  
  148.     my $blob = $key->as_blob;
  149.  
  150.     ## Set up PK_OK callback; closure on $auth, $key, and $cb.
  151.     $auth->mgr->register_handler(SSH2_MSG_USERAUTH_PK_OK, sub {
  152.         my $amgr = shift;
  153.         my($packet) = @_;
  154.         my $ssh = $amgr->{ssh};
  155.         my $alg = $packet->get_str;
  156.         my $blob = $packet->get_str;
  157.  
  158.         $ssh->debug("PK_OK received without existing key state."), return
  159.             unless $key && $cb;
  160.  
  161.         my $s_key = Net::SSH::Perl::Key->new_from_blob($blob);
  162.         $ssh->debug("Failed extracting key from blob, pkalgorithm is '$alg'"),
  163.             return unless $s_key;
  164.         $ssh->debug("PK_OK key != saved state key"), return
  165.             unless $s_key->equal($key);
  166.  
  167.         $ssh->debug("Public key is accepted, signing data.");
  168.         $ssh->debug("Key fingerprint: " . $key->fingerprint);
  169.         my $sent = $auth->_sign_send_pubkey($s_key, $cb);
  170.         $amgr->remove_handler(SSH2_MSG_USERAUTH_PK_OK);
  171.  
  172.         $sent;
  173.     });
  174.  
  175.     my $packet = $ssh->packet_start(SSH2_MSG_USERAUTH_REQUEST);
  176.     $packet->put_str($ssh->config->get('user'));
  177.     $packet->put_str("ssh-connection");
  178.     $packet->put_str("publickey");
  179.     $packet->put_int8(0);   ## No signature, just public key blob.
  180.     $packet->put_str($key->ssh_name)
  181.         unless $ssh->{datafellows} & SSH_COMPAT_BUG_PKAUTH;
  182.     $packet->put_str($blob);
  183.     $packet->send;
  184.  
  185.     return 1;
  186. }
  187.  
  188. 1;
  189. __END__
  190.  
  191. =head1 NAME
  192.  
  193. Net::SSH::Perl::Auth::PublicKey - Perform publickey authentication
  194.  
  195. =head1 SYNOPSIS
  196.  
  197.     use Net::SSH::Perl::Auth;
  198.     my $auth = Net::SSH::Perl::Auth->new('PublicKey', $ssh);
  199.     $auth->authenticate;
  200.  
  201. =head1 DESCRIPTION
  202.  
  203. I<Net::SSH::Perl::Auth::PublicKey> performs publickey authentication
  204. with a remote sshd server. When you create a new PublicKey auth
  205. object, you give it an I<$ssh> object, which should contain an open
  206. connection to an ssh daemon, as well as any data that the
  207. authentication module needs to proceed. In this case, for
  208. example, the I<$ssh> object might contain a list of
  209. identity files (see the docs for I<Net::SSH::Perl>).
  210.  
  211. The I<authenticate> method first tries to establish a connection
  212. to an authentication agent. If the attempt is successful,
  213. I<authenticate> loops through each of the identities returned from
  214. the agent and tries each identity against the sshd, entering into
  215. a dialog with the server: the client sends the public portion of
  216. the key to determine whether the server will accept it; if the
  217. server accepts the key as authorization, the client then asks the
  218. agent to sign a piece of data using the key, which the client sends
  219. to the server. If the server accepts an identity/key, authentication
  220. is successful.
  221.  
  222. If the agent connection attempt fails, or if none of the identities
  223. returned from the agent allow for successful authentication,
  224. I<authenticate> then tries to load each of the user's private key
  225. identity files (specified in the I<Net::SSH::Perl> constructor, or
  226. defaulted to F<$ENV{HOME}/.ssh/id_dsa>). For each identity,
  227. I<authenticate> enters into a dialog with the server. The client
  228. sends a message to the server, giving its public key, plus a signature
  229. of the key and the other data in the message (session ID, etc.).
  230. The signature is generated using the corresponding private key.
  231. The sshd receives the message and verifies the signature using the
  232. client's public key. If the verification is successful, the
  233. authentication succeeds.
  234.  
  235. When loading each of the private key files, the client first
  236. tries to load the key using an empty passphrase. If this
  237. fails, the client either prompts the user for a passphrase
  238. (if the session is interactive) or skips the key altogether.
  239.  
  240. =head1 AUTHOR & COPYRIGHTS
  241.  
  242. Please see the Net::SSH::Perl manpage for author, copyright,
  243. and license information.
  244.  
  245. =cut
  246.