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.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
… …
42 97
43package AnyEvent::Porttracker; 98package AnyEvent::Porttracker;
44 99
45use common::sense; 100use common::sense;
46 101
102use Carp ();
47use Scalar::Util (); 103use Scalar::Util ();
48 104
49use AnyEvent (); 105use AnyEvent ();
50use AnyEvent::Handle (); 106use AnyEvent::Handle ();
51 107
52use MIME::Base64 (); 108use MIME::Base64 ();
53use Digest::HMAC_MD6 (); 109use Digest::HMAC_MD6 ();
54use JSON (); 110use JSON ();
55 111
56our $VERSION = '0.0'; 112our $VERSION = '1.01';
57 113
58sub call { 114sub call {
59 my ($self, $type, @args) = @_; 115 my ($self, $type, @args) = @_;
60 116
61 $self->{$type} 117 $self->{$type}
… …
93=item user => $string, pass => $string 149=item user => $string, pass => $string
94 150
95These are the username and password to use when authentication is required 151These 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). 152(which it is in almost all cases, so these keys are normally mandatory).
97 153
98=item tls => ... 154=item tls => $bool
99 155
100#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.
101 170
102=item on_XYZ => $coderef 171=item on_XYZ => $coderef
103 172
104You can specify event callbacks either by subclassing and overriding the 173You can specify event callbacks either by sub-classing and overriding the
105respective methods or by specifying coderefs as key-value pairs when 174respective methods or by specifying code-refs as key-value pairs when
106constructing the object. 175constructing the object. You add or remove event handlers at any time with
176the C<event> method.
107 177
108=back 178=back
109 179
110=cut 180=cut
111 181
… …
113 my $class = shift; 183 my $class = shift;
114 184
115 my $self = bless { 185 my $self = bless {
116 id => "a", 186 id => "a",
117 ids => [], 187 ids => [],
118 queue => [], # ininitially queue everything 188 queue => [], # initially queue everything
119 @_, 189 @_,
120 }, $class; 190 }, $class;
121 191
122 { 192 {
123 Scalar::Util::weaken (my $self = $self); 193 Scalar::Util::weaken (my $self = $self);
124 194
125 $self->{hdl} = new AnyEvent::Handle 195 $self->{hdl} = new AnyEvent::Handle
126 connect => [$self->{host}, $self->{port} || "porttracker=55"], 196 connect => [$self->{host}, $self->{port} || "porttracker=55"],
127 on_error => sub { 197 on_error => sub {
128 $self->error (); 198 $self->error ($_[2]);
129 }, 199 },
130 on_connect => sub { 200 on_connect => sub {
131 if ($self->{tls}) { 201 if ($self->{tls}) {
132 $self->_req (start_tls => sub { 202 $self->_req (start_tls => sub {
133 $_[1] 203 $_[1]
… …
169} 239}
170 240
171sub error { 241sub error {
172 my ($self, $msg) = @_; 242 my ($self, $msg) = @_;
173 243
174 call on_error => $msg; 244 call $self, on_error => $msg;
175 245
176 () 246 ()
177} 247}
178 248
179sub _req { 249sub _req {
… …
188 my $msg = JSON::encode_json \@_; 258 my $msg = JSON::encode_json \@_;
189 259
190 $self->{hdl}->push_write ($msg); 260 $self->{hdl}->push_write ($msg);
191} 261}
192 262
193=item $api->req ($type => @args, $callback->($api, @args)) 263=item $api->req ($type => @args, $callback->($api, @reply))
194 264
195Sends 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
196responds, the API object and the response arguments are passed to the 266responds, the API object and the response arguments (without the success
197callback, 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.
198 272
199The available requests are documented in the Porttracker API 273The available requests are documented in the Porttracker API
200documentation (a copy of which is included in this module as 274documentation (a copy of which is included in this module as
201L<AnyEvent::Porttracker::protocol>. 275L<AnyEvent::Porttracker::protocol>.
202 276
… …
228 }); 302 });
229 303
230=cut 304=cut
231 305
232sub req { 306sub req {
307 my $cb = pop;
308 push @_, sub {
309 splice @_, 1, 1
310 or $_[0]->error ($_[1]);
311
312 &$cb
313 };
314
233 $_[0]{queue} 315 $_[0]{queue}
234 ? push @{ $_[0]{queue} }, [@_] 316 ? push @{ $_[0]{queue} }, [@_]
235 : &_req 317 : &_req
236} 318}
237 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
238sub on_start_tls_notify { 380sub on_start_tls_notify {
239 my ($self) = @_; 381 my ($self) = @_;
240 382
241 $self->{hdl}->starttls ("connect"); 383 $self->{hdl}->starttls (connect => $self->{tls_ctx});
242 $self->{tls} ||= 1; 384 $self->{tls} ||= 1;
243 385
244 $self->_login; 386 $self->_login;
245} 387}
246 388
… …
338 480
339 $msg =~ s/\n$//; 481 $msg =~ s/\n$//;
340 $self->error ("login failed: $msg"); 482 $self->error ("login failed: $msg");
341} 483}
342 484
485sub on_event_notify {
486 my ($self, $event, @args) = @_;
487
488 call $self, "on_${event}_event", @args;
489}
490
343=back 491=back
344 492
345=head2 EVENTS 493=head1 EVENTS/CALLBACKS
346 494
347AnyEvent::Porttracker conenctions are fully event-driven, and naturally 495AnyEvent::Porttracker connections are fully event-driven, and naturally
348there 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
349starting with C<on_> (example: C<on_login_failure>). 497starting with C<on_> (example: C<on_login_failure>).
350 498
351Programs can catch these events in two ways: either by providing 499Programs can catch these events in two ways: either by providing
352constructor 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:
353 501
354 my $api = new AnyEvent::Porttracker 502 my $api = new AnyEvent::Porttracker
355 host => ..., 503 host => ...,
356 user => ..., pass => ..., 504 user => ..., pass => ...,
357 on_error => sub { 505 on_error => sub {
… …
359 warn $msg; 507 warn $msg;
360 exit 1; 508 exit 1;
361 }, 509 },
362 ; 510 ;
363 511
364Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 512Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
365same name: 513same name:
366 514
367 package MyClass; 515 package MyClass;
368 516
369 use base AnyEvent::Porttracker; 517 use base AnyEvent::Porttracker;
… …
417 565
418=item on_start_tls_notify $api 566=item on_start_tls_notify $api
419 567
420Called when the server wants to start TLS negotiation. This is used 568Called when the server wants to start TLS negotiation. This is used
421internally and - while it is possible to override it - should not be 569internally and - while it is possible to override it - should not be
422overriden. 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.
423 577
424=item on_XYZ_notify $api, ... 578=item on_XYZ_notify $api, ...
425 579
426In 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
427C<on_NOTIFICATION_notify>. 581C<on_NOTIFICATION_notify>.
428 582
583=item on_XYZ_event $api, ...
584
585Called when the server broadcasts the named (XYZ) event.
586
429=back 587=back
430 588
431=head1 SEE ALSO 589=head1 SEE ALSO
432 590
433L<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>.
434 592
435=head1 AUTHOR 593=head1 AUTHOR
436 594
437 Marc Lehmann <marc@porttracker.net> 595 Marc Lehmann <marc@nethype.de>
438 596
439=cut 597=cut
440 598
4411 5991

Diff Legend

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