ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/AnyEvent-Porttracker/Porttracker.pm
(Generate patch)

Comparing cvsroot/AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.16 by root, Thu Jun 2 01:27:46 2011 UTC vs.
Revision 1.19 by root, Tue Jul 26 16:12:46 2016 UTC

1=head1 NAME 1=head1 NAME
2 2
3AnyEvent::Porttracker - Porttracker/PortIQ API client interface. 3AnyEvent::Porttracker - Porttracker API client interface.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::Porttracker; 7 use AnyEvent::Porttracker;
8 8
9 my $api = new AnyEvent::Porttracker 9 my $api = new AnyEvent::Porttracker
10 host => "10.0.0.1", 10 host => "10.0.0.1",
11 user => "admin", 11 user => "admin",
12 pass => "31331", 12 pass => "31331",
13 tls => 1, 13 tls => 1,
14 on_error => sub {
15 die $_[1];
16 },
14 ; 17 ;
15 18
16 # Example 1 19 # Example 1
17 # a simple request: ping the server synchronously 20 # a simple request: ping the server synchronously
18 21
… …
64other things) scans switches and routers in a network and gives a coherent 67other things) scans switches and routers in a network and gives a coherent
65view of which end devices are connected to which switch ports on which 68view of which end devices are connected to which switch ports on which
66switches and routers. It also offers a JSON-based client API, for which 69switches and routers. It also offers a JSON-based client API, for which
67this module is an implementation. 70this module is an implementation.
68 71
69In addition to Porttracker, the PortIQ product is also supported, as it
70uses the same protocol.
71
72If you do not have access to either a Porttracker or PortIQ box then this 72If you do not have access to a Porttracker box then this module will be of
73module will be of little value to you. 73little value to you.
74 74
75This module is an L<AnyEvent> user, you need to make sure that you use and 75This module is an L<AnyEvent> user, you need to make sure that you use and
76run a supported event loop. 76run a supported event loop.
77 77
78To quickly understand how this module works you should read how to 78To quickly understand how this module works you should read how to
… …
101 101
102use AnyEvent (); 102use AnyEvent ();
103use AnyEvent::Handle (); 103use AnyEvent::Handle ();
104 104
105use MIME::Base64 (); 105use MIME::Base64 ();
106use Digest::HMAC_MD6 ();
107use JSON (); 106use JSON ();
108 107
109our $VERSION = '1.01'; 108our $VERSION = 1.02;
110 109
111sub call { 110sub call {
112 my ($self, $type, @args) = @_; 111 my ($self, $type, @args) = @_;
113 112
114 $self->{$type} 113 $self->{$type}
… …
118 : () 117 : ()
119} 118}
120 119
121=item $api = new AnyEvent::Porttracker [key => value...] 120=item $api = new AnyEvent::Porttracker [key => value...]
122 121
123Creates a new porttracker API connection object and tries to connect to 122Creates a new porttracker API connection object and tries to connect
124the specified host (see below). After the connection has been established, 123to the specified host (see below). After the connection has been
125the TLS handshake (if requested) will take place, followed by a login 124established, the TLS handshake (if requested) will take place, followed
126attempt using either the C<none>, C<login_cram_md6> or C<login> methods, 125by a login attempt using either the C<none>, C<login_cram_sha3>,
127in this order of preference (typically, C<login_cram_md6> is used, which 126C<login_cram_md6> or C<login> methods, in this order of preference
127(typically, C<login_cram_sha3> is used, which shields against some
128shields against some man-in-the-middle attacks and avoids transferring the 128man-in-the-middle attacks and avoids transferring the password).
129password).
130 129
131It is permissible to send requests immediately after creating the object - 130It is permissible to send requests immediately after creating the object -
132they will be queued until after successful login. 131they will be queued until after successful login.
133 132
134Possible key-value pairs are: 133Possible key-value pairs are:
… …
152 151
153Enables or disables TLS (default: disables). When enabled, then the 152Enables or disables TLS (default: disables). When enabled, then the
154connection will try to handshake a TLS connection before logging in. If 153connection will try to handshake a TLS connection before logging in. If
155unsuccessful a fatal error will be raised. 154unsuccessful a fatal error will be raised.
156 155
157Since most Porttracker/PortIQ boxes will not have a sensible/verifiable 156Since most Porttracker boxes will not have a sensible/verifiable
158certificate, no attempt at verifying it will be done (which means 157certificate, no attempt at verifying it will be done (which means
159man-in-the-middle-attacks will be trivial). If you want some form of 158man-in-the-middle-attacks will be trivial). If you want some form of
160verification you need to provide your own C<tls_ctx> object with C<< 159verification you need to provide your own C<tls_ctx> object with C<<
161verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode 160verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
162you wish to use. 161you wish to use.
… …
408 407
409sub _login { 408sub _login {
410 my ($self) = @_; 409 my ($self) = @_;
411 410
412 my ($auths, $nonce) = @{ delete $self->{hello} or return }; 411 my ($auths, $nonce) = @{ delete $self->{hello} or return };
412 use Data::Dump; ddx $auths;#d#
413 413
414 if (grep $_ eq "none", @$auths) { 414 if (grep $_ eq "none", @$auths) {
415 $self->_login_success ("none"); 415 $self->_login_success ("none");
416 } elsif (grep $_ eq "login_cram_sha3", @$auths) {
417 my $cc = join "", map chr 256 * rand, 0..63;
416 418
419 require Digest::SHA3;
420 require Digest::HMAC;
421
422 my $hmac_sha3 = sub ($$){ # $key, $text
423 Digest::HMAC::hmac ($_[1], $_[0], \&Digest::SHA3::sha3_512, 72)
424 };
425
426 my $key = $hmac_sha3->($self->{pass}, $self->{user});
427 my $cr = $hmac_sha3->($key, "$cc$nonce");
428 my $sr = $hmac_sha3->($key, "$nonce$cc");
429
430 $cc = MIME::Base64::encode_base64 $cc;
431 $cr = MIME::Base64::encode_base64 $cr;
432
433 $self->_req (login_cram_sha3 => $self->{user}, $cr, $cc, sub {
434 my ($self, $ok, $msg) = @_;
435
436 $ok
437 or return call $self, on_login_failure => $msg;
438
439 (MIME::Base64::decode_base64 $msg) eq $sr
440 or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
441
442 $self->_login_success ("login_cram_sha3");
443 });
417 } elsif (grep $_ eq "login_cram_md6", @$auths) { 444 } elsif (grep $_ eq "login_cram_md6", @$auths) {
418 my $cc = join "", map chr 256 * rand, 0..63; 445 my $cc = join "", map chr 256 * rand, 0..63;
419 446
447 require Digest::HMAC_MD6;
448
420 my $key = Digest::HMAC_MD6::hmac_md6 $self->{pass}, $self->{user}, 64, 256; 449 my $key = Digest::HMAC_MD6::hmac_md6 ($self->{pass}, $self->{user}, 64, 256);
421 my $cr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$cc$nonce", 64, 256; 450 my $cr = Digest::HMAC_MD6::hmac_md6 ($key, "$cc$nonce", 64, 256);
422 my $sr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$nonce$cc", 64, 256; 451 my $sr = Digest::HMAC_MD6::hmac_md6 ($key, "$nonce$cc", 64, 256);
423 452
424 $cc = MIME::Base64::encode_base64 $cc; 453 $cc = MIME::Base64::encode_base64 $cc;
454 $cr = MIME::Base64::encode_base64 $cr;
425 455
426 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub { 456 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub {
427 my ($self, $ok, $msg) = @_; 457 my ($self, $ok, $msg) = @_;
428 458
429 $ok 459 $ok
430 or return call $self, on_login_failure => $msg; 460 or return call $self, on_login_failure => $msg;
431 461
432 $msg eq $sr 462 (MIME::Base64::decode_base64 $msg) eq $sr
433 or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack"; 463 or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
434 464
435 $self->_login_success ("login_cram_md6"); 465 $self->_login_success ("login_cram_md6");
436 }); 466 });
437 } elsif (grep $_ eq "login", @$auths) { 467 } elsif (grep $_ eq "login", @$auths) {
… …
583 613
584=back 614=back
585 615
586=head1 SEE ALSO 616=head1 SEE ALSO
587 617
588L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 618L<AnyEvent>, L<http://www.porttracker.com/>.
589 619
590=head1 AUTHOR 620=head1 AUTHOR
591 621
592 Marc Lehmann <marc@nethype.de> 622 Marc Lehmann <marc@nethype.de>
593 623

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines