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.16 by root, Thu Jun 2 01:27:46 2011 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 ;
15
16 # Example 1
17 # a simple request: ping the server synchronously
18
19 my ($timestamp, $pid) = $api->req_sync ("ping");
20
21 # Example 2
22 # find all realms, start a discovery on all of them
23 # and wait until all discovery processes have finished
24 # but execute individual discoveries in parallel,
25 # asynchronously
26
27 my $cv = AE::cv;
28
29 $cv->begin;
30 # find all realms
31 $api->req (realm_info => ["gid", "name"], sub {
32 my ($api, @realms) = @_;
33
34 # start discovery on all realms
35 for my $realm (@realms) {
36 my ($gid, $name) = @$realm;
37
38 $cv->begin;
39 $api->req (realm_discover => $gid, sub {
40 warn "discovery for realm '$name' finished\n";
41 $cv->end;
42 });
43 }
44
45 $cv->end;
46 });
47
48 $cv->recv;
49
50 # Example 3
51 # subscribe to realm_poll_stop events and report each occurance
52
53 $api->req (subscribe => "realm_poll_stop", sub {});
54 $api->on (realm_poll_stop_event => sub {
55 my ($api, $gid) = @_;
56 warn "this just in: poll for realm <$gid> finished.\n";
57 });
58
59 AE::cv->recv; # wait forever
8 60
9=head1 DESCRIPTION 61=head1 DESCRIPTION
10 62
11Porttracker (L<http://www.porttracker.com/>) is a product that (among 63Porttracker (L<http://www.porttracker.com/>) is a product that (among
12other things) scans switches and routers in a network and gives a coherent 64other things) scans switches and routers in a network and gives a coherent
… …
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
27construct a new connection object and then read about the event/callback 79construct a new connection object and then read about the event/callback
28system. 80system.
29 81
82The actual low-level protocol and, more importantly, the existing
83requests and responses, are documented in the official Porttracker
84API documentation (a copy of which is included in this module as
85L<AnyEvent::Porttracker::protocol>.
86
30=head1 THE AnyEvent::Porttracker CLASS 87=head1 THE AnyEvent::Porttracker CLASS
31 88
32The AnyEvent::Porttracker class represents a single connection. 89The AnyEvent::Porttracker class represents a single connection.
33 90
34=over 4 91=over 4
… …
37 94
38package AnyEvent::Porttracker; 95package AnyEvent::Porttracker;
39 96
40use common::sense; 97use common::sense;
41 98
99use Carp ();
42use Scalar::Util (); 100use Scalar::Util ();
43 101
44use AnyEvent (); 102use AnyEvent ();
45use AnyEvent::Handle (); 103use AnyEvent::Handle ();
46 104
47use MIME::Base64 (); 105use MIME::Base64 ();
48use Digest::HMAC_MD6 (); 106use Digest::HMAC_MD6 ();
49use JSON (); 107use JSON ();
50 108
51our $VERSION = '0.0'; 109our $VERSION = '1.01';
52 110
53sub call { 111sub call {
54 my ($self, $type, @args) = @_; 112 my ($self, $type, @args) = @_;
55 113
56 $self->{$type} 114 $self->{$type}
… …
88=item user => $string, pass => $string 146=item user => $string, pass => $string
89 147
90These are the username and password to use when authentication is required 148These 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). 149(which it is in almost all cases, so these keys are normally mandatory).
92 150
93=item tls => ... 151=item tls => $bool
94 152
95#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/PortIQ 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.
96 167
97=item on_XYZ => $coderef 168=item on_XYZ => $coderef
98 169
99You can specify event callbacks either by subclassing and overriding the 170You can specify event callbacks either by sub-classing and overriding the
100respective methods or by specifying coderefs as key-value pairs when 171respective methods or by specifying code-refs as key-value pairs when
101constructing the object. 172constructing the object. You add or remove event handlers at any time with
173the C<event> method.
102 174
103=back 175=back
104 176
105=cut 177=cut
106 178
… …
108 my $class = shift; 180 my $class = shift;
109 181
110 my $self = bless { 182 my $self = bless {
111 id => "a", 183 id => "a",
112 ids => [], 184 ids => [],
113 queue => [], # ininitially queue everything 185 queue => [], # initially queue everything
114 @_, 186 @_,
115 }, $class; 187 }, $class;
116 188
117 { 189 {
118 Scalar::Util::weaken (my $self = $self); 190 Scalar::Util::weaken (my $self = $self);
119 191
120 $self->{hdl} = new AnyEvent::Handle 192 $self->{hdl} = new AnyEvent::Handle
121 connect => [$self->{host}, $self->{port} || "porttracker=55"], 193 connect => [$self->{host}, $self->{port} || "porttracker=55"],
122 on_error => sub { 194 on_error => sub {
123 $self->error (); 195 $self->error ($_[2]);
124 }, 196 },
125 on_connect => sub { 197 on_connect => sub {
126 if ($self->{tls}) { 198 if ($self->{tls}) {
127 $self->_req (start_tls => sub { 199 $self->_req (start_tls => sub {
128 $_[1] 200 $_[1]
… …
164} 236}
165 237
166sub error { 238sub error {
167 my ($self, $msg) = @_; 239 my ($self, $msg) = @_;
168 240
169 call on_error => $msg; 241 call $self, on_error => $msg;
170 242
171 () 243 ()
172} 244}
173 245
174sub _req { 246sub _req {
… …
183 my $msg = JSON::encode_json \@_; 255 my $msg = JSON::encode_json \@_;
184 256
185 $self->{hdl}->push_write ($msg); 257 $self->{hdl}->push_write ($msg);
186} 258}
187 259
188=item $api->req ($type => @args, $callback->($api, @args)) 260=item $api->req ($type => @args, $callback->($api, @reply))
189 261
190Sends 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
191responds, the API object and the response arguments are passed to the 263responds, the API object and the response arguments (without the success
192callback, 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.
269
270The available requests are documented in the Porttracker API
271documentation (a copy of which is included in this module as
272L<AnyEvent::Porttracker::protocol>.
193 273
194It is permissible to call this (or any other request function) at any 274It is permissible to call this (or any other request function) at any
195time, even before the connection has been established - the API object 275time, even before the connection has been established - the API object
196always waits until after login before it actually sends the requests, and 276always waits until after login before it actually sends the requests, and
197queues them until then. 277queues them until then.
… …
219 }); 299 });
220 300
221=cut 301=cut
222 302
223sub req { 303sub req {
304 my $cb = pop;
305 push @_, sub {
306 splice @_, 1, 1
307 or $_[0]->error ($_[1]);
308
309 &$cb
310 };
311
224 $_[0]{queue} 312 $_[0]{queue}
225 ? push @{ $_[0]{queue} }, [@_] 313 ? push @{ $_[0]{queue} }, [@_]
226 : &_req 314 : &_req
227} 315}
228 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
229sub on_start_tls_notify { 377sub on_start_tls_notify {
230 my ($self) = @_; 378 my ($self) = @_;
231 379
232 $self->{hdl}->starttls ("connect"); 380 $self->{hdl}->starttls (connect => $self->{tls_ctx});
233 $self->{tls} ||= 1; 381 $self->{tls} ||= 1;
234 382
235 $self->_login; 383 $self->_login;
236} 384}
237 385
… …
329 477
330 $msg =~ s/\n$//; 478 $msg =~ s/\n$//;
331 $self->error ("login failed: $msg"); 479 $self->error ("login failed: $msg");
332} 480}
333 481
482sub on_event_notify {
483 my ($self, $event, @args) = @_;
484
485 call $self, "on_${event}_event", @args;
486}
487
334=back 488=back
335 489
336=head2 EVENTS 490=head1 EVENTS/CALLBACKS
337 491
338AnyEvent::Porttracker conenctions are fully event-driven, and naturally 492AnyEvent::Porttracker connections are fully event-driven, and naturally
339there 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
340starting with C<on_> (example: C<on_login_failure>). 494starting with C<on_> (example: C<on_login_failure>).
341 495
342Programs can catch these events in two ways: either by providing 496Programs can catch these events in two ways: either by providing
343constructor 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:
344 498
345 my $api = new AnyEvent::Porttracker 499 my $api = new AnyEvent::Porttracker
346 host => ..., 500 host => ...,
347 user => ..., pass => ..., 501 user => ..., pass => ...,
348 on_error => sub { 502 on_error => sub {
… …
350 warn $msg; 504 warn $msg;
351 exit 1; 505 exit 1;
352 }, 506 },
353 ; 507 ;
354 508
355Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 509Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
356same name: 510same name:
357 511
358 package MyClass; 512 package MyClass;
359 513
360 use base AnyEvent::Porttracker; 514 use base AnyEvent::Porttracker;
… …
408 562
409=item on_start_tls_notify $api 563=item on_start_tls_notify $api
410 564
411Called when the server wants to start TLS negotiation. This is used 565Called when the server wants to start TLS negotiation. This is used
412internally and - while it is possible to override it - should not be 566internally and - while it is possible to override it - should not be
413overriden. 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.
414 574
415=item on_XYZ_notify $api, ... 575=item on_XYZ_notify $api, ...
416 576
417In 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
418C<on_NOTIFICATION_notify>. 578C<on_NOTIFICATION_notify>.
419 579
580=item on_XYZ_event $api, ...
581
582Called when the server broadcasts the named (XYZ) event.
583
420=back 584=back
421 585
422=head1 SEE ALSO 586=head1 SEE ALSO
423 587
424L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 588L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>.
425 589
426=head1 AUTHOR 590=head1 AUTHOR
427 591
428 Marc Lehmann <marc@porttracker.net> 592 Marc Lehmann <marc@nethype.de>
429 593
430=cut 594=cut
431 595
4321 5961

Diff Legend

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