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

Diff Legend

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