--- AnyEvent/lib/AnyEvent/Handle.pm 2009/07/04 23:58:52 1.137 +++ AnyEvent/lib/AnyEvent/Handle.pm 2009/07/18 05:19:09 1.154 @@ -1,22 +1,19 @@ package AnyEvent::Handle; -no warnings; -use strict qw(subs vars); - -use AnyEvent (); -use AnyEvent::Util qw(WSAEWOULDBLOCK); use Scalar::Util (); use Carp (); -use Fcntl (); use Errno qw(EAGAIN EINTR); +use AnyEvent (); BEGIN { AnyEvent::common_sense } +use AnyEvent::Util qw(WSAEWOULDBLOCK); + =head1 NAME AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent =cut -our $VERSION = 4.452; +our $VERSION = 4.85; =head1 SYNOPSIS @@ -25,21 +22,22 @@ my $cv = AnyEvent->condvar; - my $handle = - AnyEvent::Handle->new ( - fh => \*STDIN, - on_eof => sub { - $cv->send; - }, + my $hdl; $hdl = new AnyEvent::Handle + fh => \*STDIN, + on_error => sub { + my ($hdl, $fatal, $msg) = @_; + warn "got error $msg\n"; + $hdl->destroy; + $cv->send; ); # send some request line - $handle->push_write ("getinfo\015\012"); + $hdl->push_write ("getinfo\015\012"); # read the response line - $handle->push_read (line => sub { - my ($handle, $line) = @_; - warn "read line <$line>\n"; + $hdl->push_read (line => sub { + my ($hdl, $line) = @_; + warn "got line <$line>\n"; $cv->send; }); @@ -83,17 +81,15 @@ Set the callback to be called when an end-of-file condition is detected, i.e. in the case of a socket, when the other side has closed the -connection cleanly. +connection cleanly, and there are no outstanding read requests in the +queue (if there are read requests, then an EOF counts as an unexpected +connection close and will be flagged as an error). For sockets, this just means that the other side has stopped sending data, you can still try to write data, and, in fact, one can return from the EOF callback and continue writing data, as only the read part has been shut down. -While not mandatory, it is I recommended to set an EOF callback, -otherwise you might end up with a closed socket while you are still -waiting for data. - If an EOF condition has been detected but no C callback has been set, then a fatal error will be raised with C<$!> set to <0>. @@ -104,10 +100,10 @@ connect or a read error. Some errors are fatal (which is indicated by C<$fatal> being true). On -fatal errors the handle object will be shut down and will not be usable -(but you are free to look at the current C<< ->rbuf >>). Examples of fatal -errors are an EOF condition with active (but unsatisifable) read watchers -(C) or I/O errors. +fatal errors the handle object will be destroyed (by a call to C<< -> +destroy >>) after invoking the error callback (which means you are free to +examine the handle object). Examples of fatal errors are an EOF condition +with active (but unsatisifable) read watchers (C) or I/O errors. AnyEvent::Handle tries to find an appropriate error code for you to check against, but in some cases (TLS errors), this does not work well. It is @@ -135,7 +131,7 @@ read buffer). To access (and remove data from) the read buffer, use the C<< ->rbuf >> -method or access the C<$handle->{rbuf}> member directly. Note that you +method or access the C<< $handle->{rbuf} >> member directly. Note that you must not enlarge or modify the read buffer, you can only remove data at the beginning from it. @@ -144,6 +140,11 @@ calling the C callback. If no progress can be made, then a fatal error will be raised (with C<$!> set to C). +Note that, unlike requests in the read queue, an C callback +doesn't mean you I some data: if there is an EOF and there +are outstanding read requests then an error will be flagged. With an +C callback, the C callback will be invoked. + =item on_drain => $cb->($handle) This sets the callback that is called when the write buffer becomes empty @@ -251,7 +252,9 @@ (I IDN!) used to create the connection, rarely the IP address. Apart from being useful in error messages, this string is also used in TLS -common name verification (see C in L). +peername verification (see C in L). This +verification will be skipped when C is not specified or +C. =item tls => "accept" | "connect" | Net::SSLeay::SSL object @@ -298,6 +301,38 @@ => value >> pairs. Those will be passed to L to create a new TLS context object. +=item on_starttls => $cb->($handle, $success[, $error_message]) + +This callback will be invoked when the TLS/SSL handshake has finished. If +C<$success> is true, then the TLS handshake succeeded, otherwise it failed +(C will not be called in this case). + +The session in C<< $handle->{tls} >> can still be examined in this +callback, even when the handshake was not successful. + +TLS handshake failures will not cause C to be invoked when this +callback is in effect, instead, the error message will be passed to C. + +Without this callback, handshake failures lead to C being +called, as normal. + +Note that you cannot call C right again in this callback. If you +need to do that, start an zero-second timer instead whose callback can +then call C<< ->starttls >> again. + +=item on_stoptls => $cb->($handle) + +When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is +set, then it will be invoked after freeing the TLS session. If it is not, +then a TLS shutdown condition will be treated like a normal EOF condition +on the handle. + +The session in C<< $handle->{tls} >> can still be examined in this +callback. + +This callback will only be called on TLS shutdowns, not when the +underlying handle signals EOF. + =item json => JSON or JSON::XS object This is the json coder object used by the C read and write types. @@ -329,7 +364,7 @@ $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) if $self->{tls}; - $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain}; + $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; $self->start_read if $self->{on_read}; @@ -337,27 +372,26 @@ $self->{fh} && $self } -sub _shutdown { - my ($self) = @_; - - delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)}; - $self->{_eof} = 1; # tell starttls et. al to stop trying - - &_freetls; -} +#sub _shutdown { +# my ($self) = @_; +# +# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)}; +# $self->{_eof} = 1; # tell starttls et. al to stop trying +# +# &_freetls; +#} sub _error { my ($self, $errno, $fatal, $message) = @_; - $self->_shutdown - if $fatal; - $! = $errno; $message ||= "$!"; if ($self->{on_error}) { $self->{on_error}($self, $fatal, $message); + $self->destroy if $fatal; } elsif ($self->{fh}) { + $self->destroy; Carp::croak "AnyEvent::Handle uncaught error: $message"; } } @@ -429,6 +463,26 @@ }; } +=item $handle->on_starttls ($cb) + +Replace the current C callback (see the C constructor argument). + +=cut + +sub on_starttls { + $_[0]{on_starttls} = $_[1]; +} + +=item $handle->on_stoptls ($cb) + +Replace the current C callback (see the C constructor argument). + +=cut + +sub on_starttls { + $_[0]{on_stoptls} = $_[1]; +} + ############################################################################# =item $handle->timeout ($seconds) @@ -462,7 +516,7 @@ if ($self->{on_timeout}) { $self->{on_timeout}($self); } else { - $self->_error (&Errno::ETIMEDOUT); + $self->_error (Errno::ETIMEDOUT); } # callback could have changed timeout value, optimise @@ -535,7 +589,7 @@ my $cb = sub { my $len = syswrite $self->{fh}, $self->{wbuf}; - if ($len >= 0) { + if (defined $len) { substr $self->{wbuf}, 0, $len, ""; $self->{_activity} = AnyEvent->now; @@ -685,8 +739,9 @@ Sometimes you know you want to close the socket after writing your data before it was actually written. One way to do that is to replace your -C handler by a callback that shuts down the socket. This method -is a shorthand for just that, and replaces the C callback with: +C handler by a callback that shuts down the socket (and set +C to C<0>). This method is a shorthand for just that, and +replaces the C callback with: sub { shutdown $_[0]{fh}, 1 } # for push_shutdown @@ -699,7 +754,10 @@ =cut sub push_shutdown { - $_[0]->{on_drain} = sub { shutdown $_[0]{fh}, 1 }; + my ($self) = @_; + + delete $self->{low_water_mark}; + $self->on_drain (sub { shutdown $_[0]{fh}, 1 }); } =item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) @@ -810,7 +868,7 @@ defined $self->{rbuf_max} && $self->{rbuf_max} < length $self->{rbuf} ) { - $self->_error (&Errno::ENOSPC, 1), return; + $self->_error (Errno::ENOSPC, 1), return; } while () { @@ -824,7 +882,7 @@ unless ($cb->($self)) { if ($self->{_eof}) { # no progress can be made (not enough data and no data forthcoming) - $self->_error (&Errno::EPIPE, 1), return; + $self->_error (Errno::EPIPE, 1), return; } unshift @{ $self->{_queue} }, $cb; @@ -842,7 +900,7 @@ ) { # no further data will arrive # so no progress can be made - $self->_error (&Errno::EPIPE, 1), return + $self->_error (Errno::EPIPE, 1), return if $self->{_eof}; last; # more data might arrive @@ -858,7 +916,7 @@ if ($self->{on_eof}) { $self->{on_eof}($self) } else { - $self->_error (0, 1); + $self->_error (0, 1, "Unexpected end-of-file"); } } @@ -1102,7 +1160,7 @@ # reject if ($reject && $$rbuf =~ $reject) { - $self->_error (&Errno::EBADMSG); + $self->_error (Errno::EBADMSG); } # skip @@ -1128,7 +1186,7 @@ sub { unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { if ($_[0]{rbuf} =~ /[^0-9]/) { - $self->_error (&Errno::EBADMSG); + $self->_error (Errno::EBADMSG); } return; } @@ -1141,7 +1199,7 @@ if ($_[1] eq ",") { $cb->($_[0], $string); } else { - $self->_error (&Errno::EBADMSG); + $self->_error (Errno::EBADMSG); } }); }); @@ -1241,7 +1299,7 @@ $self->{rbuf} = $json->incr_text; $json->incr_text = ""; - $self->_error (&Errno::EBADMSG); + $self->_error (Errno::EBADMSG); () } else { @@ -1288,7 +1346,7 @@ if (my $ref = eval { Storable::thaw ($_[1]) }) { $cb->($_[0], $ref); } else { - $self->_error (&Errno::EBADMSG); + $self->_error (Errno::EBADMSG); } }); } @@ -1379,7 +1437,6 @@ our $ERROR_SYSCALL; our $ERROR_WANT_READ; -our $ERROR_ZERO_RETURN; sub _tls_error { my ($self, $err) = @_; @@ -1392,7 +1449,13 @@ # reduce error string to look less scary $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /; - $self->_error (&Errno::EPROTO, 1, $err); + if ($self->{_on_starttls}) { + (delete $self->{_on_starttls})->($self, undef, $err); + &_freetls; + } else { + &_freetls; + $self->_error (Errno::EPROTO, 1, $err); + } } # poll the write BIO and send the data if applicable @@ -1413,16 +1476,23 @@ $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp); return $self->_tls_error ($tmp) if $tmp != $ERROR_WANT_READ - && ($tmp != $ERROR_SYSCALL || $!) - && $tmp != $ERROR_ZERO_RETURN; + && ($tmp != $ERROR_SYSCALL || $!); } while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { unless (length $tmp) { - # let's treat SSL-eof as we treat normal EOF - delete $self->{_rw}; - $self->{_eof} = 1; + $self->{_on_starttls} + and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ??? &_freetls; + + if ($self->{on_stoptls}) { + $self->{on_stoptls}($self); + return; + } else { + # let's treat SSL-eof as we treat normal EOF + delete $self->{_rw}; + $self->{_eof} = 1; + } } $self->{_tls_rbuf} .= $tmp; @@ -1433,13 +1503,16 @@ $tmp = Net::SSLeay::get_error ($self->{tls}, -1); return $self->_tls_error ($tmp) if $tmp != $ERROR_WANT_READ - && ($tmp != $ERROR_SYSCALL || $!) - && $tmp != $ERROR_ZERO_RETURN; + && ($tmp != $ERROR_SYSCALL || $!); while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) { $self->{wbuf} .= $tmp; $self->_drain_wbuf; } + + $self->{_on_starttls} + and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK () + and (delete $self->{_on_starttls})->($self, 1, "TLS/SSL connection established"); } =item $handle->starttls ($tls[, $tls_ctx]) @@ -1476,9 +1549,8 @@ Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object" if $self->{tls}; - $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); - $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); - $ERROR_ZERO_RETURN = Net::SSLeay::ERROR_ZERO_RETURN (); + $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); + $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); $ctx ||= $self->{tls_ctx}; @@ -1520,6 +1592,9 @@ Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); + $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } + if $self->{on_starttls}; + &_dotls; # need to trigger the initial handshake $self->start_read; # make sure we actually do read } @@ -1541,9 +1616,9 @@ &_dotls; - # we don't give a shit. no, we do, but we can't. no... - # we, we... have to use openssl :/ - &_freetls; +# # we don't give a shit. no, we do, but we can't. no...#d# +# # we, we... have to use openssl :/#d# +# &_freetls;#d# } } @@ -1554,7 +1629,7 @@ $self->{tls_ctx}->_put_session (delete $self->{tls}); - delete @$self{qw(_rbio _wbio _tls_wbuf)}; + delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; } sub DESTROY { @@ -1588,8 +1663,8 @@ =item $handle->destroy Shuts down the handle object as much as possible - this call ensures that -no further callbacks will be invoked and resources will be freed as much -as possible. You must not call any methods on the object afterwards. +no further callbacks will be invoked and as many resources as possible +will be freed. You must not call any methods on the object afterwards. Normally, you can just "forget" any references to an AnyEvent::Handle object and it will simply shut down. This works in fatal error and EOF @@ -1598,6 +1673,11 @@ within such an callback. You I call C<< ->destroy >> explicitly in that case. +Destroying the handle object in this way has the advantage that callbacks +will be removed as well, so if those are the only reference holders (as +is common), then one doesn't need to do anything special to break any +reference cycles. + The handle might still linger in the background and write out remaining data, as specified by the C option, however. @@ -1674,7 +1754,6 @@ $handle->on_eof (undef); $handle->on_error (sub { my $data = delete $_[0]{rbuf}; - undef $handle; }); The reason to use C is that TCP connections, due to latencies @@ -1700,6 +1779,94 @@ undef $handle; }); +If you just want to queue some data and then signal EOF to the other side, +consider using C<< ->push_shutdown >> instead. + +=item I want to contact a TLS/SSL server, I don't care about security. + +If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS, +simply connect to it and then create the AnyEvent::Handle with the C +parameter: + + tcp_connect $host, $port, sub { + my ($fh) = @_; + + my $handle = new AnyEvent::Handle + fh => $fh, + tls => "connect", + on_error => sub { ... }; + + $handle->push_write (...); + }; + +=item I want to contact a TLS/SSL server, I do care about security. + +Then you should additionally enable certificate verification, including +peername verification, if the protocol you use supports it (see +L, C). + +E.g. for HTTPS: + + tcp_connect $host, $port, sub { + my ($fh) = @_; + + my $handle = new AnyEvent::Handle + fh => $fh, + peername => $host, + tls => "connect", + tls_ctx => { verify => 1, verify_peername => "https" }, + ... + +Note that you must specify the hostname you connected to (or whatever +"peername" the protocol needs) as the C argument, otherwise no +peername verification will be done. + +The above will use the system-dependent default set of trusted CA +certificates. If you want to check against a specific CA, add the +C (or C) arguments to C: + + tls_ctx => { + verify => 1, + verify_peername => "https", + ca_file => "my-ca-cert.pem", + }, + +=item I want to create a TLS/SSL server, how do I do that? + +Well, you first need to get a server certificate and key. You have +three options: a) ask a CA (buy one, use cacert.org etc.) b) create a +self-signed certificate (cheap. check the search engine of your choice, +there are many tutorials on the net) or c) make your own CA (tinyca2 is a +nice program for that purpose). + +Then create a file with your private key (in PEM format, see +L), followed by the certificate (also in PEM format). The +file should then look like this: + + -----BEGIN RSA PRIVATE KEY----- + ...header data + ... lots of base64'y-stuff + -----END RSA PRIVATE KEY----- + + -----BEGIN CERTIFICATE----- + ... lots of base64'y-stuff + -----END CERTIFICATE----- + +The important bits are the "PRIVATE KEY" and "CERTIFICATE" parts. Then +specify this file as C: + + tcp_server undef, $port, sub { + my ($fh) = @_; + + my $handle = new AnyEvent::Handle + fh => $fh, + tls => "accept", + tls_ctx => { cert_file => "my-server-keycert.pem" }, + ... + +When you have intermediate CA certificates that your clients might not +know about, just append them to the C. + =back