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.3 by root, Mon Nov 15 19:49:36 2010 UTC vs.
Revision 1.15 by root, Fri May 20 22:57:52 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.0';
52 110
53sub call { 111sub call {
54 my ($self, $type, @args) = @_; 112 my ($self, $type, @args) = @_;
55 113
56 $self->{$type} 114 $self->{$type}
… …
58 : ($type = (UNIVERSAL::can $self, $type)) 116 : ($type = (UNIVERSAL::can $self, $type))
59 ? $type->($self, @args) 117 ? $type->($self, @args)
60 : () 118 : ()
61} 119}
62 120
63=item new AnyEvent::Porttracker [key => value...] 121=item $api = new AnyEvent::Porttracker [key => value...]
64 122
65Creates a new porttracker API connection object and tries to connect to 123Creates a new porttracker API connection object and tries to connect to
66the specified host (see below). After the connection has been established, 124the specified host (see below). After the connection has been established,
67the TLS handshake (if requested) will take place, followed by a login 125the TLS handshake (if requested) will take place, followed by a login
68attempt using either the C<none>, C<login_cram_md6> or C<login> methods, 126attempt using either the C<none>, C<login_cram_md6> or C<login> methods,
… …
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
107sub new { 179sub new {
108 my $class = shift; 180 my $class = shift;
109 181
110 my $self = bless { 182 my $self = bless {
111 id => "a", 183 id => "a",
184 ids => [],
112 queue => [], # ininitially queue everything 185 queue => [], # initially queue everything
113 @_, 186 @_,
114 }, $class; 187 }, $class;
115 188
116 { 189 {
117 Scalar::Util::weaken (my $self = $self); 190 Scalar::Util::weaken (my $self = $self);
118 191
119 $self->{hdl} = new AnyEvent::Handle 192 $self->{hdl} = new AnyEvent::Handle
120 connect => [$self->{host}, $self->{port} || "porttracker=55"], 193 connect => [$self->{host}, $self->{port} || "porttracker=55"],
121 on_error => sub { 194 on_error => sub {
122 $self->error (); 195 $self->error ($_[2]);
123 }, 196 },
124 on_connect => sub { 197 on_connect => sub {
125 if ($self->{tls}) { 198 if ($self->{tls}) {
126 $self->_req (start_tls => sub { 199 $self->_req (start_tls => sub {
127 $_[1] 200 $_[1]
… …
137 my $id = shift @$msg; 210 my $id = shift @$msg;
138 211
139 if (defined $id) { 212 if (defined $id) {
140 my $cb = delete $self->{cb}{$id} 213 my $cb = delete $self->{cb}{$id}
141 or return $self->error ("received unexpected reply msg with id $id"); 214 or return $self->error ("received unexpected reply msg with id $id");
215
216 push @{ $self->{ids} }, $id;
142 217
143 $cb->($self, @$msg); 218 $cb->($self, @$msg);
144 } else { 219 } else {
145 $msg->[0] = "on_$msg->[0]_notify"; 220 $msg->[0] = "on_$msg->[0]_notify";
146 call $self, @$msg; 221 call $self, @$msg;
… …
161} 236}
162 237
163sub error { 238sub error {
164 my ($self, $msg) = @_; 239 my ($self, $msg) = @_;
165 240
166 call on_error => $msg; 241 call $self, on_error => $msg;
167 242
168 () 243 ()
169} 244}
170 245
171sub _req { 246sub _req {
172 my $self = shift; 247 my $self = shift;
173 my $cb = pop; 248 my $cb = pop;
174 249
175 my $id = ++$self->{id}; 250 my $id = (pop @{ $self->{ids} }) || $self->{id}++;
176 251
177 unshift @_, $id; 252 unshift @_, $id;
178 $self->{cb}{$id} = $cb; 253 $self->{cb}{$id} = $cb;
179 254
180 my $msg = JSON::encode_json \@_; 255 my $msg = JSON::encode_json \@_;
181 256
182 $self->{hdl}->push_write ($msg); 257 $self->{hdl}->push_write ($msg);
183} 258}
184 259
260=item $api->req ($type => @args, $callback->($api, @reply))
261
262Sends a generic request of type C<$type> to the server. When the server
263responds, the API object and the response arguments (without the success
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>.
273
274It is permissible to call this (or any other request function) at any
275time, even before the connection has been established - the API object
276always waits until after login before it actually sends the requests, and
277queues them until then.
278
279Example: ping the porttracker server.
280
281 $api->req ("ping", sub {
282 my ($api, $ok, $timestamp, $pid) = @_;
283 ...
284 });
285
286Example: determine the product ID.
287
288 $api->req (product_id => sub {
289 my ($api, $ok, $branding, $product_id) = @_;
290 ...
291 });
292
293Example: set a new license.
294
295 $api->req (set_license => $LICENSE_STRING, sub {
296 my ($api, $ok) = @_;
297
298 $ok or die "failed to set license";
299 });
300
301=cut
302
185sub req { 303sub req {
304 my $cb = pop;
305 push @_, sub {
306 splice @_, 1, 1
307 or $_[0]->error ($_[1]);
308
309 &$cb
310 };
311
186 $_[0]{queue} 312 $_[0]{queue}
187 ? push @{ $_[0]{queue} }, [@_] 313 ? push @{ $_[0]{queue} }, [@_]
188 : &_req 314 : &_req
189} 315}
190 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
191sub on_start_tls_notify { 377sub on_start_tls_notify {
192 my ($self) = @_; 378 my ($self) = @_;
193 379
194 $self->{hdl}->starttls ("connect"); 380 $self->{hdl}->starttls (connect => $self->{tls_ctx});
195 $self->{tls} ||= 1; 381 $self->{tls} ||= 1;
196 382
197 $self->_login; 383 $self->_login;
198} 384}
199 385
… …
291 477
292 $msg =~ s/\n$//; 478 $msg =~ s/\n$//;
293 $self->error ("login failed: $msg"); 479 $self->error ("login failed: $msg");
294} 480}
295 481
482sub on_event_notify {
483 my ($self, $event, @args) = @_;
484
485 call $self, "on_${event}_event", @args;
486}
487
296=back 488=back
297 489
298=head2 EVENTS 490=head1 EVENTS/CALLBACKS
299 491
300AnyEvent::Porttracker conenctions are fully event-driven, and naturally 492AnyEvent::Porttracker connections are fully event-driven, and naturally
301there 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
302starting with C<on_> (example: C<on_login_failure>). 494starting with C<on_> (example: C<on_login_failure>).
303 495
304Programs can catch these events in two ways: either by providing 496Programs can catch these events in two ways: either by providing
305constructor 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:
306 498
307 my $api = new AnyEvent::Porttracker 499 my $api = new AnyEvent::Porttracker
308 host => ..., 500 host => ...,
309 user => ..., pass => ..., 501 user => ..., pass => ...,
310 on_error => sub { 502 on_error => sub {
… …
312 warn $msg; 504 warn $msg;
313 exit 1; 505 exit 1;
314 }, 506 },
315 ; 507 ;
316 508
317Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 509Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
318same name: 510same name:
319 511
320 package MyClass; 512 package MyClass;
321 513
322 use base AnyEvent::Porttracker; 514 use base AnyEvent::Porttracker;
… …
370 562
371=item on_start_tls_notify $api 563=item on_start_tls_notify $api
372 564
373Called when the server wants to start TLS negotiation. This is used 565Called when the server wants to start TLS negotiation. This is used
374internally and - while it is possible to override it - should not be 566internally and - while it is possible to override it - should not be
375overriden. 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.
376 574
377=item on_XYZ_notify $api, ... 575=item on_XYZ_notify $api, ...
378 576
379In 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
380C<on_NOTIFICATION_notify>. 578C<on_NOTIFICATION_notify>.
381 579
580=item on_XYZ_event $api, ...
581
582Called when the server broadcasts the named (XYZ) event.
583
382=back 584=back
383 585
384=head1 SEE ALSO 586=head1 SEE ALSO
385 587
386L<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>.

Diff Legend

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