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.6 by root, Tue Nov 16 01:10:50 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
9 my $api = new AnyEvent::Porttracker
10 host => "10.0.0.1",
11 user => "admin",
12 pass => "31331",
13 tls => 1,
14 on_error => sub {
15 die $_[1];
16 },
17 ;
18
19 # Example 1
20 # a simple request: ping the server synchronously
21
22 my ($timestamp, $pid) = $api->req_sync ("ping");
23
24 # Example 2
25 # find all realms, start a discovery on all of them
26 # and wait until all discovery processes have finished
27 # but execute individual discoveries in parallel,
28 # asynchronously
29
30 my $cv = AE::cv;
31
32 $cv->begin;
33 # find all realms
34 $api->req (realm_info => ["gid", "name"], sub {
35 my ($api, @realms) = @_;
36
37 # start discovery on all realms
38 for my $realm (@realms) {
39 my ($gid, $name) = @$realm;
40
41 $cv->begin;
42 $api->req (realm_discover => $gid, sub {
43 warn "discovery for realm '$name' finished\n";
44 $cv->end;
45 });
46 }
47
48 $cv->end;
49 });
50
51 $cv->recv;
52
53 # Example 3
54 # subscribe to realm_poll_stop events and report each occurance
55
56 $api->req (subscribe => "realm_poll_stop", sub {});
57 $api->on (realm_poll_stop_event => sub {
58 my ($api, $gid) = @_;
59 warn "this just in: poll for realm <$gid> finished.\n";
60 });
61
62 AE::cv->recv; # wait forever
8 63
9=head1 DESCRIPTION 64=head1 DESCRIPTION
10 65
11Porttracker (L<http://www.porttracker.com/>) is a product that (among 66Porttracker (L<http://www.porttracker.com/>) is a product that (among
12other 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
13view 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
14switches 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
15this module is an implementation. 70this module is an implementation.
16 71
17In addition to Porttracker, the PortIQ product is also supported, as it
18uses the same protocol.
19
20If 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
21module will be of little value to you. 73little value to you.
22 74
23This 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
24run a supported event loop. 76run a supported event loop.
25 77
26To quickly understand how this module works you should read how to 78To quickly understand how this module works you should read how to
… …
42 94
43package AnyEvent::Porttracker; 95package AnyEvent::Porttracker;
44 96
45use common::sense; 97use common::sense;
46 98
99use Carp ();
47use Scalar::Util (); 100use Scalar::Util ();
48 101
49use AnyEvent (); 102use AnyEvent ();
50use AnyEvent::Handle (); 103use AnyEvent::Handle ();
51 104
52use MIME::Base64 (); 105use MIME::Base64 ();
53use Digest::HMAC_MD6 ();
54use JSON (); 106use JSON ();
55 107
56our $VERSION = '0.0'; 108our $VERSION = 1.02;
57 109
58sub call { 110sub call {
59 my ($self, $type, @args) = @_; 111 my ($self, $type, @args) = @_;
60 112
61 $self->{$type} 113 $self->{$type}
… …
65 : () 117 : ()
66} 118}
67 119
68=item $api = new AnyEvent::Porttracker [key => value...] 120=item $api = new AnyEvent::Porttracker [key => value...]
69 121
70Creates a new porttracker API connection object and tries to connect to 122Creates a new porttracker API connection object and tries to connect
71the specified host (see below). After the connection has been established, 123to the specified host (see below). After the connection has been
72the TLS handshake (if requested) will take place, followed by a login 124established, the TLS handshake (if requested) will take place, followed
73attempt 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>,
74in 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
75shields against some man-in-the-middle attacks and avoids transferring the 128man-in-the-middle attacks and avoids transferring the password).
76password).
77 129
78It is permissible to send requests immediately after creating the object - 130It is permissible to send requests immediately after creating the object -
79they will be queued until after successful login. 131they will be queued until after successful login.
80 132
81Possible key-value pairs are: 133Possible key-value pairs are:
… …
99 151
100Enables or disables TLS (default: disables). When enabled, then the 152Enables or disables TLS (default: disables). When enabled, then the
101connection will try to handshake a TLS connection before logging in. If 153connection will try to handshake a TLS connection before logging in. If
102unsuccessful a fatal error will be raised. 154unsuccessful a fatal error will be raised.
103 155
104Since most Porttracker/PortIQ boxes will not have a sensible/verifiable 156Since most Porttracker boxes will not have a sensible/verifiable
105certificate, no attempt at verifying it will be done (which means 157certificate, no attempt at verifying it will be done (which means
106man-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
107verification 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<<
108verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode 160verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
109you wish to use. 161you wish to use.
110 162
111=item tls_ctx => $tls_ctx 163=item tls_ctx => $tls_ctx
112 164
113The L<AnyEvent::TLS> object to use. 165The L<AnyEvent::TLS> object to use. See C<tls>, above.
114
115#TODO#
116 166
117=item on_XYZ => $coderef 167=item on_XYZ => $coderef
118 168
119You can specify event callbacks either by subclassing and overriding the 169You can specify event callbacks either by sub-classing and overriding the
120respective methods or by specifying coderefs as key-value pairs when 170respective methods or by specifying code-refs as key-value pairs when
121constructing the object. 171constructing the object. You add or remove event handlers at any time with
172the C<event> method.
122 173
123=back 174=back
124 175
125=cut 176=cut
126 177
… …
128 my $class = shift; 179 my $class = shift;
129 180
130 my $self = bless { 181 my $self = bless {
131 id => "a", 182 id => "a",
132 ids => [], 183 ids => [],
133 queue => [], # ininitially queue everything 184 queue => [], # initially queue everything
134 @_, 185 @_,
135 }, $class; 186 }, $class;
136 187
137 { 188 {
138 Scalar::Util::weaken (my $self = $self); 189 Scalar::Util::weaken (my $self = $self);
… …
249=cut 300=cut
250 301
251sub req { 302sub req {
252 my $cb = pop; 303 my $cb = pop;
253 push @_, sub { 304 push @_, sub {
254 shift 305 splice @_, 1, 1
255 or $_[0]->error ($_[1]); 306 or $_[0]->error ($_[1]);
256 307
257 &$cb 308 &$cb
258 }; 309 };
259 310
260 $_[0]{queue} 311 $_[0]{queue}
261 ? push @{ $_[0]{queue} }, [@_] 312 ? push @{ $_[0]{queue} }, [@_]
262 : &_req 313 : &_req
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]
263} 334}
264 335
265=item $api->req_failok ($type => @args, $callback->($api, $success, @reply)) 336=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
266 337
267Just like C<< ->req >>, with two differences: first, a failure will not 338Just like C<< ->req >>, with two differences: first, a failure will not
… …
274 $_[0]{queue} 345 $_[0]{queue}
275 ? push @{ $_[0]{queue} }, [@_] 346 ? push @{ $_[0]{queue} }, [@_]
276 : &_req 347 : &_req
277} 348}
278 349
350=item $api->on (XYZ => $callback)
351
352Overwrites any currently registered handler for C<on_XYZ> or
353installs a new one. Or, when C<$callback> is undef, unregisters any
354currently-registered handler.
355
356Example: replace/set the handler for C<on_discover_stop_event>.
357
358 $api->on (discover_stop_event => sub {
359 my ($api, $gid) = @_;
360 ...
361 });
362
363=cut
364
365sub on {
366 my $self = shift;
367
368 while (@_) {
369 my ($event, $cb) = splice @_, 0, 2;
370 $event =~ s/^on_//;
371
372 $self->{"on_$event"} = $cb;
373 }
374}
375
279sub on_start_tls_notify { 376sub on_start_tls_notify {
280 my ($self) = @_; 377 my ($self) = @_;
281 378
282 $self->{hdl}->starttls (connect => $self->{tls_ctx}); 379 $self->{hdl}->starttls (connect => $self->{tls_ctx});
283 $self->{tls} ||= 1; 380 $self->{tls} ||= 1;
… …
310 407
311sub _login { 408sub _login {
312 my ($self) = @_; 409 my ($self) = @_;
313 410
314 my ($auths, $nonce) = @{ delete $self->{hello} or return }; 411 my ($auths, $nonce) = @{ delete $self->{hello} or return };
412 use Data::Dump; ddx $auths;#d#
315 413
316 if (grep $_ eq "none", @$auths) { 414 if (grep $_ eq "none", @$auths) {
317 $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;
318 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 });
319 } elsif (grep $_ eq "login_cram_md6", @$auths) { 444 } elsif (grep $_ eq "login_cram_md6", @$auths) {
320 my $cc = join "", map chr 256 * rand, 0..63; 445 my $cc = join "", map chr 256 * rand, 0..63;
321 446
447 require Digest::HMAC_MD6;
448
322 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);
323 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);
324 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);
325 452
326 $cc = MIME::Base64::encode_base64 $cc; 453 $cc = MIME::Base64::encode_base64 $cc;
454 $cr = MIME::Base64::encode_base64 $cr;
327 455
328 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub { 456 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub {
329 my ($self, $ok, $msg) = @_; 457 my ($self, $ok, $msg) = @_;
330 458
331 $ok 459 $ok
332 or return call $self, on_login_failure => $msg; 460 or return call $self, on_login_failure => $msg;
333 461
334 $msg eq $sr 462 (MIME::Base64::decode_base64 $msg) eq $sr
335 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";
336 464
337 $self->_login_success ("login_cram_md6"); 465 $self->_login_success ("login_cram_md6");
338 }); 466 });
339 } elsif (grep $_ eq "login", @$auths) { 467 } elsif (grep $_ eq "login", @$auths) {
… …
379 507
380 $msg =~ s/\n$//; 508 $msg =~ s/\n$//;
381 $self->error ("login failed: $msg"); 509 $self->error ("login failed: $msg");
382} 510}
383 511
512sub on_event_notify {
513 my ($self, $event, @args) = @_;
514
515 call $self, "on_${event}_event", @args;
516}
517
384=back 518=back
385 519
386=head2 EVENTS 520=head1 EVENTS/CALLBACKS
387 521
388AnyEvent::Porttracker conenctions are fully event-driven, and naturally 522AnyEvent::Porttracker connections are fully event-driven, and naturally
389there 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
390starting with C<on_> (example: C<on_login_failure>). 524starting with C<on_> (example: C<on_login_failure>).
391 525
392Programs can catch these events in two ways: either by providing 526Programs can catch these events in two ways: either by providing
393constructor 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:
394 528
395 my $api = new AnyEvent::Porttracker 529 my $api = new AnyEvent::Porttracker
396 host => ..., 530 host => ...,
397 user => ..., pass => ..., 531 user => ..., pass => ...,
398 on_error => sub { 532 on_error => sub {
… …
400 warn $msg; 534 warn $msg;
401 exit 1; 535 exit 1;
402 }, 536 },
403 ; 537 ;
404 538
405Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 539Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
406same name: 540same name:
407 541
408 package MyClass; 542 package MyClass;
409 543
410 use base AnyEvent::Porttracker; 544 use base AnyEvent::Porttracker;
… …
458 592
459=item on_start_tls_notify $api 593=item on_start_tls_notify $api
460 594
461Called when the server wants to start TLS negotiation. This is used 595Called when the server wants to start TLS negotiation. This is used
462internally and - while it is possible to override it - should not be 596internally and - while it is possible to override it - should not be
463overriden. 597overridden.
598
599=item on_event_notify $api, $eventname, @args
600
601Called when the server broadcasts an event the API object is subscribed
602to. The default implementation (which should not be overridden) simply
603re-issues an "on_eventname_event" event with the @args.
464 604
465=item on_XYZ_notify $api, ... 605=item on_XYZ_notify $api, ...
466 606
467In general, any protocol notification will result in an event of the form 607In general, any protocol notification will result in an event of the form
468C<on_NOTIFICATION_notify>. 608C<on_NOTIFICATION_notify>.
469 609
610=item on_XYZ_event $api, ...
611
612Called when the server broadcasts the named (XYZ) event.
613
470=back 614=back
471 615
472=head1 SEE ALSO 616=head1 SEE ALSO
473 617
474L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 618L<AnyEvent>, L<http://www.porttracker.com/>.
475 619
476=head1 AUTHOR 620=head1 AUTHOR
477 621
478 Marc Lehmann <marc@porttracker.net> 622 Marc Lehmann <marc@nethype.de>
479 623
480=cut 624=cut
481 625
4821 6261

Diff Legend

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