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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.107 by root, Wed Nov 26 06:40:47 2008 UTC vs.
Revision 1.129 by root, Mon Jun 29 11:04:09 2009 UTC

14 14
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17=cut
18 18
19our $VERSION = 4.33; 19our $VERSION = 4.42;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
127and no read request is in the queue (unlike read queue callbacks, this 127and no read request is in the queue (unlike read queue callbacks, this
128callback will only be called when at least one octet of data is in the 128callback will only be called when at least one octet of data is in the
129read buffer). 129read buffer).
130 130
131To access (and remove data from) the read buffer, use the C<< ->rbuf >> 131To access (and remove data from) the read buffer, use the C<< ->rbuf >>
132method or access the C<$handle->{rbuf}> member directly. 132method or access the C<$handle->{rbuf}> member directly. Note that you
133must not enlarge or modify the read buffer, you can only remove data at
134the beginning from it.
133 135
134When an EOF condition is detected then AnyEvent::Handle will first try to 136When an EOF condition is detected then AnyEvent::Handle will first try to
135feed all the remaining data to the queued callbacks and C<on_read> before 137feed all the remaining data to the queued callbacks and C<on_read> before
136calling the C<on_eof> callback. If no progress can be made, then a fatal 138calling the C<on_eof> callback. If no progress can be made, then a fatal
137error will be raised (with C<$!> set to C<EPIPE>). 139error will be raised (with C<$!> set to C<EPIPE>).
255You can also provide your own TLS connection object, but you have 257You can also provide your own TLS connection object, but you have
256to make sure that you call either C<Net::SSLeay::set_connect_state> 258to make sure that you call either C<Net::SSLeay::set_connect_state>
257or C<Net::SSLeay::set_accept_state> on it before you pass it to 259or C<Net::SSLeay::set_accept_state> on it before you pass it to
258AnyEvent::Handle. 260AnyEvent::Handle.
259 261
262B<IMPORTANT:> since Net::SSLeay "objects" are really only integers,
263passing in the wrong integer will lead to certain crash. This most often
264happens when one uses a stylish C<< tls => 1 >> and is surprised about the
265segmentation fault.
266
260See the C<< ->starttls >> method for when need to start TLS negotiation later. 267See the C<< ->starttls >> method for when need to start TLS negotiation later.
261 268
262=item tls_ctx => $ssl_ctx 269=item tls_ctx => $ssl_ctx
263 270
264Use the given C<Net::SSLeay::CTX> object to create the new TLS connection 271Use the given C<Net::SSLeay::CTX> object to create the new TLS connection
305} 312}
306 313
307sub _shutdown { 314sub _shutdown {
308 my ($self) = @_; 315 my ($self) = @_;
309 316
310 delete $self->{_tw}; 317 delete @$self{qw(_tw _rw _ww fh rbuf wbuf on_read _queue)};
311 delete $self->{_rw};
312 delete $self->{_ww};
313 delete $self->{fh};
314 318
315 &_freetls; 319 &_freetls;
316
317 delete $self->{on_read};
318 delete $self->{_queue};
319} 320}
320 321
321sub _error { 322sub _error {
322 my ($self, $errno, $fatal) = @_; 323 my ($self, $errno, $fatal) = @_;
323 324
762 ) { 763 ) {
763 $self->_error (&Errno::ENOSPC, 1), return; 764 $self->_error (&Errno::ENOSPC, 1), return;
764 } 765 }
765 766
766 while () { 767 while () {
768 # we need to use a separate tls read buffer, as we must not receive data while
769 # we are draining the buffer, and this can only happen with TLS.
770 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf};
771
767 my $len = length $self->{rbuf}; 772 my $len = length $self->{rbuf};
768 773
769 if (my $cb = shift @{ $self->{_queue} }) { 774 if (my $cb = shift @{ $self->{_queue} }) {
770 unless ($cb->($self)) { 775 unless ($cb->($self)) {
771 if ($self->{_eof}) { 776 if ($self->{_eof}) {
832 837
833=item $handle->rbuf 838=item $handle->rbuf
834 839
835Returns the read buffer (as a modifiable lvalue). 840Returns the read buffer (as a modifiable lvalue).
836 841
837You can access the read buffer directly as the C<< ->{rbuf} >> member, if 842You can access the read buffer directly as the C<< ->{rbuf} >>
838you want. 843member, if you want. However, the only operation allowed on the
844read buffer (apart from looking at it) is removing data from its
845beginning. Otherwise modifying or appending to it is not allowed and will
846lead to hard-to-track-down bugs.
839 847
840NOTE: The read buffer should only be used or modified if the C<on_read>, 848NOTE: The read buffer should only be used or modified if the C<on_read>,
841C<push_read> or C<unshift_read> methods are used. The other read methods 849C<push_read> or C<unshift_read> methods are used. The other read methods
842automatically manage the read buffer. 850automatically manage the read buffer.
843 851
1139 } 1147 }
1140}; 1148};
1141 1149
1142=item json => $cb->($handle, $hash_or_arrayref) 1150=item json => $cb->($handle, $hash_or_arrayref)
1143 1151
1144Reads a JSON object or array, decodes it and passes it to the callback. 1152Reads a JSON object or array, decodes it and passes it to the
1153callback. When a parse error occurs, an C<EBADMSG> error will be raised.
1145 1154
1146If a C<json> object was passed to the constructor, then that will be used 1155If a C<json> object was passed to the constructor, then that will be used
1147for the final decode, otherwise it will create a JSON coder expecting UTF-8. 1156for the final decode, otherwise it will create a JSON coder expecting UTF-8.
1148 1157
1149This read type uses the incremental parser available with JSON version 1158This read type uses the incremental parser available with JSON version
1166 my $rbuf = \$self->{rbuf}; 1175 my $rbuf = \$self->{rbuf};
1167 1176
1168 my $json = $self->{json} ||= JSON->new->utf8; 1177 my $json = $self->{json} ||= JSON->new->utf8;
1169 1178
1170 sub { 1179 sub {
1171 my $ref = $json->incr_parse ($self->{rbuf}); 1180 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1172 1181
1173 if ($ref) { 1182 if ($ref) {
1174 $self->{rbuf} = $json->incr_text; 1183 $self->{rbuf} = $json->incr_text;
1175 $json->incr_text = ""; 1184 $json->incr_text = "";
1176 $cb->($self, $ref); 1185 $cb->($self, $ref);
1177 1186
1178 1 1187 1
1188 } elsif ($@) {
1189 # error case
1190 $json->incr_skip;
1191
1192 $self->{rbuf} = $json->incr_text;
1193 $json->incr_text = "";
1194
1195 $self->_error (&Errno::EBADMSG);
1196
1197 ()
1179 } else { 1198 } else {
1180 $self->{rbuf} = ""; 1199 $self->{rbuf} = "";
1200
1181 () 1201 ()
1182 } 1202 }
1183 } 1203 }
1184}; 1204};
1185 1205
1326 delete $self->{_rw}; 1346 delete $self->{_rw};
1327 $self->{_eof} = 1; 1347 $self->{_eof} = 1;
1328 &_freetls; 1348 &_freetls;
1329 } 1349 }
1330 1350
1331 $self->{rbuf} .= $tmp; 1351 $self->{_tls_rbuf} .= $tmp;
1332 $self->_drain_rbuf unless $self->{_in_drain}; 1352 $self->_drain_rbuf unless $self->{_in_drain};
1333 $self->{tls} or return; # tls session might have gone away in callback 1353 $self->{tls} or return; # tls session might have gone away in callback
1334 } 1354 }
1335 1355
1336 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1356 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1337 1357
1338 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) { 1358 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) {
1339 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) { 1359 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) {
1340 return $self->_error ($!, 1); 1360 return $self->_error ($!, 1);
1341 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) { 1361 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) {
1342 return $self->_error (&Errno::EIO, 1); 1362 return $self->_error (&Errno::EIO, 1);
1343 } 1363 }
1344 1364
1345 # all other errors are fine for our purposes 1365 # all other errors are fine for our purposes
1346 } 1366 }
1447 1467
1448 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1468 delete @$self{qw(_rbio _wbio _tls_wbuf)};
1449} 1469}
1450 1470
1451sub DESTROY { 1471sub DESTROY {
1452 my $self = shift; 1472 my ($self) = @_;
1453 1473
1454 &_freetls; 1474 &_freetls;
1455 1475
1456 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1476 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1457 1477

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines