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.4 by root, Mon Nov 15 20:41:17 2010 UTC vs.
Revision 1.17 by root, Mon Mar 11 08:43:53 2013 UTC

… …
3AnyEvent::Porttracker - Porttracker/PortIQ API client interface. 3AnyEvent::Porttracker - Porttracker/PortIQ 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
… …
25 80
26To quickly understand how this module works you should read how to 81To quickly understand how this module works you should read how to
27construct a new connection object and then read about the event/callback 82construct a new connection object and then read about the event/callback
28system. 83system.
29 84
85The actual low-level protocol and, more importantly, the existing
86requests and responses, are documented in the official Porttracker
87API documentation (a copy of which is included in this module as
88L<AnyEvent::Porttracker::protocol>.
89
30=head1 THE AnyEvent::Porttracker CLASS 90=head1 THE AnyEvent::Porttracker CLASS
31 91
32The AnyEvent::Porttracker class represents a single connection. 92The AnyEvent::Porttracker class represents a single connection.
33 93
34=over 4 94=over 4
… …
37 97
38package AnyEvent::Porttracker; 98package AnyEvent::Porttracker;
39 99
40use common::sense; 100use common::sense;
41 101
102use Carp ();
42use Scalar::Util (); 103use Scalar::Util ();
43 104
44use AnyEvent (); 105use AnyEvent ();
45use AnyEvent::Handle (); 106use AnyEvent::Handle ();
46 107
47use MIME::Base64 (); 108use MIME::Base64 ();
48use Digest::HMAC_MD6 (); 109use Digest::HMAC_MD6 ();
49use JSON (); 110use JSON ();
50 111
51our $VERSION = '0.0'; 112our $VERSION = '1.01';
52 113
53sub call { 114sub call {
54 my ($self, $type, @args) = @_; 115 my ($self, $type, @args) = @_;
55 116
56 $self->{$type} 117 $self->{$type}
… …
88=item user => $string, pass => $string 149=item user => $string, pass => $string
89 150
90These are the username and password to use when authentication is required 151These are the username and password to use when authentication is required
91(which it is in almost all cases, so these keys are normally mandatory). 152(which it is in almost all cases, so these keys are normally mandatory).
92 153
93=item tls => ... 154=item tls => $bool
94 155
95#TODO# 156Enables or disables TLS (default: disables). When enabled, then the
157connection will try to handshake a TLS connection before logging in. If
158unsuccessful a fatal error will be raised.
159
160Since most Porttracker/PortIQ boxes will not have a sensible/verifiable
161certificate, no attempt at verifying it will be done (which means
162man-in-the-middle-attacks will be trivial). If you want some form of
163verification you need to provide your own C<tls_ctx> object with C<<
164verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
165you wish to use.
166
167=item tls_ctx => $tls_ctx
168
169The L<AnyEvent::TLS> object to use. See C<tls>, above.
96 170
97=item on_XYZ => $coderef 171=item on_XYZ => $coderef
98 172
99You can specify event callbacks either by subclassing and overriding the 173You can specify event callbacks either by sub-classing and overriding the
100respective methods or by specifying coderefs as key-value pairs when 174respective methods or by specifying code-refs as key-value pairs when
101constructing the object. 175constructing the object. You add or remove event handlers at any time with
176the C<event> method.
102 177
103=back 178=back
104 179
105=cut 180=cut
106 181
… …
108 my $class = shift; 183 my $class = shift;
109 184
110 my $self = bless { 185 my $self = bless {
111 id => "a", 186 id => "a",
112 ids => [], 187 ids => [],
113 queue => [], # ininitially queue everything 188 queue => [], # initially queue everything
114 @_, 189 @_,
115 }, $class; 190 }, $class;
116 191
117 { 192 {
118 Scalar::Util::weaken (my $self = $self); 193 Scalar::Util::weaken (my $self = $self);
119 194
120 $self->{hdl} = new AnyEvent::Handle 195 $self->{hdl} = new AnyEvent::Handle
121 connect => [$self->{host}, $self->{port} || "porttracker=55"], 196 connect => [$self->{host}, $self->{port} || "porttracker=55"],
122 on_error => sub { 197 on_error => sub {
123 $self->error (); 198 $self->error ($_[2]);
124 }, 199 },
125 on_connect => sub { 200 on_connect => sub {
126 if ($self->{tls}) { 201 if ($self->{tls}) {
127 $self->_req (start_tls => sub { 202 $self->_req (start_tls => sub {
128 $_[1] 203 $_[1]
… …
164} 239}
165 240
166sub error { 241sub error {
167 my ($self, $msg) = @_; 242 my ($self, $msg) = @_;
168 243
169 call on_error => $msg; 244 call $self, on_error => $msg;
170 245
171 () 246 ()
172} 247}
173 248
174sub _req { 249sub _req {
… …
183 my $msg = JSON::encode_json \@_; 258 my $msg = JSON::encode_json \@_;
184 259
185 $self->{hdl}->push_write ($msg); 260 $self->{hdl}->push_write ($msg);
186} 261}
187 262
188=item $api->req ($type => @args, $callback->($api, @args)) 263=item $api->req ($type => @args, $callback->($api, @reply))
189 264
190Sends a generic request of type C<$type> to the server. When the server 265Sends a generic request of type C<$type> to the server. When the server
191responds, the API object and the response arguments are passed to the 266responds, the API object and the response arguments (without the success
192callback, which is the last argument to this method. 267status) are passed to the callback, which is the last argument to this
268method.
269
270If the request fails, then a fatal error will be raised. If you want to
271handle failures gracefully, you need to use C<< ->req_failok >> instead.
272
273The available requests are documented in the Porttracker API
274documentation (a copy of which is included in this module as
275L<AnyEvent::Porttracker::protocol>.
193 276
194It is permissible to call this (or any other request function) at any 277It is permissible to call this (or any other request function) at any
195time, even before the connection has been established - the API object 278time, even before the connection has been established - the API object
196always waits until after login before it actually sends the requests, and 279always waits until after login before it actually sends the requests, and
197queues them until then. 280queues them until then.
… …
219 }); 302 });
220 303
221=cut 304=cut
222 305
223sub req { 306sub req {
307 my $cb = pop;
308 push @_, sub {
309 splice @_, 1, 1
310 or $_[0]->error ($_[1]);
311
312 &$cb
313 };
314
224 $_[0]{queue} 315 $_[0]{queue}
225 ? push @{ $_[0]{queue} }, [@_] 316 ? push @{ $_[0]{queue} }, [@_]
226 : &_req 317 : &_req
227} 318}
228 319
320=item @res = $api->req_sync ($type => @args)
321
322Similar to C<< ->req >>, but waits for the results of the request and on
323success, returns the values instead (without the success flag, and only
324the first value in scalar context). On failure, the method will C<croak>
325with the error message.
326
327=cut
328
329sub req_sync {
330 push @_, my $cv = AE::cv;
331 &req;
332 my ($ok, @res) = $cv->recv;
333
334 $ok
335 or Carp::croak $res[0];
336
337 wantarray ? @res : $res[0]
338}
339
340=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
341
342Just like C<< ->req >>, with two differences: first, a failure will not
343raise an error, second, the initial status reply which indicates success
344or failure is not removed before calling the callback.
345
346=cut
347
348sub req_failok {
349 $_[0]{queue}
350 ? push @{ $_[0]{queue} }, [@_]
351 : &_req
352}
353
354=item $api->on (XYZ => $callback)
355
356Overwrites any currently registered handler for C<on_XYZ> or
357installs a new one. Or, when C<$callback> is undef, unregisters any
358currently-registered handler.
359
360Example: replace/set the handler for C<on_discover_stop_event>.
361
362 $api->on (discover_stop_event => sub {
363 my ($api, $gid) = @_;
364 ...
365 });
366
367=cut
368
369sub on {
370 my $self = shift;
371
372 while (@_) {
373 my ($event, $cb) = splice @_, 0, 2;
374 $event =~ s/^on_//;
375
376 $self->{"on_$event"} = $cb;
377 }
378}
379
229sub on_start_tls_notify { 380sub on_start_tls_notify {
230 my ($self) = @_; 381 my ($self) = @_;
231 382
232 $self->{hdl}->starttls ("connect"); 383 $self->{hdl}->starttls (connect => $self->{tls_ctx});
233 $self->{tls} ||= 1; 384 $self->{tls} ||= 1;
234 385
235 $self->_login; 386 $self->_login;
236} 387}
237 388
… …
329 480
330 $msg =~ s/\n$//; 481 $msg =~ s/\n$//;
331 $self->error ("login failed: $msg"); 482 $self->error ("login failed: $msg");
332} 483}
333 484
485sub on_event_notify {
486 my ($self, $event, @args) = @_;
487
488 call $self, "on_${event}_event", @args;
489}
490
334=back 491=back
335 492
336=head2 EVENTS 493=head1 EVENTS/CALLBACKS
337 494
338AnyEvent::Porttracker conenctions are fully event-driven, and naturally 495AnyEvent::Porttracker connections are fully event-driven, and naturally
339there are a number of events that can occur. All these events have a name 496there are a number of events that can occur. All these events have a name
340starting with C<on_> (example: C<on_login_failure>). 497starting with C<on_> (example: C<on_login_failure>).
341 498
342Programs can catch these events in two ways: either by providing 499Programs can catch these events in two ways: either by providing
343constructor arguments with the event name as key and a coderef as value: 500constructor arguments with the event name as key and a code-ref as value:
344 501
345 my $api = new AnyEvent::Porttracker 502 my $api = new AnyEvent::Porttracker
346 host => ..., 503 host => ...,
347 user => ..., pass => ..., 504 user => ..., pass => ...,
348 on_error => sub { 505 on_error => sub {
… …
350 warn $msg; 507 warn $msg;
351 exit 1; 508 exit 1;
352 }, 509 },
353 ; 510 ;
354 511
355Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 512Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
356same name: 513same name:
357 514
358 package MyClass; 515 package MyClass;
359 516
360 use base AnyEvent::Porttracker; 517 use base AnyEvent::Porttracker;
… …
408 565
409=item on_start_tls_notify $api 566=item on_start_tls_notify $api
410 567
411Called when the server wants to start TLS negotiation. This is used 568Called when the server wants to start TLS negotiation. This is used
412internally and - while it is possible to override it - should not be 569internally and - while it is possible to override it - should not be
413overriden. 570overridden.
571
572=item on_event_notify $api, $eventname, @args
573
574Called when the server broadcasts an event the API object is subscribed
575to. The default implementation (which should not be overridden) simply
576re-issues an "on_eventname_event" event with the @args.
414 577
415=item on_XYZ_notify $api, ... 578=item on_XYZ_notify $api, ...
416 579
417In general, any protocol notification will result in an event of the form 580In general, any protocol notification will result in an event of the form
418C<on_NOTIFICATION_notify>. 581C<on_NOTIFICATION_notify>.
419 582
583=item on_XYZ_event $api, ...
584
585Called when the server broadcasts the named (XYZ) event.
586
420=back 587=back
421 588
422=head1 SEE ALSO 589=head1 SEE ALSO
423 590
424L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 591L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>.
425 592
426=head1 AUTHOR 593=head1 AUTHOR
427 594
428 Marc Lehmann <marc@porttracker.net> 595 Marc Lehmann <marc@nethype.de>
429 596
430=cut 597=cut
431 598
4321 5991

Diff Legend

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