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.111 by root, Wed Jan 21 06:01:29 2009 UTC vs.
Revision 1.131 by root, Tue Jun 30 22:42:33 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 rbuf 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
1202 } 1219 }
1203}; 1220};
1204 1221
1205=item storable => $cb->($handle, $ref) 1222=item storable => $cb->($handle, $ref)
1206 1223
1345 delete $self->{_rw}; 1362 delete $self->{_rw};
1346 $self->{_eof} = 1; 1363 $self->{_eof} = 1;
1347 &_freetls; 1364 &_freetls;
1348 } 1365 }
1349 1366
1350 $self->{rbuf} .= $tmp; 1367 $self->{_tls_rbuf} .= $tmp;
1351 $self->_drain_rbuf unless $self->{_in_drain}; 1368 $self->_drain_rbuf unless $self->{_in_drain};
1352 $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
1353 } 1370 }
1354 1371
1355 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1372 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1356 1373
1357 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) { 1374 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) {
1358 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) { 1375 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) {
1359 return $self->_error ($!, 1); 1376 return $self->_error ($!, 1);
1360 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) { 1377 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) {
1361 return $self->_error (&Errno::EIO, 1); 1378 return $self->_error (&Errno::EIO, 1);
1362 } 1379 }
1363 1380
1364 # all other errors are fine for our purposes 1381 # all other errors are fine for our purposes
1365 } 1382 }
1377C<starttls>. 1394C<starttls>.
1378 1395
1379The 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
1380C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1397C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1381 1398
1382The 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
1383used 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.
1384 1403
1385The 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
1386call 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
1387might have already started when this function returns. 1406changed to your liking. Note that the handshake might have already started
1407when this function returns.
1388 1408
1389If 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
1390AnyEvent::Handle object (this is due to bugs in OpenSSL). 1410AnyEvent::Handle object (this is due to bugs in OpenSSL).
1391 1411
1392=cut 1412=cut
1396 1416
1397 require Net::SSLeay; 1417 require Net::SSLeay;
1398 1418
1399 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"
1400 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 }
1401 1430
1402 if ($ssl eq "accept") { 1431 $self->{tls_ctx} = $ctx || TLS_CTX ();
1403 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1432 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self);
1404 Net::SSLeay::set_accept_state ($ssl);
1405 } elsif ($ssl eq "connect") {
1406 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1407 Net::SSLeay::set_connect_state ($ssl);
1408 }
1409
1410 $self->{tls} = $ssl;
1411 1433
1412 # 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)
1413 # but the openssl maintainers basically said: "trust us, it just works". 1435 # but the openssl maintainers basically said: "trust us, it just works".
1414 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1436 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1415 # and mismaintained ssleay-module doesn't even offer them). 1437 # and mismaintained ssleay-module doesn't even offer them).
1419 # 1441 #
1420 # 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.
1421 # 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,
1422 # 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
1423 # have identity issues in that area. 1445 # have identity issues in that area.
1424 Net::SSLeay::CTX_set_mode ($self->{tls}, 1446# Net::SSLeay::CTX_set_mode ($ssl,
1425 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1447# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1426 | (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);
1427 1450
1428 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1451 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1429 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1452 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1430 1453
1431 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1454 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1460sub _freetls { 1483sub _freetls {
1461 my ($self) = @_; 1484 my ($self) = @_;
1462 1485
1463 return unless $self->{tls}; 1486 return unless $self->{tls};
1464 1487
1465 Net::SSLeay::free (delete $self->{tls}); 1488 $self->{tls_ctx}->_put_session (delete $self->{tls});
1466 1489
1467 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1490 delete @$self{qw(_rbio _wbio _tls_wbuf)};
1468} 1491}
1469 1492
1470sub DESTROY { 1493sub DESTROY {
1471 my $self = shift; 1494 my ($self) = @_;
1472 1495
1473 &_freetls; 1496 &_freetls;
1474 1497
1475 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1498 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1476 1499
1520 %$self = (); 1543 %$self = ();
1521} 1544}
1522 1545
1523=item AnyEvent::Handle::TLS_CTX 1546=item AnyEvent::Handle::TLS_CTX
1524 1547
1525This function creates and returns the Net::SSLeay::CTX object used by 1548This function creates and returns the AnyEvent::TLS object used by default
1526default for TLS mode. 1549for TLS mode.
1527 1550
1528The context is created like this: 1551The context is created by calling L<AnyEvent::TLS> without any arguments.
1529
1530 Net::SSLeay::load_error_strings;
1531 Net::SSLeay::SSLeay_add_ssl_algorithms;
1532 Net::SSLeay::randomize;
1533
1534 my $CTX = Net::SSLeay::CTX_new;
1535
1536 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
1537 1552
1538=cut 1553=cut
1539 1554
1540our $TLS_CTX; 1555our $TLS_CTX;
1541 1556
1542sub TLS_CTX() { 1557sub TLS_CTX() {
1543 $TLS_CTX || do { 1558 $TLS_CTX ||= do {
1544 require Net::SSLeay; 1559 require AnyEvent::TLS;
1545 1560
1546 Net::SSLeay::load_error_strings (); 1561 new AnyEvent::TLS
1547 Net::SSLeay::SSLeay_add_ssl_algorithms ();
1548 Net::SSLeay::randomize ();
1549
1550 $TLS_CTX = Net::SSLeay::CTX_new ();
1551
1552 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
1553
1554 $TLS_CTX
1555 } 1562 }
1556} 1563}
1557 1564
1558=back 1565=back
1559 1566

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines