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 / Agent.pm < prev    next >
Encoding:
Perl POD Document  |  2001-07-11  |  8.7 KB  |  303 lines
  1. # $Id: Agent.pm,v 1.4 2001/07/11 21:57:26 btrott Exp $
  2.  
  3. package Net::SSH::Perl::Agent;
  4. use strict;
  5.  
  6. use IO::Socket;
  7. use Carp qw( croak );
  8. use Net::SSH::Perl::Constants qw( :agent SSH_COM_AGENT2_FAILURE );
  9. use Net::SSH::Perl::Buffer;
  10.  
  11. sub new {
  12.     my $class = shift;
  13.     my $agent = bless {}, $class;
  14.     $agent->init(@_);
  15. }
  16.  
  17. sub init {
  18.     my $agent = shift;
  19.     my($version) = @_;
  20.     $agent->{sock} = $agent->create_socket or return;
  21.     $agent->{version} = $version;
  22.     $agent;
  23. }
  24.  
  25. sub create_socket {
  26.     my $agent = shift;
  27.     my $authsock = $ENV{"SSH_AUTH_SOCK"} or return;
  28.  
  29.     $agent->{sock} = IO::Socket::UNIX->new(
  30.                     Type => SOCK_STREAM,
  31.                     Peer => $authsock
  32.         ) or return;
  33. }
  34.  
  35. sub request {
  36.     my $agent = shift;
  37.     my($req) = @_;
  38.     my $len = pack "N", $req->length;
  39.     my $sock = $agent->{sock};
  40.     (syswrite($sock, $len, 4) == 4 and
  41.       syswrite($sock, $req->bytes, $req->length) == $req->length) or
  42.         croak "Error writing to auth socket.";
  43.     $len = 4;
  44.     my $buf;
  45.     while ($len > 0) {
  46.         my $l = sysread $sock, $buf, $len;
  47.         croak "Error reading response length from auth socket." unless $l > 0;
  48.         $len -= $l;
  49.     }
  50.     $len = unpack "N", $buf;
  51.     croak "Auth response too long: $len" if $len > 256 * 1024;
  52.  
  53.     $buf = Net::SSH::Perl::Buffer->new( MP => "SSH$agent->{version}" );
  54.     while ($buf->length < $len) {
  55.         my $b;
  56.         my $l = sysread $sock, $b, $len;
  57.         croak "Error reading response from auth socket." unless $l > 0;
  58.         $buf->append($b);
  59.     }
  60.     $buf;
  61. }
  62.  
  63. sub num_left { $_[0]->{num} }
  64.  
  65. sub num_identities {
  66.     my $agent = shift;
  67.     my($type1, $type2) = $agent->{version} == 2 ?
  68.         (SSH2_AGENTC_REQUEST_IDENTITIES, SSH2_AGENT_IDENTITIES_ANSWER) :
  69.         (SSH_AGENTC_REQUEST_RSA_IDENTITIES, SSH_AGENT_RSA_IDENTITIES_ANSWER);
  70.  
  71.     my $r = Net::SSH::Perl::Buffer->new( MP => "SSH$agent->{version}" );
  72.     $r->put_int8($type1);
  73.     my $reply = $agent->{identities} = $agent->request($r);
  74.  
  75.     my $type = $reply->get_int8;
  76.     if ($type == SSH_AGENT_FAILURE || $type == SSH_COM_AGENT2_FAILURE) {
  77.         return;
  78.     }
  79.     elsif ($type != $type2) {
  80.         croak "Bad auth reply message type: $type1 != $type2";
  81.     }
  82.  
  83.     $agent->{num} = $reply->get_int32;
  84.     croak "Too many identities in agent reply: $agent->{num}"
  85.         if $agent->{num} > 1024;
  86.  
  87.     $agent->{num};
  88. }
  89.  
  90. sub identity_iterator {
  91.     my $agent = shift;
  92.     return sub { } unless $agent->num_identities;
  93.     sub { $agent->next_identity };
  94. }
  95.  
  96. sub first_identity {
  97.     my $agent = shift;
  98.     $agent->next_identity if $agent->num_identities;
  99. }
  100.  
  101. sub next_identity {
  102.     my $agent = shift;
  103.     return unless $agent->{num} > 0;
  104.  
  105.     my($ident, $key, $comment) = ($agent->{identities});
  106.     if ($agent->{version} == 1) {
  107.         $key = Net::SSH::Perl::Key->new('RSA1');
  108.         $key->{rsa}{bits} = $ident->get_int32;
  109.         $key->{rsa}{e} = $ident->get_mp_int;
  110.         $key->{rsa}{n} = $ident->get_mp_int;
  111.         $comment = $ident->get_str;
  112.     }
  113.     else {
  114.         my $blob = $ident->get_str;
  115.         $comment = $ident->get_str;
  116.         $key = Net::SSH::Perl::Key->new_from_blob($blob);
  117.     }
  118.     $agent->{num}--;
  119.     wantarray ? ($key, $comment) : $key;
  120. }
  121.  
  122. sub sign {
  123.     my $agent = shift;
  124.     my($key, $data) = @_;
  125.     my $blob = $key->as_blob;
  126.     my $r = Net::SSH::Perl::Buffer->new( MP => "SSH$agent->{version}" );
  127.     $r->put_int8(SSH2_AGENTC_SIGN_REQUEST);
  128.     $r->put_str($blob);
  129.     $r->put_str($data);
  130.     $r->put_int32(0);
  131.  
  132.     my $reply = $agent->request($r);
  133.     my $type = $reply->get_int8;
  134.     if ($type == SSH_AGENT_FAILURE || $type == SSH_COM_AGENT2_FAILURE) {
  135.         return;
  136.     }
  137.     elsif ($type != SSH2_AGENT_SIGN_RESPONSE) {
  138.         croak "Bad auth response: $type != ",  SSH2_AGENT_SIGN_RESPONSE;
  139.     }
  140.     else {
  141.         return $reply->get_str;
  142.     }
  143. }
  144.  
  145. sub decrypt {
  146.     my $agent = shift;
  147.     my($key, $data, $session_id) = @_;
  148.     my $r = Net::SSH::Perl::Buffer->new( MP => "SSH$agent->{version}" );
  149.     $r->put_int8(SSH_AGENTC_RSA_CHALLENGE);
  150.     $r->put_int32($key->{rsa}{bits});
  151.     $r->put_mp_int($key->{rsa}{e});
  152.     $r->put_mp_int($key->{rsa}{n});
  153.     $r->put_mp_int($data);
  154.     $r->put_chars($session_id);
  155.     $r->put_int32(1);
  156.  
  157.     my $reply = $agent->request($r);
  158.     my $type = $reply->get_int8;
  159.     my $response = '';
  160.     if ($type == SSH_AGENT_FAILURE || $type == SSH_COM_AGENT2_FAILURE) {
  161.         return;
  162.     }
  163.     elsif ($type != SSH_AGENT_RSA_RESPONSE) {
  164.         croak "Bad auth response: $type";
  165.     }
  166.     else {
  167.         $response .= $reply->get_char for 1..16;
  168.     }
  169.     $response;
  170. }
  171.  
  172. sub close_socket {
  173.     my $agent = shift;
  174.     close($agent->{sock});
  175. }
  176.  
  177. 1;
  178. __END__
  179.  
  180. =head1 NAME
  181.  
  182. Net::SSH::Perl::Agent - Client for agent authentication
  183.  
  184. =head1 SYNOPSIS
  185.  
  186.     use Net::SSH::Perl::Agent;
  187.     my $agent = Net::SSH::Perl::Agent->new(2);  ## SSH-2 protocol
  188.     my $iter = $agent->identity_iterator;
  189.     while (my($key, $comment) = $iter->()) {
  190.         ## Do something with $key.
  191.     }
  192.  
  193. =head1 DESCRIPTION
  194.  
  195. I<Net::SSH::Perl::Agent> provides a client for agent-based
  196. publickey authentication. The idea behind agent authentication
  197. is that an auth daemon is started as the parent of all of your
  198. other processes (eg. as the parent of your shell process); all
  199. other processes thus inherit the connection to the daemon.
  200.  
  201. After loading your public keys into the agent using I<ssh-add>, the
  202. agent listens on a Unix domain socket for requests for identities.
  203. When requested it sends back the public portions of the keys,
  204. which the SSH client (ie. I<Net::SSH::Perl>, in this case) can
  205. send to the sshd, to determine if the keys will be accepted on
  206. the basis of authorization. If so, the client requests that the
  207. agent use the key to decrypt a random challenge (SSH-1) or sign
  208. a piece of data (SSH-2).
  209.  
  210. I<Net::SSH::Perl::Agent> implements the client portion of the
  211. authentication agent; this is the piece that interfaces with
  212. I<Net::SSH::Perl>'s authentication mechanism to contact the
  213. agent daemon and ask for identities, etc. If you use publickey
  214. authentication (I<RSA> authentication in SSH-1, I<PublicKey>
  215. authentication in SSH-2), an attempt will automatically be
  216. made to contact the authentication agent. If the attempt
  217. succeeds, I<Net::SSH::Perl> will try to use the identities
  218. returned from the agent, in addition to any identity files on
  219. disk.
  220.  
  221. =head1 USAGE
  222.  
  223. =head2 Net::SSH::Perl::Agent->new($version)
  224.  
  225. Constructs a new I<Agent> object and returns that object.
  226.  
  227. I<$version> should be either I<1> or I<2> and is a mandatory
  228. argument; it specifies the protocol version that the agent
  229. client should use when talking to the agent daemon.
  230.  
  231. =head2 $agent->identity_iterator
  232.  
  233. This is probably the easiest way to get at the identities
  234. provided by the agent. I<identity_iterator> returns an iterator
  235. function that, when invoked, will returned the next identity
  236. in the list from the agent. For example:
  237.  
  238.     my $iter = $agent->identity_iterator;
  239.     while (my($key, $comment) = $iter->()) {
  240.          ## Do something with $key.
  241.     }
  242.  
  243. If called in scalar context, the iterator function will return
  244. the next key (a subclass of I<Net::SSH::Perl::Key>). If called
  245. in list context (as above), both the key and the comment are
  246. returned.
  247.  
  248. =head2 $agent->first_identity
  249.  
  250. Returns the first identity in the list provided by the auth
  251. agent.
  252.  
  253. If called in scalar context, the iterator function will return
  254. the next key (a subclass of I<Net::SSH::Perl::Key>). If called
  255. in list context, both the key and the comment are returned.
  256.  
  257. =head2 $agent->next_identity
  258.  
  259. Returns the next identity in the list provided by the auth
  260. agent. You I<must> call this I<after> first calling the
  261. I<first_identity> method. For example:
  262.  
  263.     my($key, $comment) = $agent->first_identity;
  264.     ## Do something.
  265.  
  266.     while (($key, $comment) = $agent->next_identity) {
  267.         ## Do something.
  268.     }
  269.  
  270. If called in scalar context, the iterator function will return
  271. the next key (a subclass of I<Net::SSH::Perl::Key>). If called
  272. in list context, both the key and the comment are returned.
  273.  
  274. =head2 $agent->sign($key, $data)
  275.  
  276. Asks the agent I<$agent> to sign the data I<$data> using the
  277. private portion of I<$key>. The key and the data are sent to
  278. the agent, which returns the signature; the signature is then
  279. sent to the sshd for verification.
  280.  
  281. This method is only applicable in SSH-2.
  282.  
  283. =head2 $agent->decrypt($key, $data, $session_id)
  284.  
  285. Asks the agent to which I<$agent> holds an open connection to
  286. decrypt the data I<$data> using the private portion of I<$key>.
  287. I<$data> should be a big integer (I<Math::GMP> object), and
  288. is generally a challenge to a request for RSA authentication.
  289. I<$session_id> is the SSH session ID:
  290.  
  291.     $ssh->session_id
  292.  
  293. where I<$ssh> is a I<Net::SSH::Perl::SSH1> object.
  294.  
  295. This method is only applicable in SSH-1.
  296.  
  297. =head1 AUTHOR & COPYRIGHTS
  298.  
  299. Please see the Net::SSH::Perl manpage for author, copyright,
  300. and license information.
  301.  
  302. =cut
  303.