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.10 by root, Tue Nov 16 02:07:31 2010 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 20 # a simple request: ping the server synchronously
18 21
19 $api->req ("ping", sub { 22 my ($timestamp, $pid) = $api->req_sync ("ping");
20 my ($api, $ok, $timestamp, $pid) = @_;
21 ...
22 });
23 23
24 # Example 2 24 # Example 2
25 # find all realms, start a discovery on all of them 25 # find all realms, start a discovery on all of them
26 # and wait until all discovery processes have finished 26 # and wait until all discovery processes have finished
27 # but execute individual discoveries in parallel,
28 # asynchronously
27 29
28 my $cv = AE::cv; 30 my $cv = AE::cv;
29 31
30 $cv->begin; 32 $cv->begin;
31 # find all realms 33 # find all realms
… …
35 # start discovery on all realms 37 # start discovery on all realms
36 for my $realm (@realms) { 38 for my $realm (@realms) {
37 my ($gid, $name) = @$realm; 39 my ($gid, $name) = @$realm;
38 40
39 $cv->begin; 41 $cv->begin;
40 $api->req (realm_discover => $realm->[0], sub { 42 $api->req (realm_discover => $gid, sub {
41 warn "discovery for realm '$realm->[1]' finished\n"; 43 warn "discovery for realm '$name' finished\n";
42 $cv->end; 44 $cv->end;
43 }); 45 });
44 } 46 }
45 47
46 $cv->end; 48 $cv->end;
… …
55 $api->on (realm_poll_stop_event => sub { 57 $api->on (realm_poll_stop_event => sub {
56 my ($api, $gid) = @_; 58 my ($api, $gid) = @_;
57 warn "this just in: poll for realm <$gid> finished.\n"; 59 warn "this just in: poll for realm <$gid> finished.\n";
58 }); 60 });
59 61
62 AE::cv->recv; # wait forever
63
60=head1 DESCRIPTION 64=head1 DESCRIPTION
61 65
62Porttracker (L<http://www.porttracker.com/>) is a product that (among 66Porttracker (L<http://www.porttracker.com/>) is a product that (among
63other 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
64view 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
65switches 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
66this module is an implementation. 70this module is an implementation.
67 71
68In addition to Porttracker, the PortIQ product is also supported, as it
69uses the same protocol.
70
71If 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
72module will be of little value to you. 73little value to you.
73 74
74This 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
75run a supported event loop. 76run a supported event loop.
76 77
77To quickly understand how this module works you should read how to 78To quickly understand how this module works you should read how to
… …
93 94
94package AnyEvent::Porttracker; 95package AnyEvent::Porttracker;
95 96
96use common::sense; 97use common::sense;
97 98
99use Carp ();
98use Scalar::Util (); 100use Scalar::Util ();
99 101
100use AnyEvent (); 102use AnyEvent ();
101use AnyEvent::Handle (); 103use AnyEvent::Handle ();
102 104
103use MIME::Base64 (); 105use MIME::Base64 ();
104use Digest::HMAC_MD6 ();
105use JSON (); 106use JSON ();
106 107
107our $VERSION = '0.0'; 108our $VERSION = 1.02;
108 109
109sub call { 110sub call {
110 my ($self, $type, @args) = @_; 111 my ($self, $type, @args) = @_;
111 112
112 $self->{$type} 113 $self->{$type}
… …
116 : () 117 : ()
117} 118}
118 119
119=item $api = new AnyEvent::Porttracker [key => value...] 120=item $api = new AnyEvent::Porttracker [key => value...]
120 121
121Creates a new porttracker API connection object and tries to connect to 122Creates a new porttracker API connection object and tries to connect
122the specified host (see below). After the connection has been established, 123to the specified host (see below). After the connection has been
123the TLS handshake (if requested) will take place, followed by a login 124established, the TLS handshake (if requested) will take place, followed
124attempt 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>,
125in 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
126shields against some man-in-the-middle attacks and avoids transferring the 128man-in-the-middle attacks and avoids transferring the password).
127password).
128 129
129It is permissible to send requests immediately after creating the object - 130It is permissible to send requests immediately after creating the object -
130they will be queued until after successful login. 131they will be queued until after successful login.
131 132
132Possible key-value pairs are: 133Possible key-value pairs are:
… …
150 151
151Enables or disables TLS (default: disables). When enabled, then the 152Enables or disables TLS (default: disables). When enabled, then the
152connection will try to handshake a TLS connection before logging in. If 153connection will try to handshake a TLS connection before logging in. If
153unsuccessful a fatal error will be raised. 154unsuccessful a fatal error will be raised.
154 155
155Since most Porttracker/PortIQ boxes will not have a sensible/verifiable 156Since most Porttracker boxes will not have a sensible/verifiable
156certificate, no attempt at verifying it will be done (which means 157certificate, no attempt at verifying it will be done (which means
157man-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
158verification 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<<
159verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode 160verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
160you wish to use. 161you wish to use.
… …
163 164
164The L<AnyEvent::TLS> object to use. See C<tls>, above. 165The L<AnyEvent::TLS> object to use. See C<tls>, above.
165 166
166=item on_XYZ => $coderef 167=item on_XYZ => $coderef
167 168
168You can specify event callbacks either by subclassing and overriding the 169You can specify event callbacks either by sub-classing and overriding the
169respective methods or by specifying coderefs as key-value pairs when 170respective methods or by specifying code-refs as key-value pairs when
170constructing the object. You add or remove event handlers at any time with 171constructing the object. You add or remove event handlers at any time with
171the C<event> method. 172the C<event> method.
172 173
173=back 174=back
174 175
… …
178 my $class = shift; 179 my $class = shift;
179 180
180 my $self = bless { 181 my $self = bless {
181 id => "a", 182 id => "a",
182 ids => [], 183 ids => [],
183 queue => [], # ininitially queue everything 184 queue => [], # initially queue everything
184 @_, 185 @_,
185 }, $class; 186 }, $class;
186 187
187 { 188 {
188 Scalar::Util::weaken (my $self = $self); 189 Scalar::Util::weaken (my $self = $self);
… …
310 $_[0]{queue} 311 $_[0]{queue}
311 ? push @{ $_[0]{queue} }, [@_] 312 ? push @{ $_[0]{queue} }, [@_]
312 : &_req 313 : &_req
313} 314}
314 315
316=item @res = $api->req_sync ($type => @args)
317
318Similar to C<< ->req >>, but waits for the results of the request and on
319success, returns the values instead (without the success flag, and only
320the first value in scalar context). On failure, the method will C<croak>
321with the error message.
322
323=cut
324
325sub req_sync {
326 push @_, my $cv = AE::cv;
327 &req;
328 my ($ok, @res) = $cv->recv;
329
330 $ok
331 or Carp::croak $res[0];
332
333 wantarray ? @res : $res[0]
334}
335
315=item $api->req_failok ($type => @args, $callback->($api, $success, @reply)) 336=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
316 337
317Just like C<< ->req >>, with two differences: first, a failure will not 338Just like C<< ->req >>, with two differences: first, a failure will not
318raise an error, second, the initial status reply which indicates success 339raise an error, second, the initial status reply which indicates success
319or failure is not removed before calling the callback. 340or failure is not removed before calling the callback.
… …
386 407
387sub _login { 408sub _login {
388 my ($self) = @_; 409 my ($self) = @_;
389 410
390 my ($auths, $nonce) = @{ delete $self->{hello} or return }; 411 my ($auths, $nonce) = @{ delete $self->{hello} or return };
412 use Data::Dump; ddx $auths;#d#
391 413
392 if (grep $_ eq "none", @$auths) { 414 if (grep $_ eq "none", @$auths) {
393 $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;
394 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 });
395 } elsif (grep $_ eq "login_cram_md6", @$auths) { 444 } elsif (grep $_ eq "login_cram_md6", @$auths) {
396 my $cc = join "", map chr 256 * rand, 0..63; 445 my $cc = join "", map chr 256 * rand, 0..63;
397 446
447 require Digest::HMAC_MD6;
448
398 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);
399 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);
400 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);
401 452
402 $cc = MIME::Base64::encode_base64 $cc; 453 $cc = MIME::Base64::encode_base64 $cc;
454 $cr = MIME::Base64::encode_base64 $cr;
403 455
404 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub { 456 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub {
405 my ($self, $ok, $msg) = @_; 457 my ($self, $ok, $msg) = @_;
406 458
407 $ok 459 $ok
408 or return call $self, on_login_failure => $msg; 460 or return call $self, on_login_failure => $msg;
409 461
410 $msg eq $sr 462 (MIME::Base64::decode_base64 $msg) eq $sr
411 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";
412 464
413 $self->_login_success ("login_cram_md6"); 465 $self->_login_success ("login_cram_md6");
414 }); 466 });
415 } elsif (grep $_ eq "login", @$auths) { 467 } elsif (grep $_ eq "login", @$auths) {
… …
463 call $self, "on_${event}_event", @args; 515 call $self, "on_${event}_event", @args;
464} 516}
465 517
466=back 518=back
467 519
468=head1 EVENTS 520=head1 EVENTS/CALLBACKS
469 521
470AnyEvent::Porttracker conenctions are fully event-driven, and naturally 522AnyEvent::Porttracker connections are fully event-driven, and naturally
471there are a number of events that can occur. All these events have a name 523there are a number of events that can occur. All these events have a name
472starting with C<on_> (example: C<on_login_failure>). 524starting with C<on_> (example: C<on_login_failure>).
473 525
474Programs can catch these events in two ways: either by providing 526Programs can catch these events in two ways: either by providing
475constructor arguments with the event name as key and a coderef as value: 527constructor arguments with the event name as key and a code-ref as value:
476 528
477 my $api = new AnyEvent::Porttracker 529 my $api = new AnyEvent::Porttracker
478 host => ..., 530 host => ...,
479 user => ..., pass => ..., 531 user => ..., pass => ...,
480 on_error => sub { 532 on_error => sub {
… …
482 warn $msg; 534 warn $msg;
483 exit 1; 535 exit 1;
484 }, 536 },
485 ; 537 ;
486 538
487Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 539Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
488same name: 540same name:
489 541
490 package MyClass; 542 package MyClass;
491 543
492 use base AnyEvent::Porttracker; 544 use base AnyEvent::Porttracker;
… …
540 592
541=item on_start_tls_notify $api 593=item on_start_tls_notify $api
542 594
543Called when the server wants to start TLS negotiation. This is used 595Called when the server wants to start TLS negotiation. This is used
544internally and - while it is possible to override it - should not be 596internally and - while it is possible to override it - should not be
545overriden. 597overridden.
546 598
547=item on_event_notify $api, $eventname, @args 599=item on_event_notify $api, $eventname, @args
548 600
549Called when the server broadcasts an event the API object is subscribed 601Called when the server broadcasts an event the API object is subscribed
550to. The default implementation (which should not be overridden) simply 602to. The default implementation (which should not be overridden) simply
… …
561 613
562=back 614=back
563 615
564=head1 SEE ALSO 616=head1 SEE ALSO
565 617
566L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 618L<AnyEvent>, L<http://www.porttracker.com/>.
567 619
568=head1 AUTHOR 620=head1 AUTHOR
569 621
570 Marc Lehmann <marc@porttracker.net> 622 Marc Lehmann <marc@nethype.de>
571 623
572=cut 624=cut
573 625
5741 6261

Diff Legend

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