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.109 by root, Wed Jan 14 02:03:43 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
1144 } 1163 }
1145}; 1164};
1146 1165
1147=item json => $cb->($handle, $hash_or_arrayref) 1166=item json => $cb->($handle, $hash_or_arrayref)
1148 1167
1149Reads a JSON object or array, decodes it and passes it to the callback. 1168Reads a JSON object or array, decodes it and passes it to the
1169callback. When a parse error occurs, an C<EBADMSG> error will be raised.
1150 1170
1151If a C<json> object was passed to the constructor, then that will be used 1171If a C<json> object was passed to the constructor, then that will be used
1152for the final decode, otherwise it will create a JSON coder expecting UTF-8. 1172for the final decode, otherwise it will create a JSON coder expecting UTF-8.
1153 1173
1154This read type uses the incremental parser available with JSON version 1174This read type uses the incremental parser available with JSON version
1171 my $rbuf = \$self->{rbuf}; 1191 my $rbuf = \$self->{rbuf};
1172 1192
1173 my $json = $self->{json} ||= JSON->new->utf8; 1193 my $json = $self->{json} ||= JSON->new->utf8;
1174 1194
1175 sub { 1195 sub {
1176 my $ref = $json->incr_parse ($self->{rbuf}); 1196 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1177 1197
1178 if ($ref) { 1198 if ($ref) {
1179 $self->{rbuf} = $json->incr_text; 1199 $self->{rbuf} = $json->incr_text;
1180 $json->incr_text = ""; 1200 $json->incr_text = "";
1181 $cb->($self, $ref); 1201 $cb->($self, $ref);
1182 1202
1183 1 1203 1
1204 } elsif ($@) {
1205 # error case
1206 $json->incr_skip;
1207
1208 $self->{rbuf} = $json->incr_text;
1209 $json->incr_text = "";
1210
1211 $self->_error (&Errno::EBADMSG);
1212
1213 ()
1184 } else { 1214 } else {
1185 $self->{rbuf} = ""; 1215 $self->{rbuf} = "";
1216
1186 () 1217 ()
1187 } 1218 }
1188 } 1219 }
1189}; 1220};
1190 1221
1331 delete $self->{_rw}; 1362 delete $self->{_rw};
1332 $self->{_eof} = 1; 1363 $self->{_eof} = 1;
1333 &_freetls; 1364 &_freetls;
1334 } 1365 }
1335 1366
1336 $self->{rbuf} .= $tmp; 1367 $self->{_tls_rbuf} .= $tmp;
1337 $self->_drain_rbuf unless $self->{_in_drain}; 1368 $self->_drain_rbuf unless $self->{_in_drain};
1338 $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
1339 } 1370 }
1340 1371
1341 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1372 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1342 1373
1343 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) { 1374 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) {
1344 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) { 1375 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) {
1345 return $self->_error ($!, 1); 1376 return $self->_error ($!, 1);
1346 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) { 1377 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) {
1347 return $self->_error (&Errno::EIO, 1); 1378 return $self->_error (&Errno::EIO, 1);
1348 } 1379 }
1349 1380
1350 # all other errors are fine for our purposes 1381 # all other errors are fine for our purposes
1351 } 1382 }
1363C<starttls>. 1394C<starttls>.
1364 1395
1365The 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
1366C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1397C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1367 1398
1368The 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
1369used 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.
1370 1403
1371The 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
1372call 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
1373might have already started when this function returns. 1406changed to your liking. Note that the handshake might have already started
1407when this function returns.
1374 1408
1375If 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
1376AnyEvent::Handle object (this is due to bugs in OpenSSL). 1410AnyEvent::Handle object (this is due to bugs in OpenSSL).
1377 1411
1378=cut 1412=cut
1382 1416
1383 require Net::SSLeay; 1417 require Net::SSLeay;
1384 1418
1385 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"
1386 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 }
1387 1430
1388 if ($ssl eq "accept") { 1431 $self->{tls_ctx} = $ctx || TLS_CTX ();
1389 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1432 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self);
1390 Net::SSLeay::set_accept_state ($ssl);
1391 } elsif ($ssl eq "connect") {
1392 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1393 Net::SSLeay::set_connect_state ($ssl);
1394 }
1395
1396 $self->{tls} = $ssl;
1397 1433
1398 # 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)
1399 # but the openssl maintainers basically said: "trust us, it just works". 1435 # but the openssl maintainers basically said: "trust us, it just works".
1400 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1436 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1401 # and mismaintained ssleay-module doesn't even offer them). 1437 # and mismaintained ssleay-module doesn't even offer them).
1405 # 1441 #
1406 # 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.
1407 # 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,
1408 # 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
1409 # have identity issues in that area. 1445 # have identity issues in that area.
1410 Net::SSLeay::CTX_set_mode ($self->{tls}, 1446# Net::SSLeay::CTX_set_mode ($ssl,
1411 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1447# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1412 | (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);
1413 1450
1414 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1451 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1415 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1452 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1416 1453
1417 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1454 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1446sub _freetls { 1483sub _freetls {
1447 my ($self) = @_; 1484 my ($self) = @_;
1448 1485
1449 return unless $self->{tls}; 1486 return unless $self->{tls};
1450 1487
1451 Net::SSLeay::free (delete $self->{tls}); 1488 $self->{tls_ctx}->_put_session (delete $self->{tls});
1452 1489
1453 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1490 delete @$self{qw(_rbio _wbio _tls_wbuf)};
1454} 1491}
1455 1492
1456sub DESTROY { 1493sub DESTROY {
1457 my $self = shift; 1494 my ($self) = @_;
1458 1495
1459 &_freetls; 1496 &_freetls;
1460 1497
1461 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1498 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1462 1499
1506 %$self = (); 1543 %$self = ();
1507} 1544}
1508 1545
1509=item AnyEvent::Handle::TLS_CTX 1546=item AnyEvent::Handle::TLS_CTX
1510 1547
1511This function creates and returns the Net::SSLeay::CTX object used by 1548This function creates and returns the AnyEvent::TLS object used by default
1512default for TLS mode. 1549for TLS mode.
1513 1550
1514The context is created like this: 1551The context is created by calling L<AnyEvent::TLS> without any arguments.
1515
1516 Net::SSLeay::load_error_strings;
1517 Net::SSLeay::SSLeay_add_ssl_algorithms;
1518 Net::SSLeay::randomize;
1519
1520 my $CTX = Net::SSLeay::CTX_new;
1521
1522 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
1523 1552
1524=cut 1553=cut
1525 1554
1526our $TLS_CTX; 1555our $TLS_CTX;
1527 1556
1528sub TLS_CTX() { 1557sub TLS_CTX() {
1529 $TLS_CTX || do { 1558 $TLS_CTX ||= do {
1530 require Net::SSLeay; 1559 require AnyEvent::TLS;
1531 1560
1532 Net::SSLeay::load_error_strings (); 1561 new AnyEvent::TLS
1533 Net::SSLeay::SSLeay_add_ssl_algorithms ();
1534 Net::SSLeay::randomize ();
1535
1536 $TLS_CTX = Net::SSLeay::CTX_new ();
1537
1538 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
1539
1540 $TLS_CTX
1541 } 1562 }
1542} 1563}
1543 1564
1544=back 1565=back
1545 1566

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines