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.8 by root, Tue Nov 16 01:22:03 2010 UTC

… …
24run a supported event loop. 24run a supported event loop.
25 25
26To quickly understand how this module works you should read how to 26To quickly understand how this module works you should read how to
27construct a new connection object and then read about the event/callback 27construct a new connection object and then read about the event/callback
28system. 28system.
29
30The actual low-level protocol and, more importantly, the existing
31requests and responses, are documented in the official Porttracker
32API documentation (a copy of which is included in this module as
33L<AnyEvent::Porttracker::protocol>.
29 34
30=head1 THE AnyEvent::Porttracker CLASS 35=head1 THE AnyEvent::Porttracker CLASS
31 36
32The AnyEvent::Porttracker class represents a single connection. 37The AnyEvent::Porttracker class represents a single connection.
33 38
… …
88=item user => $string, pass => $string 93=item user => $string, pass => $string
89 94
90These are the username and password to use when authentication is required 95These 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). 96(which it is in almost all cases, so these keys are normally mandatory).
92 97
93=item tls => ... 98=item tls => $bool
99
100Enables or disables TLS (default: disables). When enabled, then the
101connection will try to handshake a TLS connection before logging in. If
102unsuccessful a fatal error will be raised.
103
104Since most Porttracker/PortIQ boxes will not have a sensible/verifiable
105certificate, no attempt at verifying it will be done (which means
106man-in-the-middle-attacks will be trivial). If you want some form of
107verification you need to provide your own C<tls_ctx> object with C<<
108verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
109you wish to use.
110
111=item tls_ctx => $tls_ctx
112
113The L<AnyEvent::TLS> object to use.
94 114
95#TODO# 115#TODO#
96 116
97=item on_XYZ => $coderef 117=item on_XYZ => $coderef
98 118
… …
118 Scalar::Util::weaken (my $self = $self); 138 Scalar::Util::weaken (my $self = $self);
119 139
120 $self->{hdl} = new AnyEvent::Handle 140 $self->{hdl} = new AnyEvent::Handle
121 connect => [$self->{host}, $self->{port} || "porttracker=55"], 141 connect => [$self->{host}, $self->{port} || "porttracker=55"],
122 on_error => sub { 142 on_error => sub {
123 $self->error (); 143 $self->error ($_[2]);
124 }, 144 },
125 on_connect => sub { 145 on_connect => sub {
126 if ($self->{tls}) { 146 if ($self->{tls}) {
127 $self->_req (start_tls => sub { 147 $self->_req (start_tls => sub {
128 $_[1] 148 $_[1]
… …
164} 184}
165 185
166sub error { 186sub error {
167 my ($self, $msg) = @_; 187 my ($self, $msg) = @_;
168 188
169 call on_error => $msg; 189 call $self, on_error => $msg;
170 190
171 () 191 ()
172} 192}
173 193
174sub _req { 194sub _req {
… …
183 my $msg = JSON::encode_json \@_; 203 my $msg = JSON::encode_json \@_;
184 204
185 $self->{hdl}->push_write ($msg); 205 $self->{hdl}->push_write ($msg);
186} 206}
187 207
188=item $api->req ($type => @args, $callback->($api, @args)) 208=item $api->req ($type => @args, $callback->($api, @reply))
189 209
190Sends a generic request of type C<$type> to the server. When the server 210Sends 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 211responds, the API object and the response arguments (without the success
192callback, which is the last argument to this method. 212status) are passed to the callback, which is the last argument to this
213method.
214
215If the request fails, then a fatal error will be raised. If you want to
216handle failures gracefully, you need to use C<< ->req_failok >> instead.
217
218The available requests are documented in the Porttracker API
219documentation (a copy of which is included in this module as
220L<AnyEvent::Porttracker::protocol>.
193 221
194It is permissible to call this (or any other request function) at any 222It is permissible to call this (or any other request function) at any
195time, even before the connection has been established - the API object 223time, even before the connection has been established - the API object
196always waits until after login before it actually sends the requests, and 224always waits until after login before it actually sends the requests, and
197queues them until then. 225queues them until then.
… …
219 }); 247 });
220 248
221=cut 249=cut
222 250
223sub req { 251sub req {
252 my $cb = pop;
253 push @_, sub {
254 splice @_, 1, 1
255 or $_[0]->error ($_[1]);
256
257 &$cb
258 };
259
224 $_[0]{queue} 260 $_[0]{queue}
225 ? push @{ $_[0]{queue} }, [@_] 261 ? push @{ $_[0]{queue} }, [@_]
226 : &_req 262 : &_req
227} 263}
228 264
265=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
266
267Just like C<< ->req >>, with two differences: first, a failure will not
268raise an error, second, the initial status reply which indicates success
269or failure is not removed before calling the callback.
270
271=cut
272
273sub req_failok {
274 $_[0]{queue}
275 ? push @{ $_[0]{queue} }, [@_]
276 : &_req
277}
278
229sub on_start_tls_notify { 279sub on_start_tls_notify {
230 my ($self) = @_; 280 my ($self) = @_;
231 281
232 $self->{hdl}->starttls ("connect"); 282 $self->{hdl}->starttls (connect => $self->{tls_ctx});
233 $self->{tls} ||= 1; 283 $self->{tls} ||= 1;
234 284
235 $self->_login; 285 $self->_login;
236} 286}
237 287
… …
327sub on_login_failure { 377sub on_login_failure {
328 my ($self, $msg) = @_; 378 my ($self, $msg) = @_;
329 379
330 $msg =~ s/\n$//; 380 $msg =~ s/\n$//;
331 $self->error ("login failed: $msg"); 381 $self->error ("login failed: $msg");
382}
383
384sub on_event_notify {
385 my ($self, $event, @args) = @_;
386
387 call $self, "on_${event}_event", @args;
332} 388}
333 389
334=back 390=back
335 391
336=head2 EVENTS 392=head2 EVENTS
… …
410 466
411Called when the server wants to start TLS negotiation. This is used 467Called when the server wants to start TLS negotiation. This is used
412internally and - while it is possible to override it - should not be 468internally and - while it is possible to override it - should not be
413overriden. 469overriden.
414 470
471=item on_event_notify $api, $eventname, @args
472
473Called when the server broadcasts an event the API object is subscribed
474to. The default implementation (which should not be overridden) simply
475re-issues an "on_evenname_event" event with the @args.
476
415=item on_XYZ_notify $api, ... 477=item on_XYZ_notify $api, ...
416 478
417In general, any protocol notification will result in an event of the form 479In general, any protocol notification will result in an event of the form
418C<on_NOTIFICATION_notify>. 480C<on_NOTIFICATION_notify>.
419 481
482=item on_XYZ_event $api, ...
483
484Called when the server broadcasts the named (XYZ) event.
485
420=back 486=back
421 487
422=head1 SEE ALSO 488=head1 SEE ALSO
423 489
424L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 490L<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