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.112 by root, Wed Jan 21 06:01:35 2009 UTC vs.
Revision 1.132 by elmex, Thu Jul 2 22:25:13 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.331; 19our $VERSION = 4.45;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
63 63
64=head1 METHODS 64=head1 METHODS
65 65
66=over 4 66=over 4
67 67
68=item B<new (%args)> 68=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
69 69
70The constructor supports these arguments (all as key => value pairs). 70The constructor supports these arguments (all as C<< key => value >> pairs).
71 71
72=over 4 72=over 4
73 73
74=item fh => $filehandle [MANDATORY] 74=item fh => $filehandle [MANDATORY]
75 75
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>).
235 237
236This will not work for partial TLS data that could not be encoded 238This will not work for partial TLS data that could not be encoded
237yet. This data will be lost. Calling the C<stoptls> method in time might 239yet. This data will be lost. Calling the C<stoptls> method in time might
238help. 240help.
239 241
242=item common_name => $string
243
244The common name used by some verification methods (most notably SSL/TLS)
245associated with this connection. Usually this is the remote hostname used
246to connect, but can be almost anything.
247
240=item tls => "accept" | "connect" | Net::SSLeay::SSL object 248=item tls => "accept" | "connect" | Net::SSLeay::SSL object
241 249
242When this parameter is given, it enables TLS (SSL) mode, that means 250When this parameter is given, it enables TLS (SSL) mode, that means
243AnyEvent will start a TLS handshake as soon as the conenction has been 251AnyEvent will start a TLS handshake as soon as the conenction has been
244established and will transparently encrypt/decrypt data afterwards. 252established and will transparently encrypt/decrypt data afterwards.
253mode. 261mode.
254 262
255You can also provide your own TLS connection object, but you have 263You can also provide your own TLS connection object, but you have
256to make sure that you call either C<Net::SSLeay::set_connect_state> 264to 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 265or C<Net::SSLeay::set_accept_state> on it before you pass it to
258AnyEvent::Handle. 266AnyEvent::Handle. Also, this module will take ownership of this connection
267object.
268
269At some future point, AnyEvent::Handle might switch to another TLS
270implementation, then the option to use your own session object will go
271away.
259 272
260B<IMPORTANT:> since Net::SSLeay "objects" are really only integers, 273B<IMPORTANT:> since Net::SSLeay "objects" are really only integers,
261passing in the wrong integer will lead to certain crash. This most often 274passing in the wrong integer will lead to certain crash. This most often
262happens when one uses a stylish C<< tls => 1 >> and is surprised about the 275happens when one uses a stylish C<< tls => 1 >> and is surprised about the
263segmentation fault. 276segmentation fault.
264 277
265See the C<< ->starttls >> method for when need to start TLS negotiation later. 278See the C<< ->starttls >> method for when need to start TLS negotiation later.
266 279
267=item tls_ctx => $ssl_ctx 280=item tls_ctx => $anyevent_tls
268 281
269Use the given C<Net::SSLeay::CTX> object to create the new TLS connection 282Use the given C<AnyEvent::TLS> object to create the new TLS connection
270(unless a connection object was specified directly). If this parameter is 283(unless a connection object was specified directly). If this parameter is
271missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 284missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
285
286Instead of an object, you can also specify a hash reference with C<< key
287=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a
288new TLS context object.
272 289
273=item json => JSON or JSON::XS object 290=item json => JSON or JSON::XS object
274 291
275This is the json coder object used by the C<json> read and write types. 292This is the json coder object used by the C<json> read and write types.
276 293
285 302
286=cut 303=cut
287 304
288sub new { 305sub new {
289 my $class = shift; 306 my $class = shift;
290
291 my $self = bless { @_ }, $class; 307 my $self = bless { @_ }, $class;
292 308
293 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 309 $self->{fh} or Carp::croak "mandatory argument fh is missing";
294 310
295 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 311 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
312
313 $self->{_activity} = AnyEvent->now;
314 $self->_timeout;
315
316 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
296 317
297 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 318 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
298 if $self->{tls}; 319 if $self->{tls};
299 320
300 $self->{_activity} = AnyEvent->now;
301 $self->_timeout;
302
303 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain}; 321 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain};
304 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
305 322
306 $self->start_read 323 $self->start_read
307 if $self->{on_read}; 324 if $self->{on_read};
308 325
309 $self 326 $self->{fh} && $self
310} 327}
311 328
312sub _shutdown { 329sub _shutdown {
313 my ($self) = @_; 330 my ($self) = @_;
314 331
315 delete $self->{_tw}; 332 delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
316 delete $self->{_rw}; 333 $self->{_eof} = 1; # tell starttls et. al to stop trying
317 delete $self->{_ww};
318 delete $self->{fh};
319 334
320 &_freetls; 335 &_freetls;
321
322 delete $self->{on_read};
323 delete $self->{_queue};
324} 336}
325 337
326sub _error { 338sub _error {
327 my ($self, $errno, $fatal) = @_; 339 my ($self, $errno, $fatal) = @_;
328 340
767 ) { 779 ) {
768 $self->_error (&Errno::ENOSPC, 1), return; 780 $self->_error (&Errno::ENOSPC, 1), return;
769 } 781 }
770 782
771 while () { 783 while () {
784 # we need to use a separate tls read buffer, as we must not receive data while
785 # we are draining the buffer, and this can only happen with TLS.
786 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf};
787
772 my $len = length $self->{rbuf}; 788 my $len = length $self->{rbuf};
773 789
774 if (my $cb = shift @{ $self->{_queue} }) { 790 if (my $cb = shift @{ $self->{_queue} }) {
775 unless ($cb->($self)) { 791 unless ($cb->($self)) {
776 if ($self->{_eof}) { 792 if ($self->{_eof}) {
837 853
838=item $handle->rbuf 854=item $handle->rbuf
839 855
840Returns the read buffer (as a modifiable lvalue). 856Returns the read buffer (as a modifiable lvalue).
841 857
842You can access the read buffer directly as the C<< ->{rbuf} >> member, if 858You can access the read buffer directly as the C<< ->{rbuf} >>
843you want. 859member, if you want. However, the only operation allowed on the
860read buffer (apart from looking at it) is removing data from its
861beginning. Otherwise modifying or appending to it is not allowed and will
862lead to hard-to-track-down bugs.
844 863
845NOTE: The read buffer should only be used or modified if the C<on_read>, 864NOTE: The read buffer should only be used or modified if the C<on_read>,
846C<push_read> or C<unshift_read> methods are used. The other read methods 865C<push_read> or C<unshift_read> methods are used. The other read methods
847automatically manage the read buffer. 866automatically manage the read buffer.
848 867
1172 my $rbuf = \$self->{rbuf}; 1191 my $rbuf = \$self->{rbuf};
1173 1192
1174 my $json = $self->{json} ||= JSON->new->utf8; 1193 my $json = $self->{json} ||= JSON->new->utf8;
1175 1194
1176 sub { 1195 sub {
1177 eval {
1178 my $ref = $json->incr_parse ($self->{rbuf}); 1196 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1179 1197
1180 if ($ref) { 1198 if ($ref) {
1181 $self->{rbuf} = $json->incr_text; 1199 $self->{rbuf} = $json->incr_text;
1182 $json->incr_text = ""; 1200 $json->incr_text = "";
1183 $cb->($self, $ref); 1201 $cb->($self, $ref);
1184
1185 1
1186 } else {
1187 $self->{rbuf} = "";
1188 ()
1189 }
1190 1202
1191 1 1203 1
1192 } or do { 1204 } elsif ($@) {
1193 # error case 1205 # error case
1194 $json->incr_skip; 1206 $json->incr_skip;
1195 1207
1196 $self->{rbuf} = $json->incr_text; 1208 $self->{rbuf} = $json->incr_text;
1197 $json->incr_text = ""; 1209 $json->incr_text = "";
1198 1210
1199 $self->_error (&Errno::EBADMSG); 1211 $self->_error (&Errno::EBADMSG);
1212
1213 ()
1214 } else {
1215 $self->{rbuf} = "";
1216
1217 ()
1200 }; 1218 }
1201 } 1219 }
1202}; 1220};
1203 1221
1204=item storable => $cb->($handle, $ref) 1222=item storable => $cb->($handle, $ref)
1205 1223
1344 delete $self->{_rw}; 1362 delete $self->{_rw};
1345 $self->{_eof} = 1; 1363 $self->{_eof} = 1;
1346 &_freetls; 1364 &_freetls;
1347 } 1365 }
1348 1366
1349 $self->{rbuf} .= $tmp; 1367 $self->{_tls_rbuf} .= $tmp;
1350 $self->_drain_rbuf unless $self->{_in_drain}; 1368 $self->_drain_rbuf unless $self->{_in_drain};
1351 $self->{tls} or return; # tls session might have gone away in callback 1369 $self->{tls} or return; # tls session might have gone away in callback
1352 } 1370 }
1353 1371
1354 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1372 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1355 1373
1356 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) { 1374 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) {
1357 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) { 1375 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) {
1358 return $self->_error ($!, 1); 1376 return $self->_error ($!, 1);
1359 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) { 1377 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) {
1360 return $self->_error (&Errno::EIO, 1); 1378 return $self->_error (&Errno::EIO, 1);
1361 } 1379 }
1362 1380
1363 # all other errors are fine for our purposes 1381 # all other errors are fine for our purposes
1364 } 1382 }
1376C<starttls>. 1394C<starttls>.
1377 1395
1378The first argument is the same as the C<tls> constructor argument (either 1396The first argument is the same as the C<tls> constructor argument (either
1379C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1397C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1380 1398
1381The second argument is the optional C<Net::SSLeay::CTX> object that is 1399The second argument is the optional C<AnyEvent::TLS> object that is used
1382used when AnyEvent::Handle has to create its own TLS connection object. 1400when AnyEvent::Handle has to create its own TLS connection object, or
1401a hash reference with C<< key => value >> pairs that will be used to
1402construct a new context.
1383 1403
1384The TLS connection object will end up in C<< $handle->{tls} >> after this 1404The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1385call and can be used or changed to your liking. Note that the handshake 1405context in C<< $handle->{tls_ctx} >> after this call and can be used or
1386might have already started when this function returns. 1406changed to your liking. Note that the handshake might have already started
1407when this function returns.
1387 1408
1388If it an error to start a TLS handshake more than once per 1409If it an error to start a TLS handshake more than once per
1389AnyEvent::Handle object (this is due to bugs in OpenSSL). 1410AnyEvent::Handle object (this is due to bugs in OpenSSL).
1390 1411
1391=cut 1412=cut
1395 1416
1396 require Net::SSLeay; 1417 require Net::SSLeay;
1397 1418
1398 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object" 1419 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1399 if $self->{tls}; 1420 if $self->{tls};
1421
1422 $ctx ||= $self->{tls_ctx};
1423
1424 if ("HASH" eq ref $ctx) {
1425 require AnyEvent::TLS;
1426
1427 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context
1428 $ctx = new AnyEvent::TLS %$ctx;
1429 }
1400 1430
1401 if ($ssl eq "accept") { 1431 $self->{tls_ctx} = $ctx || TLS_CTX ();
1402 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1432 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self);
1403 Net::SSLeay::set_accept_state ($ssl);
1404 } elsif ($ssl eq "connect") {
1405 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1406 Net::SSLeay::set_connect_state ($ssl);
1407 }
1408
1409 $self->{tls} = $ssl;
1410 1433
1411 # basically, this is deep magic (because SSL_read should have the same issues) 1434 # basically, this is deep magic (because SSL_read should have the same issues)
1412 # but the openssl maintainers basically said: "trust us, it just works". 1435 # but the openssl maintainers basically said: "trust us, it just works".
1413 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1436 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1414 # and mismaintained ssleay-module doesn't even offer them). 1437 # and mismaintained ssleay-module doesn't even offer them).
1418 # 1441 #
1419 # note that we do not try to keep the length constant between writes as we are required to do. 1442 # note that we do not try to keep the length constant between writes as we are required to do.
1420 # we assume that most (but not all) of this insanity only applies to non-blocking cases, 1443 # we assume that most (but not all) of this insanity only applies to non-blocking cases,
1421 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 1444 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1422 # have identity issues in that area. 1445 # have identity issues in that area.
1423 Net::SSLeay::CTX_set_mode ($self->{tls}, 1446# Net::SSLeay::CTX_set_mode ($ssl,
1424 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1447# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1425 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1448# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1449 Net::SSLeay::CTX_set_mode ($ssl, 1|2);
1426 1450
1427 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1451 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1428 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1452 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1429 1453
1430 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1454 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1459sub _freetls { 1483sub _freetls {
1460 my ($self) = @_; 1484 my ($self) = @_;
1461 1485
1462 return unless $self->{tls}; 1486 return unless $self->{tls};
1463 1487
1464 Net::SSLeay::free (delete $self->{tls}); 1488 $self->{tls_ctx}->_put_session (delete $self->{tls});
1465 1489
1466 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1490 delete @$self{qw(_rbio _wbio _tls_wbuf)};
1467} 1491}
1468 1492
1469sub DESTROY { 1493sub DESTROY {
1470 my $self = shift; 1494 my ($self) = @_;
1471 1495
1472 &_freetls; 1496 &_freetls;
1473 1497
1474 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1498 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1475 1499
1519 %$self = (); 1543 %$self = ();
1520} 1544}
1521 1545
1522=item AnyEvent::Handle::TLS_CTX 1546=item AnyEvent::Handle::TLS_CTX
1523 1547
1524This function creates and returns the Net::SSLeay::CTX object used by 1548This function creates and returns the AnyEvent::TLS object used by default
1525default for TLS mode. 1549for TLS mode.
1526 1550
1527The context is created like this: 1551The context is created by calling L<AnyEvent::TLS> without any arguments.
1528
1529 Net::SSLeay::load_error_strings;
1530 Net::SSLeay::SSLeay_add_ssl_algorithms;
1531 Net::SSLeay::randomize;
1532
1533 my $CTX = Net::SSLeay::CTX_new;
1534
1535 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
1536 1552
1537=cut 1553=cut
1538 1554
1539our $TLS_CTX; 1555our $TLS_CTX;
1540 1556
1541sub TLS_CTX() { 1557sub TLS_CTX() {
1542 $TLS_CTX || do { 1558 $TLS_CTX ||= do {
1543 require Net::SSLeay; 1559 require AnyEvent::TLS;
1544 1560
1545 Net::SSLeay::load_error_strings (); 1561 new AnyEvent::TLS
1546 Net::SSLeay::SSLeay_add_ssl_algorithms ();
1547 Net::SSLeay::randomize ();
1548
1549 $TLS_CTX = Net::SSLeay::CTX_new ();
1550
1551 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
1552
1553 $TLS_CTX
1554 } 1562 }
1555} 1563}
1556 1564
1557=back 1565=back
1558 1566

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines