[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Handle.pm

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.135 by root, Fri Jul 3 08:51:48 2009 UTC vs.
Revision 1.144 by root, Mon Jul 6 21:38:25 2009 UTC

 AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
 =cut
-our $VERSION = 4.45;
+our $VERSION = 4.452;
 =head1 SYNOPSIS
    use AnyEvent;
    use AnyEvent::Handle;
 and no read request is in the queue (unlike read queue callbacks, this
 callback will only be called when at least one octet of data is in the
 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.
 When an EOF condition is detected then AnyEvent::Handle will first try to
 feed all the remaining data to the queued callbacks and C<on_read> before
 A string used to identify the remote site - usually the DNS hostname
 (I<not> 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<verify_cn> in L<AnyEvent::TLS>).
+peername verification (see C<verify_peername> in L<AnyEvent::TLS>). This
+verification will be skipped when C<peername> is not specified or
+C<undef>.
 =item tls => "accept" | "connect" | Net::SSLeay::SSL object
 When this parameter is given, it enables TLS (SSL) mode, that means
 AnyEvent will start a TLS handshake as soon as the conenction has been
 Instead of an object, you can also specify a hash reference with C<< key
 => value >> pairs. Those will be passed to L<AnyEvent::TLS> 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<on_stoptls> 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<on_error> to be invoked when this
+callback is in effect, instead, the error message will be passed to C<on_starttls>.
+Without this callback, handshake failures lead to C<on_error> being
+called, as normal.
+Note that you cannot call C<starttls> 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<json> read and write types.
 If you don't supply it, then AnyEvent::Handle will create and use a
    $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
    $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};
    $self->{fh} && $self
    eval {
       local $SIG{__DIE__};
       setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1];
    };
+}
+=item $handle->on_starttls ($cb)
+Replace the current C<on_starttls> callback (see the C<on_starttls> constructor argument).
+=cut
+sub on_starttls {
+   $_[0]{on_starttls} = $_[1];
+}
+=item $handle->on_stoptls ($cb)
+Replace the current C<on_stoptls> callback (see the C<on_stoptls> constructor argument).
+=cut
+sub on_starttls {
+   $_[0]{on_stoptls} = $_[1];
 }
 #############################################################################
 =item $handle->timeout ($seconds)
 =item $handle->push_shutdown
 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<on_drain> handler by a callback that shuts down the socket. This method
+C<on_drain> handler by a callback that shuts down the socket (and set
-is a shorthand for just that, and replaces the C<on_drain> callback with:
+C<low_water_mark> to C<0>). This method is a shorthand for just that, and
+replaces the C<on_drain> callback with:
    sub { shutdown $_[0]{fh}, 1 }    # for push_shutdown
 This simply shuts down the write side and signals an EOF condition to the
 the peer.
 afterwards. This is the cleanest way to close a connection.
 =cut
 sub push_shutdown {
+   my ($self) = @_;
+   delete $self->{low_water_mark};
-   $_[0]->{on_drain} = sub { shutdown $_[0]{fh}, 1 };
+   $self->on_drain (sub { shutdown $_[0]{fh}, 1 });
 }
 =item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
 This function (not method) lets you add your own types to C<push_write>.
    if ($self->{_eof}) {
       if ($self->{on_eof}) {
          $self->{on_eof}($self)
       } else {
-         $self->_error (0, 1);
+         $self->_error (0, 1, "Unexpected end-of-file");
       }
    }
    # may need to restart read watcher
    unless ($self->{_rw}) {
    }
 }
 our $ERROR_SYSCALL;
 our $ERROR_WANT_READ;
-our $ERROR_ZERO_RETURN;
 sub _tls_error {
    my ($self, $err) = @_;
-      warn "$err,$!\n";#d#
    return $self->_error ($!, 1)
       if $err == Net::SSLeay::ERROR_SYSCALL ();
+   my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
+   # reduce error string to look less scary
+   $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
+   if ($self->{_on_starttls}) {
+      (delete $self->{_on_starttls})->($self, undef, $err);
+      &_freetls;
+   } else {
+      &_freetls;
-   $self->_error (&Errno::EPROTO, 1,
+      $self->_error (&Errno::EPROTO, 1, $err);
-                  Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()));
+   }
 }
 # poll the write BIO and send the data if applicable
 # also decode read data if possible
 # this is basiclaly our TLS state machine
       }
       $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);
       return $self->_tls_error ($tmp)
          if $tmp != $ERROR_WANT_READ
-            && ($tmp != $ERROR_SYSCALL || $!)
+            && ($tmp != $ERROR_SYSCALL || $!);
-            && $tmp != $ERROR_ZERO_RETURN;
    }
    while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
       unless (length $tmp) {
-         # let's treat SSL-eof as we treat normal EOF
+         $self->{_on_starttls}
-         delete $self->{_rw};
+            and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ???
-         $self->{_eof} = 1;
          &_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;
       $self->_drain_rbuf unless $self->{_in_drain};
       $self->{tls} or return; # tls session might have gone away in callback
    }
    $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
    return $self->_tls_error ($tmp)
       if $tmp != $ERROR_WANT_READ
-         && ($tmp != $ERROR_SYSCALL || $!)
+         && ($tmp != $ERROR_SYSCALL || $!);
-         && $tmp != $ERROR_ZERO_RETURN;
    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])
 Instead of starting TLS negotiation immediately when the AnyEvent::Handle
 If it an error to start a TLS handshake more than once per
 AnyEvent::Handle object (this is due to bugs in OpenSSL).
 =cut
+our %TLS_CACHE; #TODO not yet documented, should we?
 sub starttls {
    my ($self, $ssl, $ctx) = @_;
    require Net::SSLeay;
    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_SYSCALL   = Net::SSLeay::ERROR_SYSCALL     ();
-   $ERROR_WANT_READ   = Net::SSLeay::ERROR_WANT_READ   ();
+   $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ   ();
-   $ERROR_ZERO_RETURN = Net::SSLeay::ERROR_ZERO_RETURN ();
    $ctx ||= $self->{tls_ctx};
    if ("HASH" eq ref $ctx) {
       require AnyEvent::TLS;
       local $Carp::CarpLevel = 1; # skip ourselves when creating a new context
+      if ($ctx->{cache}) {
+         my $key = $ctx+0;
+         $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
+      } else {
-      $ctx = new AnyEvent::TLS %$ctx;
+         $ctx = new AnyEvent::TLS %$ctx;
+      }
    }
    $self->{tls_ctx} = $ctx || TLS_CTX ();
    $self->{tls}     = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername});
    $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
    $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
    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
 }
 =item $handle->stoptls
    if ($self->{tls}) {
       Net::SSLeay::shutdown ($self->{tls});
       &_dotls;
-      # we don't give a shit. no, we do, but we can't. no...
+#      # we don't give a shit. no, we do, but we can't. no...#d#
-      # we, we... have to use openssl :/
+#      # we, we... have to use openssl :/#d#
-      &_freetls;
+#      &_freetls;#d#
    }
 }
 sub _freetls {
    my ($self) = @_;
    return unless $self->{tls};
    $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 {
    my ($self) = @_;
 }
 =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
+no further callbacks will be invoked and as many resources as possible
-as possible. You must not call any methods on the object afterwards.
+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
 callbacks, as well as code outside. It does I<NOT> work in a read or write
 callback, so when you want to destroy the AnyEvent::Handle object from
    $handle->on_drain (sub {
       warn "all data submitted to the kernel\n";
       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<tls>
+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<AnyEvent::TLS>, C<verify_peername>).
+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<peername> 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<ca_file> (or C<ca_cert>) arguments to C<tls_ctx>:
+       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<AnyEvent::TLS>), 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<cert_file>:
+   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<cert_file>.
 =back
 =head1 SUBCLASSING AnyEvent::Handle

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents): Revision 1.135 by root, Fri Jul 3 08:51:48 2009 UTC vs. Revision 1.144 by root, Mon Jul 6 21:38:25 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.135 by root, Fri Jul 3 08:51:48 2009 UTC vs.
Revision 1.144 by root, Mon Jul 6 21:38:25 2009 UTC