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.246 by root, Sun Jun 28 09:30:37 2015 UTC vs.
Revision 1.253 by root, Fri Feb 7 15:06:01 2020 UTC

… …
755 $_[0]{oobinline} = $_[1]; 755 $_[0]{oobinline} = $_[1];
756 756
757 eval { 757 eval {
758 local $SIG{__DIE__}; 758 local $SIG{__DIE__};
759 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1] 759 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1]
760 if $_[0]{fh};
761 };
762}
763
764=item $handle->keepalive ($boolean)
765
766Enables or disables the C<keepalive> setting (see constructor argument of
767the same name for details).
768
769=cut
770
771sub keepalive {
772 $_[0]{keepalive} = $_[1];
773
774 eval {
775 local $SIG{__DIE__};
776 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
777 if $_[0]{fh}; 760 if $_[0]{fh};
778 }; 761 };
779} 762}
780 763
781=item $handle->on_starttls ($cb) 764=item $handle->on_starttls ($cb)
… …
1873is handled, up to the fictituous protocol 4.x (but both SSL3+ and 1856is handled, up to the fictituous protocol 4.x (but both SSL3+ and
1874SSL2-compatible framing is supported). 1857SSL2-compatible framing is supported).
1875 1858
1876If it detects that the input data is likely TLS, it calls the callback 1859If it detects that the input data is likely TLS, it calls the callback
1877with a true value for C<$detect> and the (on-wire) TLS version as second 1860with a true value for C<$detect> and the (on-wire) TLS version as second
1878and third argument (C<$major> is C<3>, and C<$minor> is 0..3 for SSL 1861and third argument (C<$major> is C<3>, and C<$minor> is 0..4 for SSL
18793.0, TLS 1.0, 1.1 and 1.2, respectively). If it detects the input to 18623.0, TLS 1.0, 1.1, 1.2 and 1.3, respectively). If it detects the input
1880be definitely not TLS, it calls the callback with a false value for 1863to be definitely not TLS, it calls the callback with a false value for
1881C<$detect>. 1864C<$detect>.
1882 1865
1883The callback could use this information to decide whether or not to start 1866The callback could use this information to decide whether or not to start
1884TLS negotiation. 1867TLS negotiation.
1885 1868
… …
1895accomodate protocol changes. 1878accomodate protocol changes.
1896 1879
1897This read type does not rely on L<AnyEvent::TLS> (and thus, not on 1880This read type does not rely on L<AnyEvent::TLS> (and thus, not on
1898L<Net::SSLeay>). 1881L<Net::SSLeay>).
1899 1882
1900=item tls_autostart => $tls[, $tls_ctx] 1883=item tls_autostart => [$tls_ctx, ]$tls
1901 1884
1902Tries to detect a valid SSL or TLS handshake. If one is detected, it tries 1885Tries to detect a valid SSL or TLS handshake. If one is detected, it tries
1903to start tls by calling C<starttls> with the given arguments. 1886to start tls by calling C<starttls> with the given arguments.
1904 1887
1905In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has 1888In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has
… …
1909See C<tls_detect> above for more details. 1892See C<tls_detect> above for more details.
1910 1893
1911Example: give the client a chance to start TLS before accepting a text 1894Example: give the client a chance to start TLS before accepting a text
1912line. 1895line.
1913 1896
1914 $hdl->push_read (tls_detect => "accept"); 1897 $hdl->push_read (tls_autostart => "accept");
1915 $hdl->push_read (line => sub { 1898 $hdl->push_read (line => sub {
1916 print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n"; 1899 print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n";
1917 }); 1900 });
1918 1901
1919=cut 1902=cut
… …
1931 ) { 1914 ) {
1932 return if 3 != length $1; # partial match, can't decide yet 1915 return if 3 != length $1; # partial match, can't decide yet
1933 1916
1934 # full match, valid TLS record 1917 # full match, valid TLS record
1935 my ($major, $minor) = unpack "CC", $1; 1918 my ($major, $minor) = unpack "CC", $1;
1936 $cb->($self, "accept", $major + $minor * 0.1); 1919 $cb->($self, "accept", $major, $minor);
1937 } else { 1920 } else {
1938 # mismatch == guaranteed not TLS 1921 # mismatch == guaranteed not TLS
1939 $cb->($self, undef); 1922 $cb->($self, undef);
1940 } 1923 }
1941 1924
… …
2073 } 2056 }
2074} 2057}
2075 2058
2076# poll the write BIO and send the data if applicable 2059# poll the write BIO and send the data if applicable
2077# also decode read data if possible 2060# also decode read data if possible
2078# this is basiclaly our TLS state machine 2061# this is basically our TLS state machine
2079# more efficient implementations are possible with openssl, 2062# more efficient implementations are possible with openssl,
2080# but not with the buggy and incomplete Net::SSLeay. 2063# but not with the buggy and incomplete Net::SSLeay.
2081sub _dotls { 2064sub _dotls {
2082 my ($self) = @_; 2065 my ($self) = @_;
2083 2066
… …
2210 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername}); 2193 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
2211 2194
2212 # basically, this is deep magic (because SSL_read should have the same issues) 2195 # basically, this is deep magic (because SSL_read should have the same issues)
2213 # but the openssl maintainers basically said: "trust us, it just works". 2196 # but the openssl maintainers basically said: "trust us, it just works".
2214 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 2197 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
2215 # and mismaintained ssleay-module doesn't even offer them). 2198 # and mismaintained ssleay-module didn't offer them for a decade or so).
2216 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 2199 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
2217 # 2200 #
2218 # in short: this is a mess. 2201 # in short: this is a mess.
2219 # 2202 #
2220 # note that we do not try to keep the length constant between writes as we are required to do. 2203 # note that we do not try to keep the length constant between writes as we are required to do.
2221 # we assume that most (but not all) of this insanity only applies to non-blocking cases, 2204 # we assume that most (but not all) of this insanity only applies to non-blocking cases,
2222 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 2205 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
2223 # have identity issues in that area. 2206 # have identity issues in that area.
2224# Net::SSLeay::CTX_set_mode ($ssl, 2207# Net::SSLeay::set_mode ($ssl,
2225# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 2208# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
2226# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 2209# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
2227 Net::SSLeay::CTX_set_mode ($tls, 1|2); 2210 Net::SSLeay::set_mode ($tls, 1|2);
2228 2211
2229 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 2212 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
2230 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 2213 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
2231 2214
2232 Net::SSLeay::BIO_write ($self->{_rbio}, $self->{rbuf}); 2215 Net::SSLeay::BIO_write ($self->{_rbio}, $self->{rbuf});
… …
2272 2255
2273 return unless $self->{tls}; 2256 return unless $self->{tls};
2274 2257
2275 $self->{tls_ctx}->_put_session (delete $self->{tls}) 2258 $self->{tls_ctx}->_put_session (delete $self->{tls})
2276 if $self->{tls} > 0; 2259 if $self->{tls} > 0;
2277 2260
2278 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 2261 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
2279} 2262}
2280 2263
2281=item $handle->resettls 2264=item $handle->resettls
2282 2265

Diff Legend

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