AnyEvent
view release on metacpan or search on metacpan
lib/AnyEvent/Handle.pm view on Meta::CPAN
};
=item tls_detect => $cb->($handle, $detect, $major, $minor)
Checks the input stream for a valid SSL or TLS handshake TLSPaintext
record without consuming anything. Only SSL version 3 or higher
is handled, up to the fictituous protocol 4.x (but both SSL3+ and
SSL2-compatible framing is supported).
If it detects that the input data is likely TLS, it calls the callback
with a true value for C<$detect> and the (on-wire) TLS version as second
and third argument (C<$major> is C<3>, and C<$minor> is 0..4 for SSL
3.0, TLS 1.0, 1.1, 1.2 and 1.3, respectively). If it detects the input
to be definitely not TLS, it calls the callback with a false value for
C<$detect>.
The callback could use this information to decide whether or not to start
TLS negotiation.
In all cases the data read so far is passed to the following read
handlers.
Usually you want to use the C<tls_autostart> read type instead.
If you want to design a protocol that works in the presence of TLS
dtection, make sure that any non-TLS data doesn't start with the octet 22
(ASCII SYN, 16 hex) or 128-255 (i.e. highest bit set). The checks this
read type does are a bit more strict, but might losen in the future to
accomodate protocol changes.
This read type does not rely on L<AnyEvent::TLS> (and thus, not on
L<Net::SSLeay>).
=item tls_autostart => [$tls_ctx, ]$tls
Tries to detect a valid SSL or TLS handshake. If one is detected, it tries
to start tls by calling C<starttls> with the given arguments.
In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has
been configured to accept, as servers do not normally send a handshake on
their own and ths cannot be detected in this way.
See C<tls_detect> above for more details.
Example: give the client a chance to start TLS before accepting a text
line.
$hdl->push_read (tls_autostart => "accept");
$hdl->push_read (line => sub {
print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n";
});
=cut
register_read_type tls_detect => sub {
my ($self, $cb) = @_;
sub {
# this regex matches a full or partial tls record
if (
# ssl3+: type(22=handshake) major(=3) minor(any) length_hi
$self->{rbuf} =~ /^(?:\z| \x16 (\z| [\x03\x04] (?:\z| . (?:\z| [\x00-\x40] ))))/xs
# ssl2 comapatible: len_hi len_lo type(1) major minor dummy(forlength)
or $self->{rbuf} =~ /^(?:\z| [\x80-\xff] (?:\z| . (?:\z| \x01 (\z| [\x03\x04] (?:\z| . (?:\z| . ))))))/xs
) {
return if 3 != length $1; # partial match, can't decide yet
# full match, valid TLS record
my ($major, $minor) = unpack "CC", $1;
$cb->($self, "accept", $major, $minor);
} else {
# mismatch == guaranteed not TLS
$cb->($self, undef);
}
1
}
};
register_read_type tls_autostart => sub {
my ($self, @tls) = @_;
$RH{tls_detect}($self, sub {
return unless $_[1];
$_[0]->starttls (@tls);
})
};
=back
=item custom read types - Package::anyevent_read_type $handle, $cb, @args
Instead of one of the predefined types, you can also specify the name
of a package. AnyEvent will try to load the package and then expects to
find a function named C<anyevent_read_type> inside. If it isn't found, it
progressively tries to load the parent package until it either finds the
function (good) or runs out of packages (bad).
Whenever this type is used, C<push_read> will invoke the function with the
handle object, the original callback and the remaining arguments.
The function is supposed to return a callback (usually a closure) that
works as a plain read callback (see C<< ->push_read ($cb) >>), so you can
mentally treat the function as a "configurable read type to read callback"
converter.
It should invoke the original callback when it is done reading (remember
to pass C<$handle> as first argument as all other callbacks do that,
although there is no strict requirement on this).
For examples, see the source of this module (F<perldoc -m
AnyEvent::Handle>, search for C<register_read_type>)).
=item $handle->stop_read
=item $handle->start_read
In rare cases you actually do not want to read anything from the
socket. In this case you can call C<stop_read>. Neither C<on_read> nor
any queued callbacks will be executed then. To start reading again, call
C<start_read>.
Note that AnyEvent::Handle will automatically C<start_read> for you when
lib/AnyEvent/Handle.pm view on Meta::CPAN
$self->{_rw} = AE::io $self->{fh}, 0, sub {
my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});
my $len = sysread $self->{fh}, $$rbuf, $self->{read_size}, length $$rbuf;
if ($len > 0) {
$self->{_activity} = $self->{_ractivity} = AE::now;
if ($self->{tls}) {
Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
&_dotls ($self);
} else {
$self->_drain_rbuf;
}
if ($len == $self->{read_size}) {
$self->{read_size} *= 2;
$self->{read_size} = $self->{max_read_size} || MAX_READ_SIZE
if $self->{read_size} > ($self->{max_read_size} || MAX_READ_SIZE);
}
} elsif (defined $len) {
delete $self->{_rw};
$self->{_eof} = 1;
$self->_drain_rbuf;
} elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) {
return $self->_error ($!, 1);
}
};
}
}
our $ERROR_SYSCALL;
our $ERROR_WANT_READ;
sub _tls_error {
my ($self, $err) = @_;
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, $err);
}
}
# poll the write BIO and send the data if applicable
# also decode read data if possible
# this is basiclaly our TLS state machine
# more efficient implementations are possible with openssl,
# but not with the buggy and incomplete Net::SSLeay.
sub _dotls {
my ($self) = @_;
my $tmp;
while (length $self->{_tls_wbuf}) {
if (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) <= 0) {
$tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);
return $self->_tls_error ($tmp)
if $tmp != $ERROR_WANT_READ
&& ($tmp != $ERROR_SYSCALL || $!);
last;
}
substr $self->{_tls_wbuf}, 0, $tmp, "";
}
while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
unless (length $tmp) {
$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;
$self->_drain_rbuf;
$self->{tls} or return; # tls session might have gone away in callback
}
$tmp = Net::SSLeay::get_error ($self->{tls}, -1); # -1 is not neccessarily correct, but Net::SSLeay doesn't tell us
return $self->_tls_error ($tmp)
if $tmp != $ERROR_WANT_READ
&& ($tmp != $ERROR_SYSCALL || $!);
while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) {
$self->{wbuf} .= $tmp;
$self->_drain_wbuf;
$self->{tls} or return; # tls session might have gone away in callback
}
$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
lib/AnyEvent/Handle.pm view on Meta::CPAN
when AnyEvent::Handle has to create its own TLS connection object, or
a hash reference with C<< key => value >> pairs that will be used to
construct a new context.
The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
context in C<< $handle->{tls_ctx} >> after this call and can be used or
changed to your liking. Note that the handshake might have already started
when this function returns.
Due to bugs in OpenSSL, it might or might not be possible to do multiple
handshakes on the same stream. It is best to not attempt to use the
stream after stopping TLS.
This method may invoke callbacks (and therefore the handle might be
destroyed after it returns).
=cut
our %TLS_CACHE; #TODO not yet documented, should we?
sub starttls {
my ($self, $tls, $ctx) = @_;
Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
if $self->{tls};
unless (defined $AnyEvent::TLS::VERSION) {
eval {
require Net::SSLeay;
require AnyEvent::TLS;
1
} or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system");
}
$self->{tls} = $tls;
$self->{tls_ctx} = $ctx if @_ > 2;
return unless $self->{fh};
$ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
$ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
$tls = delete $self->{tls};
$ctx = $self->{tls_ctx};
local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
if ("HASH" eq ref $ctx) {
if ($ctx->{cache}) {
my $key = $ctx+0;
$ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
} else {
$ctx = new AnyEvent::TLS %$ctx;
}
}
$self->{tls_ctx} = $ctx || TLS_CTX ();
$self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
# basically, this is deep magic (because SSL_read should have the same issues)
# but the openssl maintainers basically said: "trust us, it just works".
# (unfortunately, we have to hardcode constants because the abysmally misdesigned
# and mismaintained ssleay-module didn't offer them for a decade or so).
# http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
#
# in short: this is a mess.
#
# note that we do not try to keep the length constant between writes as we are required to do.
# we assume that most (but not all) of this insanity only applies to non-blocking cases,
# and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
# have identity issues in that area.
# Net::SSLeay::set_mode ($ssl,
# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
Net::SSLeay::set_mode ($tls, 1|2);
$self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
$self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
Net::SSLeay::BIO_write ($self->{_rbio}, $self->{rbuf});
$self->{rbuf} = "";
Net::SSLeay::set_bio ($tls, $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
Shuts down the SSL connection - this makes a proper EOF handshake by
sending a close notify to the other side, but since OpenSSL doesn't
support non-blocking shut downs, it is not guaranteed that you can re-use
the stream afterwards.
This method may invoke callbacks (and therefore the handle might be
destroyed after it returns).
=cut
sub stoptls {
my ($self) = @_;
if ($self->{tls} && $self->{fh}) {
Net::SSLeay::shutdown ($self->{tls});
&_dotls;
# # we don't give a shit. no, we do, but we can't. no...#d#
# # we, we... have to use openssl :/#d#
# &_freetls;#d#
}
}
sub _freetls {
my ($self) = @_;
return unless $self->{tls};
$self->{tls_ctx}->_put_session (delete $self->{tls})
if $self->{tls} > 0;
delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
}
=item $handle->resettls
This rarely-used method simply resets and TLS state on the handle, usually
causing data loss.
One case where it may be useful is when you want to skip over the data in
the stream but you are not interested in interpreting it, so data loss is
no concern.
=cut
*resettls = \&_freetls;
sub DESTROY {
my ($self) = @_;
&_freetls;
my $linger = exists $self->{linger} ? $self->{linger} : 3600;
if ($linger && length $self->{wbuf} && $self->{fh}) {
my $fh = delete $self->{fh};
my $wbuf = delete $self->{wbuf};
my @linger;
push @linger, AE::io $fh, 1, sub {
my $len = syswrite $fh, $wbuf, length $wbuf;
if ($len > 0) {
substr $wbuf, 0, $len, "";
} elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK)) {
@linger = (); # end
}
};
push @linger, AE::timer $linger, 0, sub {
@linger = ();
};
}
}
=item $handle->destroy
Shuts down the handle object as much as possible - this call ensures that
no further callbacks will be invoked and as many resources as possible
lib/AnyEvent/Handle.pm view on Meta::CPAN
problem).
Having an outstanding read request at all times is possible if you ignore
C<EPIPE> errors, but this doesn't help with when the client drops the
connection during a request, which would still be an error.
A better solution is to push the initial request read in an C<on_read>
callback. This avoids an error, as when the server doesn't expect data
(i.e. is idly waiting for the next request, an EOF will not raise an
error, but simply result in an C<on_eof> callback. It is also a bit slower
and simpler:
# auth done, now go into request handling loop
$hdl->on_read (sub {
my ($hdl) = @_;
# called each time we receive data but the read queue is empty
# simply start read the request
$hdl->push_read (line => sub {
my ($hdl, $line) = @_;
... handle request
# do nothing special when the request has been handled, just
# let the request queue go empty.
});
});
=item I get different callback invocations in TLS mode/Why can't I pause
reading?
Unlike, say, TCP, TLS connections do not consist of two independent
communication channels, one for each direction. Or put differently, the
read and write directions are not independent of each other: you cannot
write data unless you are also prepared to read, and vice versa.
This means that, in TLS mode, you might get C<on_error> or C<on_eof>
callback invocations when you are not expecting any read data - the reason
is that AnyEvent::Handle always reads in TLS mode.
During the connection, you have to make sure that you always have a
non-empty read-queue, or an C<on_read> watcher. At the end of the
connection (or when you no longer want to use it) you can call the
C<destroy> method.
=item How do I read data until the other side closes the connection?
If you just want to read your data into a perl scalar, the easiest way
to achieve this is by setting an C<on_read> callback that does nothing,
clearing the C<on_eof> callback and in the C<on_error> callback, the data
will be in C<$_[0]{rbuf}>:
$handle->on_read (sub { });
$handle->on_eof (undef);
$handle->on_error (sub {
my $data = delete $_[0]{rbuf};
});
Note that this example removes the C<rbuf> member from the handle object,
which is not normally allowed by the API. It is expressly permitted in
this case only, as the handle object needs to be destroyed afterwards.
The reason to use C<on_error> is that TCP connections, due to latencies
and packets loss, might get closed quite violently with an error, when in
fact all data has been received.
It is usually better to use acknowledgements when transferring data,
to make sure the other side hasn't just died and you got the data
intact. This is also one reason why so many internet protocols have an
explicit QUIT command.
=item I don't want to destroy the handle too early - how do I wait until
all data has been written?
After writing your last bits of data, set the C<on_drain> callback
and destroy the handle in there - with the default setting of
C<low_water_mark> this will be called precisely when all data has been
written to the socket:
$handle->push_write (...);
$handle->on_drain (sub {
AE::log debug => "All data submitted to the kernel.";
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,
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",
( run in 1.193 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )