--- AnyEvent/lib/AnyEvent/Handle.pm 2009/07/06 01:03:09 1.141 +++ AnyEvent/lib/AnyEvent/Handle.pm 2009/07/10 22:35:28 1.148 @@ -16,7 +16,7 @@ =cut -our $VERSION = 4.452; +our $VERSION = 4.82; =head1 SYNOPSIS @@ -251,7 +251,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 -peername 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 +300,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 +363,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}; @@ -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) @@ -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) @@ -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 { @@ -1700,6 +1775,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