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.5 by root, Mon Nov 15 20:43:11 2010 UTC vs.
Revision 1.18 by root, Wed Jan 7 01:41:33 2015 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 (); 106use Digest::HMAC_MD6 ();
54use JSON (); 107use JSON ();
55 108
56our $VERSION = '0.0'; 109our $VERSION = '1.01';
57 110
58sub call { 111sub call {
59 my ($self, $type, @args) = @_; 112 my ($self, $type, @args) = @_;
60 113
61 $self->{$type} 114 $self->{$type}
93=item user => $string, pass => $string 146=item user => $string, pass => $string
94 147
95These are the username and password to use when authentication is required 148These are the username and password to use when authentication is required
96(which it is in almost all cases, so these keys are normally mandatory). 149(which it is in almost all cases, so these keys are normally mandatory).
97 150
98=item tls => ... 151=item tls => $bool
99 152
100#TODO# 153Enables or disables TLS (default: disables). When enabled, then the
154connection will try to handshake a TLS connection before logging in. If
155unsuccessful a fatal error will be raised.
156
157Since most Porttracker boxes will not have a sensible/verifiable
158certificate, no attempt at verifying it will be done (which means
159man-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<<
161verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
162you wish to use.
163
164=item tls_ctx => $tls_ctx
165
166The L<AnyEvent::TLS> object to use. See C<tls>, above.
101 167
102=item on_XYZ => $coderef 168=item on_XYZ => $coderef
103 169
104You can specify event callbacks either by subclassing and overriding the 170You can specify event callbacks either by sub-classing and overriding the
105respective methods or by specifying coderefs as key-value pairs when 171respective methods or by specifying code-refs as key-value pairs when
106constructing the object. 172constructing the object. You add or remove event handlers at any time with
173the C<event> method.
107 174
108=back 175=back
109 176
110=cut 177=cut
111 178
113 my $class = shift; 180 my $class = shift;
114 181
115 my $self = bless { 182 my $self = bless {
116 id => "a", 183 id => "a",
117 ids => [], 184 ids => [],
118 queue => [], # ininitially queue everything 185 queue => [], # initially queue everything
119 @_, 186 @_,
120 }, $class; 187 }, $class;
121 188
122 { 189 {
123 Scalar::Util::weaken (my $self = $self); 190 Scalar::Util::weaken (my $self = $self);
124 191
125 $self->{hdl} = new AnyEvent::Handle 192 $self->{hdl} = new AnyEvent::Handle
126 connect => [$self->{host}, $self->{port} || "porttracker=55"], 193 connect => [$self->{host}, $self->{port} || "porttracker=55"],
127 on_error => sub { 194 on_error => sub {
128 $self->error (); 195 $self->error ($_[2]);
129 }, 196 },
130 on_connect => sub { 197 on_connect => sub {
131 if ($self->{tls}) { 198 if ($self->{tls}) {
132 $self->_req (start_tls => sub { 199 $self->_req (start_tls => sub {
133 $_[1] 200 $_[1]
169} 236}
170 237
171sub error { 238sub error {
172 my ($self, $msg) = @_; 239 my ($self, $msg) = @_;
173 240
174 call on_error => $msg; 241 call $self, on_error => $msg;
175 242
176 () 243 ()
177} 244}
178 245
179sub _req { 246sub _req {
188 my $msg = JSON::encode_json \@_; 255 my $msg = JSON::encode_json \@_;
189 256
190 $self->{hdl}->push_write ($msg); 257 $self->{hdl}->push_write ($msg);
191} 258}
192 259
193=item $api->req ($type => @args, $callback->($api, @args)) 260=item $api->req ($type => @args, $callback->($api, @reply))
194 261
195Sends a generic request of type C<$type> to the server. When the server 262Sends a generic request of type C<$type> to the server. When the server
196responds, the API object and the response arguments are passed to the 263responds, the API object and the response arguments (without the success
197callback, which is the last argument to this method. 264status) are passed to the callback, which is the last argument to this
265method.
266
267If the request fails, then a fatal error will be raised. If you want to
268handle failures gracefully, you need to use C<< ->req_failok >> instead.
198 269
199The available requests are documented in the Porttracker API 270The available requests are documented in the Porttracker API
200documentation (a copy of which is included in this module as 271documentation (a copy of which is included in this module as
201L<AnyEvent::Porttracker::protocol>. 272L<AnyEvent::Porttracker::protocol>.
202 273
228 }); 299 });
229 300
230=cut 301=cut
231 302
232sub req { 303sub req {
304 my $cb = pop;
305 push @_, sub {
306 splice @_, 1, 1
307 or $_[0]->error ($_[1]);
308
309 &$cb
310 };
311
233 $_[0]{queue} 312 $_[0]{queue}
234 ? push @{ $_[0]{queue} }, [@_] 313 ? push @{ $_[0]{queue} }, [@_]
235 : &_req 314 : &_req
236} 315}
237 316
317=item @res = $api->req_sync ($type => @args)
318
319Similar to C<< ->req >>, but waits for the results of the request and on
320success, returns the values instead (without the success flag, and only
321the first value in scalar context). On failure, the method will C<croak>
322with the error message.
323
324=cut
325
326sub req_sync {
327 push @_, my $cv = AE::cv;
328 &req;
329 my ($ok, @res) = $cv->recv;
330
331 $ok
332 or Carp::croak $res[0];
333
334 wantarray ? @res : $res[0]
335}
336
337=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
338
339Just like C<< ->req >>, with two differences: first, a failure will not
340raise an error, second, the initial status reply which indicates success
341or failure is not removed before calling the callback.
342
343=cut
344
345sub req_failok {
346 $_[0]{queue}
347 ? push @{ $_[0]{queue} }, [@_]
348 : &_req
349}
350
351=item $api->on (XYZ => $callback)
352
353Overwrites any currently registered handler for C<on_XYZ> or
354installs a new one. Or, when C<$callback> is undef, unregisters any
355currently-registered handler.
356
357Example: replace/set the handler for C<on_discover_stop_event>.
358
359 $api->on (discover_stop_event => sub {
360 my ($api, $gid) = @_;
361 ...
362 });
363
364=cut
365
366sub on {
367 my $self = shift;
368
369 while (@_) {
370 my ($event, $cb) = splice @_, 0, 2;
371 $event =~ s/^on_//;
372
373 $self->{"on_$event"} = $cb;
374 }
375}
376
238sub on_start_tls_notify { 377sub on_start_tls_notify {
239 my ($self) = @_; 378 my ($self) = @_;
240 379
241 $self->{hdl}->starttls ("connect"); 380 $self->{hdl}->starttls (connect => $self->{tls_ctx});
242 $self->{tls} ||= 1; 381 $self->{tls} ||= 1;
243 382
244 $self->_login; 383 $self->_login;
245} 384}
246 385
338 477
339 $msg =~ s/\n$//; 478 $msg =~ s/\n$//;
340 $self->error ("login failed: $msg"); 479 $self->error ("login failed: $msg");
341} 480}
342 481
482sub on_event_notify {
483 my ($self, $event, @args) = @_;
484
485 call $self, "on_${event}_event", @args;
486}
487
343=back 488=back
344 489
345=head2 EVENTS 490=head1 EVENTS/CALLBACKS
346 491
347AnyEvent::Porttracker conenctions are fully event-driven, and naturally 492AnyEvent::Porttracker connections are fully event-driven, and naturally
348there are a number of events that can occur. All these events have a name 493there are a number of events that can occur. All these events have a name
349starting with C<on_> (example: C<on_login_failure>). 494starting with C<on_> (example: C<on_login_failure>).
350 495
351Programs can catch these events in two ways: either by providing 496Programs can catch these events in two ways: either by providing
352constructor arguments with the event name as key and a coderef as value: 497constructor arguments with the event name as key and a code-ref as value:
353 498
354 my $api = new AnyEvent::Porttracker 499 my $api = new AnyEvent::Porttracker
355 host => ..., 500 host => ...,
356 user => ..., pass => ..., 501 user => ..., pass => ...,
357 on_error => sub { 502 on_error => sub {
359 warn $msg; 504 warn $msg;
360 exit 1; 505 exit 1;
361 }, 506 },
362 ; 507 ;
363 508
364Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 509Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
365same name: 510same name:
366 511
367 package MyClass; 512 package MyClass;
368 513
369 use base AnyEvent::Porttracker; 514 use base AnyEvent::Porttracker;
417 562
418=item on_start_tls_notify $api 563=item on_start_tls_notify $api
419 564
420Called when the server wants to start TLS negotiation. This is used 565Called when the server wants to start TLS negotiation. This is used
421internally and - while it is possible to override it - should not be 566internally and - while it is possible to override it - should not be
422overriden. 567overridden.
568
569=item on_event_notify $api, $eventname, @args
570
571Called when the server broadcasts an event the API object is subscribed
572to. The default implementation (which should not be overridden) simply
573re-issues an "on_eventname_event" event with the @args.
423 574
424=item on_XYZ_notify $api, ... 575=item on_XYZ_notify $api, ...
425 576
426In general, any protocol notification will result in an event of the form 577In general, any protocol notification will result in an event of the form
427C<on_NOTIFICATION_notify>. 578C<on_NOTIFICATION_notify>.
428 579
580=item on_XYZ_event $api, ...
581
582Called when the server broadcasts the named (XYZ) event.
583
429=back 584=back
430 585
431=head1 SEE ALSO 586=head1 SEE ALSO
432 587
433L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 588L<AnyEvent>, L<http://www.porttracker.com/>.
434 589
435=head1 AUTHOR 590=head1 AUTHOR
436 591
437 Marc Lehmann <marc@porttracker.net> 592 Marc Lehmann <marc@nethype.de>
438 593
439=cut 594=cut
440 595
4411 5961

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines