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

… …
93=item user => $string, pass => $string 93=item user => $string, pass => $string
94 94
95These are the username and password to use when authentication is required 95These 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). 96(which it is in almost all cases, so these keys are normally mandatory).
97 97
98=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.
99 114
100#TODO# 115#TODO#
101 116
102=item on_XYZ => $coderef 117=item on_XYZ => $coderef
103 118
… …
123 Scalar::Util::weaken (my $self = $self); 138 Scalar::Util::weaken (my $self = $self);
124 139
125 $self->{hdl} = new AnyEvent::Handle 140 $self->{hdl} = new AnyEvent::Handle
126 connect => [$self->{host}, $self->{port} || "porttracker=55"], 141 connect => [$self->{host}, $self->{port} || "porttracker=55"],
127 on_error => sub { 142 on_error => sub {
128 $self->error (); 143 $self->error ($_[2]);
129 }, 144 },
130 on_connect => sub { 145 on_connect => sub {
131 if ($self->{tls}) { 146 if ($self->{tls}) {
132 $self->_req (start_tls => sub { 147 $self->_req (start_tls => sub {
133 $_[1] 148 $_[1]
… …
169} 184}
170 185
171sub error { 186sub error {
172 my ($self, $msg) = @_; 187 my ($self, $msg) = @_;
173 188
174 call on_error => $msg; 189 call $self, on_error => $msg;
175 190
176 () 191 ()
177} 192}
178 193
179sub _req { 194sub _req {
… …
188 my $msg = JSON::encode_json \@_; 203 my $msg = JSON::encode_json \@_;
189 204
190 $self->{hdl}->push_write ($msg); 205 $self->{hdl}->push_write ($msg);
191} 206}
192 207
193=item $api->req ($type => @args, $callback->($api, @args)) 208=item $api->req ($type => @args, $callback->($api, @reply))
194 209
195Sends 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
196responds, the API object and the response arguments are passed to the 211responds, the API object and the response arguments (without the success
197callback, 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.
198 217
199The available requests are documented in the Porttracker API 218The available requests are documented in the Porttracker API
200documentation (a copy of which is included in this module as 219documentation (a copy of which is included in this module as
201L<AnyEvent::Porttracker::protocol>. 220L<AnyEvent::Porttracker::protocol>.
202 221
… …
228 }); 247 });
229 248
230=cut 249=cut
231 250
232sub req { 251sub req {
252 my $cb = pop;
253 push @_, sub {
254 splice @_, 1, 1
255 or $_[0]->error ($_[1]);
256
257 &$cb
258 };
259
233 $_[0]{queue} 260 $_[0]{queue}
234 ? push @{ $_[0]{queue} }, [@_] 261 ? push @{ $_[0]{queue} }, [@_]
235 : &_req 262 : &_req
236} 263}
237 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
238sub on_start_tls_notify { 279sub on_start_tls_notify {
239 my ($self) = @_; 280 my ($self) = @_;
240 281
241 $self->{hdl}->starttls ("connect"); 282 $self->{hdl}->starttls (connect => $self->{tls_ctx});
242 $self->{tls} ||= 1; 283 $self->{tls} ||= 1;
243 284
244 $self->_login; 285 $self->_login;
245} 286}
246 287
… …
336sub on_login_failure { 377sub on_login_failure {
337 my ($self, $msg) = @_; 378 my ($self, $msg) = @_;
338 379
339 $msg =~ s/\n$//; 380 $msg =~ s/\n$//;
340 $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;
341} 388}
342 389
343=back 390=back
344 391
345=head2 EVENTS 392=head2 EVENTS
… …
419 466
420Called when the server wants to start TLS negotiation. This is used 467Called when the server wants to start TLS negotiation. This is used
421internally and - while it is possible to override it - should not be 468internally and - while it is possible to override it - should not be
422overriden. 469overriden.
423 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
424=item on_XYZ_notify $api, ... 477=item on_XYZ_notify $api, ...
425 478
426In 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
427C<on_NOTIFICATION_notify>. 480C<on_NOTIFICATION_notify>.
428 481
482=item on_XYZ_event $api, ...
483
484Called when the server broadcasts the named (XYZ) event.
485
429=back 486=back
430 487
431=head1 SEE ALSO 488=head1 SEE ALSO
432 489
433L<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