ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-Porttracker/Porttracker.pm
(Generate patch)

Comparing AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.5 by root, Mon Nov 15 20:43:11 2010 UTC vs.
Revision 1.6 by root, Tue Nov 16 01:10:50 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 shift
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

Diff Legend

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