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.229 by root, Mon Feb 27 17:14:02 2012 UTC vs.
Revision 1.241 by root, Fri Sep 5 22:17:26 2014 UTC

11 11
12 my $hdl; $hdl = new AnyEvent::Handle 12 my $hdl; $hdl = new AnyEvent::Handle
13 fh => \*STDIN, 13 fh => \*STDIN,
14 on_error => sub { 14 on_error => sub {
15 my ($hdl, $fatal, $msg) = @_; 15 my ($hdl, $fatal, $msg) = @_;
16 AE::log error => "got error $msg\n"; 16 AE::log error => $msg;
17 $hdl->destroy; 17 $hdl->destroy;
18 $cv->send; 18 $cv->send;
19 }; 19 };
20 20
21 # send some request line 21 # send some request line
170with active (but unsatisfiable) read watchers (C<EPIPE>) or I/O errors. In 170with active (but unsatisfiable) read watchers (C<EPIPE>) or I/O errors. In
171cases where the other side can close the connection at will, it is 171cases where the other side can close the connection at will, it is
172often easiest to not report C<EPIPE> errors in this callback. 172often easiest to not report C<EPIPE> errors in this callback.
173 173
174AnyEvent::Handle tries to find an appropriate error code for you to check 174AnyEvent::Handle tries to find an appropriate error code for you to check
175against, but in some cases (TLS errors), this does not work well. It is 175against, but in some cases (TLS errors), this does not work well.
176recommended to always output the C<$message> argument in human-readable 176
177error messages (it's usually the same as C<"$!">). 177If you report the error to the user, it is recommended to always output
178the C<$message> argument in human-readable error messages (you don't need
179to report C<"$!"> if you report C<$message>).
180
181If you want to react programmatically to the error, then looking at C<$!>
182and comparing it against some of the documented C<Errno> values is usually
183better than looking at the C<$message>.
178 184
179Non-fatal errors can be retried by returning, but it is recommended 185Non-fatal errors can be retried by returning, but it is recommended
180to simply ignore this parameter and instead abondon the handle object 186to simply ignore this parameter and instead abondon the handle object
181when this callback is invoked. Examples of non-fatal errors are timeouts 187when this callback is invoked. Examples of non-fatal errors are timeouts
182C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>). 188C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
423appropriate error message. 429appropriate error message.
424 430
425TLS mode requires Net::SSLeay to be installed (it will be loaded 431TLS mode requires Net::SSLeay to be installed (it will be loaded
426automatically when you try to create a TLS handle): this module doesn't 432automatically when you try to create a TLS handle): this module doesn't
427have a dependency on that module, so if your module requires it, you have 433have a dependency on that module, so if your module requires it, you have
428to add the dependency yourself. 434to add the dependency yourself. If Net::SSLeay cannot be loaded or is too
435old, you get an C<EPROTO> error.
429 436
430Unlike TCP, TLS has a server and client side: for the TLS server side, use 437Unlike TCP, TLS has a server and client side: for the TLS server side, use
431C<accept>, and for the TLS client side of a connection, use C<connect> 438C<accept>, and for the TLS client side of a connection, use C<connect>
432mode. 439mode.
433 440
489callback. 496callback.
490 497
491This callback will only be called on TLS shutdowns, not when the 498This callback will only be called on TLS shutdowns, not when the
492underlying handle signals EOF. 499underlying handle signals EOF.
493 500
494=item json => JSON or JSON::XS object 501=item json => L<JSON>, L<JSON::PP> or L<JSON::XS> object
495 502
496This is the json coder object used by the C<json> read and write types. 503This is the json coder object used by the C<json> read and write types.
497 504
498If you don't supply it, then AnyEvent::Handle will create and use a 505If you don't supply it, then AnyEvent::Handle will create and use a
499suitable one (on demand), which will write and expect UTF-8 encoded JSON 506suitable one (on demand), which will write and expect UTF-8 encoded
507JSON texts (either using L<JSON::XS> or L<JSON>). The written texts are
508guaranteed not to contain any newline character.
509
510For security reasons, this encoder will likely I<not> handle numbers and
511strings, only arrays and objects/hashes. The reason is that originally
512JSON was self-delimited, but Dougles Crockford thought it was a splendid
513idea to redefine JSON incompatibly, so this is no longer true.
514
515For protocols that used back-to-back JSON texts, this might lead to
516run-ins, where two or more JSON texts will be interpreted as one JSON
500texts. 517text.
501 518
519For this reason, if the default encoder uses L<JSON::XS>, it will default
520to not allowing anything but arrays and objects/hashes, at least for the
521forseeable future (it will change at some point). This might or might not
522be true for the L<JSON> module, so this might cause a security issue.
523
524If you depend on either behaviour, you should create your own json object
525and pass it in explicitly.
526
527=item cbor => L<CBOR::XS> object
528
529This is the cbor coder object used by the C<cbor> read and write types.
530
531If you don't supply it, then AnyEvent::Handle will create and use a
532suitable one (on demand), which will write CBOR without using extensions,
533if possible.
534
502Note that you are responsible to depend on the JSON module if you want to 535Note that you are responsible to depend on the L<CBOR::XS> module if you
503use this functionality, as AnyEvent does not have a dependency itself. 536want to use this functionality, as AnyEvent does not have a dependency on
537it itself.
504 538
505=back 539=back
506 540
507=cut 541=cut
508 542
1038 1072
1039Encodes the given hash or array reference into a JSON object. Unless you 1073Encodes the given hash or array reference into a JSON object. Unless you
1040provide your own JSON object, this means it will be encoded to JSON text 1074provide your own JSON object, this means it will be encoded to JSON text
1041in UTF-8. 1075in UTF-8.
1042 1076
1077The default encoder might or might not handle every type of JSON value -
1078it might be limited to arrays and objects for security reasons. See the
1079C<json> constructor attribute for more details.
1080
1043JSON objects (and arrays) are self-delimiting, so you can write JSON at 1081JSON objects (and arrays) are self-delimiting, so if you only use arrays
1044one end of a handle and read them at the other end without using any 1082and hashes, you can write JSON at one end of a handle and read them at the
1045additional framing. 1083other end without using any additional framing.
1046 1084
1047The generated JSON text is guaranteed not to contain any newlines: While 1085The JSON text generated by the default encoder is guaranteed not to
1048this module doesn't need delimiters after or between JSON texts to be 1086contain any newlines: While this module doesn't need delimiters after or
1049able to read them, many other languages depend on that. 1087between JSON texts to be able to read them, many other languages depend on
1088them.
1050 1089
1051A simple RPC protocol that interoperates easily with others is to send 1090A simple RPC protocol that interoperates easily with other languages is
1052JSON arrays (or objects, although arrays are usually the better choice as 1091to send JSON arrays (or objects, although arrays are usually the better
1053they mimic how function argument passing works) and a newline after each 1092choice as they mimic how function argument passing works) and a newline
1054JSON text: 1093after each JSON text:
1055 1094
1056 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever 1095 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
1057 $handle->push_write ("\012"); 1096 $handle->push_write ("\012");
1058 1097
1059An AnyEvent::Handle receiver would simply use the C<json> read type and 1098An AnyEvent::Handle receiver would simply use the C<json> read type and
1062 $handle->push_read (json => sub { my $array = $_[1]; ... }); 1101 $handle->push_read (json => sub { my $array = $_[1]; ... });
1063 1102
1064Other languages could read single lines terminated by a newline and pass 1103Other languages could read single lines terminated by a newline and pass
1065this line into their JSON decoder of choice. 1104this line into their JSON decoder of choice.
1066 1105
1106=item cbor => $perl_scalar
1107
1108Encodes the given scalar into a CBOR value. Unless you provide your own
1109L<CBOR::XS> object, this means it will be encoded to a CBOR string not
1110using any extensions, if possible.
1111
1112CBOR values are self-delimiting, so you can write CBOR at one end of
1113a handle and read them at the other end without using any additional
1114framing.
1115
1116A simple nd very very fast RPC protocol that interoperates with
1117other languages is to send CBOR and receive CBOR values (arrays are
1118recommended):
1119
1120 $handle->push_write (cbor => ["method", "arg1", "arg2"]); # whatever
1121
1122An AnyEvent::Handle receiver would simply use the C<cbor> read type:
1123
1124 $handle->push_read (cbor => sub { my $array = $_[1]; ... });
1125
1067=cut 1126=cut
1068 1127
1069sub json_coder() { 1128sub json_coder() {
1070 eval { require JSON::XS; JSON::XS->new->utf8 } 1129 eval { require JSON::XS; JSON::XS->new->utf8 }
1071 || do { require JSON; JSON->new->utf8 } 1130 || do { require JSON::PP; JSON::PP->new->utf8 }
1072} 1131}
1073 1132
1074register_write_type json => sub { 1133register_write_type json => sub {
1075 my ($self, $ref) = @_; 1134 my ($self, $ref) = @_;
1076 1135
1077 my $json = $self->{json} ||= json_coder; 1136 ($self->{json} ||= json_coder)
1078
1079 $json->encode ($ref) 1137 ->encode ($ref)
1138};
1139
1140sub cbor_coder() {
1141 require CBOR::XS;
1142 CBOR::XS->new
1143}
1144
1145register_write_type cbor => sub {
1146 my ($self, $scalar) = @_;
1147
1148 ($self->{cbor} ||= cbor_coder)
1149 ->encode ($scalar)
1080}; 1150};
1081 1151
1082=item storable => $reference 1152=item storable => $reference
1083 1153
1084Freezes the given reference using L<Storable> and writes it to the 1154Freezes the given reference using L<Storable> and writes it to the
1478 1548
1479register_read_type line => sub { 1549register_read_type line => sub {
1480 my ($self, $cb, $eol) = @_; 1550 my ($self, $cb, $eol) = @_;
1481 1551
1482 if (@_ < 3) { 1552 if (@_ < 3) {
1483 # this is more than twice as fast as the generic code below 1553 # this is faster then the generic code below
1484 sub { 1554 sub {
1485 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return; 1555 (my $pos = index $_[0]{rbuf}, "\012") >= 0
1556 or return;
1486 1557
1558 (my $str = substr $_[0]{rbuf}, 0, $pos + 1, "") =~ s/(\015?\012)\Z// or die;
1487 $cb->($_[0], "$1", "$2"); 1559 $cb->($_[0], $str, "$1");
1488 1 1560 1
1489 } 1561 }
1490 } else { 1562 } else {
1491 $eol = quotemeta $eol unless ref $eol; 1563 $eol = quotemeta $eol unless ref $eol;
1492 $eol = qr|^(.*?)($eol)|s; 1564 $eol = qr|^(.*?)($eol)|s;
1655=item json => $cb->($handle, $hash_or_arrayref) 1727=item json => $cb->($handle, $hash_or_arrayref)
1656 1728
1657Reads a JSON object or array, decodes it and passes it to the 1729Reads a JSON object or array, decodes it and passes it to the
1658callback. When a parse error occurs, an C<EBADMSG> error will be raised. 1730callback. When a parse error occurs, an C<EBADMSG> error will be raised.
1659 1731
1660If a C<json> object was passed to the constructor, then that will be used 1732If a C<json> object was passed to the constructor, then that will be
1661for the final decode, otherwise it will create a JSON coder expecting UTF-8. 1733used for the final decode, otherwise it will create a L<JSON::XS> or
1734L<JSON::PP> coder object expecting UTF-8.
1662 1735
1663This read type uses the incremental parser available with JSON version 1736This read type uses the incremental parser available with JSON version
16642.09 (and JSON::XS version 2.2) and above. You have to provide a 17372.09 (and JSON::XS version 2.2) and above.
1665dependency on your own: this module will load the JSON module, but
1666AnyEvent does not depend on it itself.
1667 1738
1668Since JSON texts are fully self-delimiting, the C<json> read and write 1739Since JSON texts are fully self-delimiting, the C<json> read and write
1669types are an ideal simple RPC protocol: just exchange JSON datagrams. See 1740types are an ideal simple RPC protocol: just exchange JSON datagrams. See
1670the C<json> write type description, above, for an actual example. 1741the C<json> write type description, above, for an actual example.
1671 1742
1675 my ($self, $cb) = @_; 1746 my ($self, $cb) = @_;
1676 1747
1677 my $json = $self->{json} ||= json_coder; 1748 my $json = $self->{json} ||= json_coder;
1678 1749
1679 my $data; 1750 my $data;
1680 my $rbuf = \$self->{rbuf};
1681 1751
1682 sub { 1752 sub {
1683 my $ref = eval { $json->incr_parse ($_[0]{rbuf}) }; 1753 my $ref = eval { $json->incr_parse ($_[0]{rbuf}) };
1684 1754
1685 if ($ref) { 1755 if ($ref) {
1704 () 1774 ()
1705 } 1775 }
1706 } 1776 }
1707}; 1777};
1708 1778
1779=item cbor => $cb->($handle, $scalar)
1780
1781Reads a CBOR value, decodes it and passes it to the callback. When a parse
1782error occurs, an C<EBADMSG> error will be raised.
1783
1784If a L<CBOR::XS> object was passed to the constructor, then that will be
1785used for the final decode, otherwise it will create a CBOR coder without
1786enabling any options.
1787
1788You have to provide a dependency to L<CBOR::XS> on your own: this module
1789will load the L<CBOR::XS> module, but AnyEvent does not depend on it
1790itself.
1791
1792Since CBOR values are fully self-delimiting, the C<cbor> read and write
1793types are an ideal simple RPC protocol: just exchange CBOR datagrams. See
1794the C<cbor> write type description, above, for an actual example.
1795
1796=cut
1797
1798register_read_type cbor => sub {
1799 my ($self, $cb) = @_;
1800
1801 my $cbor = $self->{cbor} ||= cbor_coder;
1802
1803 my $data;
1804
1805 sub {
1806 my (@value) = eval { $cbor->incr_parse ($_[0]{rbuf}) };
1807
1808 if (@value) {
1809 $cb->($_[0], @value);
1810
1811 1
1812 } elsif ($@) {
1813 # error case
1814 $cbor->incr_reset;
1815
1816 $_[0]->_error (Errno::EBADMSG);
1817
1818 ()
1819 } else {
1820 ()
1821 }
1822 }
1823};
1824
1709=item storable => $cb->($handle, $ref) 1825=item storable => $cb->($handle, $ref)
1710 1826
1711Deserialises a L<Storable> frozen representation as written by the 1827Deserialises a L<Storable> frozen representation as written by the
1712C<storable> write type (BER-encoded length prefix followed by nfreeze'd 1828C<storable> write type (BER-encoded length prefix followed by nfreeze'd
1713data). 1829data).
1730 1846
1731 # bypass unshift if we already have the remaining chunk 1847 # bypass unshift if we already have the remaining chunk
1732 if ($format + $len <= length $_[0]{rbuf}) { 1848 if ($format + $len <= length $_[0]{rbuf}) {
1733 my $data = substr $_[0]{rbuf}, $format, $len; 1849 my $data = substr $_[0]{rbuf}, $format, $len;
1734 substr $_[0]{rbuf}, 0, $format + $len, ""; 1850 substr $_[0]{rbuf}, 0, $format + $len, "";
1851
1735 $cb->($_[0], Storable::thaw ($data)); 1852 eval { $cb->($_[0], Storable::thaw ($data)); 1 }
1853 or return $_[0]->_error (Errno::EBADMSG);
1736 } else { 1854 } else {
1737 # remove prefix 1855 # remove prefix
1738 substr $_[0]{rbuf}, 0, $format, ""; 1856 substr $_[0]{rbuf}, 0, $format, "";
1739 1857
1740 # read remaining chunk 1858 # read remaining chunk
1741 $_[0]->unshift_read (chunk => $len, sub { 1859 $_[0]->unshift_read (chunk => $len, sub {
1742 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1860 eval { $cb->($_[0], Storable::thaw ($_[1])); 1 }
1743 $cb->($_[0], $ref);
1744 } else {
1745 $_[0]->_error (Errno::EBADMSG); 1861 or $_[0]->_error (Errno::EBADMSG);
1746 }
1747 }); 1862 });
1748 } 1863 }
1749 1864
1750 1 1865 1
1751 } 1866 }
1867};
1868
1869=item tls_detect => $cb->($handle, $detect, $major, $minor)
1870
1871Checks the input stream for a valid SSL or TLS handshake TLSPaintext
1872record without consuming anything. Only SSL version 3 or higher
1873is handled, up to the fictituous protocol 4.x (but both SSL3+ and
1874SSL2-compatible framing is supported).
1875
1876If 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
1878and third argument (C<$major> is C<3>, and C<$minor> is 0..3 for SSL
18793.0, TLS 1.0, 1.1 and 1.2, respectively). If it detects the input to
1880be definitely not TLS, it calls the callback with a false value for
1881C<$detect>.
1882
1883The callback could use this information to decide whether or not to start
1884TLS negotiation.
1885
1886In all cases the data read so far is passed to the following read
1887handlers.
1888
1889Usually you want to use the C<tls_autostart> read type instead.
1890
1891If you want to design a protocol that works in the presence of TLS
1892dtection, make sure that any non-TLS data doesn't start with the octet 22
1893(ASCII SYN, 16 hex) or 128-255 (i.e. highest bit set). The checks this
1894read type does are a bit more strict, but might losen in the future to
1895accomodate protocol changes.
1896
1897This read type does not rely on L<AnyEvent::TLS> (and thus, not on
1898L<Net::SSLeay>).
1899
1900=item tls_autostart => $tls[, $tls_ctx]
1901
1902Tries 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.
1904
1905In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has
1906been configured to accept, as servers do not normally send a handshake on
1907their own and ths cannot be detected in this way.
1908
1909See C<tls_detect> above for more details.
1910
1911Example: give the client a chance to start TLS before accepting a text
1912line.
1913
1914 $hdl->push_read (tls_detect => "accept");
1915 $hdl->push_read (line => sub {
1916 print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n";
1917 });
1918
1919=cut
1920
1921register_read_type tls_detect => sub {
1922 my ($self, $cb) = @_;
1923
1924 sub {
1925 # this regex matches a full or partial tls record
1926 if (
1927 # ssl3+: type(22=handshake) major(=3) minor(any) length_hi
1928 $self->{rbuf} =~ /^(?:\z| \x16 (\z| [\x03\x04] (?:\z| . (?:\z| [\x00-\x40] ))))/xs
1929 # ssl2 comapatible: len_hi len_lo type(1) major minor dummy(forlength)
1930 or $self->{rbuf} =~ /^(?:\z| [\x80-\xff] (?:\z| . (?:\z| \x01 (\z| [\x03\x04] (?:\z| . (?:\z| . ))))))/xs
1931 ) {
1932 return if 3 != length $1; # partial match, can't decide yet
1933
1934 # full match, valid TLS record
1935 my ($major, $minor) = unpack "CC", $1;
1936 $cb->($self, "accept", $major + $minor * 0.1);
1937 } else {
1938 # mismatch == guaranteed not TLS
1939 $cb->($self, undef);
1940 }
1941
1942 1
1943 }
1944};
1945
1946register_read_type tls_autostart => sub {
1947 my ($self, @tls) = @_;
1948
1949 $RH{tls_detect}($self, sub {
1950 return unless $_[1];
1951 $_[0]->starttls (@tls);
1952 })
1752}; 1953};
1753 1954
1754=back 1955=back
1755 1956
1756=item custom read types - Package::anyevent_read_type $handle, $cb, @args 1957=item custom read types - Package::anyevent_read_type $handle, $cb, @args
1856 my ($self, $err) = @_; 2057 my ($self, $err) = @_;
1857 2058
1858 return $self->_error ($!, 1) 2059 return $self->_error ($!, 1)
1859 if $err == Net::SSLeay::ERROR_SYSCALL (); 2060 if $err == Net::SSLeay::ERROR_SYSCALL ();
1860 2061
1861 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()); 2062 my $err = Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
1862 2063
1863 # reduce error string to look less scary 2064 # reduce error string to look less scary
1864 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /; 2065 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
1865 2066
1866 if ($self->{_on_starttls}) { 2067 if ($self->{_on_starttls}) {
1880sub _dotls { 2081sub _dotls {
1881 my ($self) = @_; 2082 my ($self) = @_;
1882 2083
1883 my $tmp; 2084 my $tmp;
1884 2085
1885 if (length $self->{_tls_wbuf}) { 2086 while (length $self->{_tls_wbuf}) {
1886 while (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 2087 if (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) <= 0) {
1887 substr $self->{_tls_wbuf}, 0, $tmp, ""; 2088 $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);
2089
2090 return $self->_tls_error ($tmp)
2091 if $tmp != $ERROR_WANT_READ
2092 && ($tmp != $ERROR_SYSCALL || $!);
2093
2094 last;
1888 } 2095 }
1889 2096
1890 $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp); 2097 substr $self->{_tls_wbuf}, 0, $tmp, "";
1891 return $self->_tls_error ($tmp)
1892 if $tmp != $ERROR_WANT_READ
1893 && ($tmp != $ERROR_SYSCALL || $!);
1894 } 2098 }
1895 2099
1896 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { 2100 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
1897 unless (length $tmp) { 2101 unless (length $tmp) {
1898 $self->{_on_starttls} 2102 $self->{_on_starttls}
1912 $self->{_tls_rbuf} .= $tmp; 2116 $self->{_tls_rbuf} .= $tmp;
1913 $self->_drain_rbuf; 2117 $self->_drain_rbuf;
1914 $self->{tls} or return; # tls session might have gone away in callback 2118 $self->{tls} or return; # tls session might have gone away in callback
1915 } 2119 }
1916 2120
1917 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 2121 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); # -1 is not neccessarily correct, but Net::SSLeay doesn't tell us
1918 return $self->_tls_error ($tmp) 2122 return $self->_tls_error ($tmp)
1919 if $tmp != $ERROR_WANT_READ 2123 if $tmp != $ERROR_WANT_READ
1920 && ($tmp != $ERROR_SYSCALL || $!); 2124 && ($tmp != $ERROR_SYSCALL || $!);
1921 2125
1922 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) { 2126 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1932 2136
1933=item $handle->starttls ($tls[, $tls_ctx]) 2137=item $handle->starttls ($tls[, $tls_ctx])
1934 2138
1935Instead of starting TLS negotiation immediately when the AnyEvent::Handle 2139Instead of starting TLS negotiation immediately when the AnyEvent::Handle
1936object is created, you can also do that at a later time by calling 2140object is created, you can also do that at a later time by calling
1937C<starttls>. 2141C<starttls>. See the C<tls> constructor argument for general info.
1938 2142
1939Starting TLS is currently an asynchronous operation - when you push some 2143Starting TLS is currently an asynchronous operation - when you push some
1940write data and then call C<< ->starttls >> then TLS negotiation will start 2144write data and then call C<< ->starttls >> then TLS negotiation will start
1941immediately, after which the queued write data is then sent. 2145immediately, after which the queued write data is then sent. This might
2146change in future versions, so best make sure you have no outstanding write
2147data when calling this method.
1942 2148
1943The first argument is the same as the C<tls> constructor argument (either 2149The first argument is the same as the C<tls> constructor argument (either
1944C<"connect">, C<"accept"> or an existing Net::SSLeay object). 2150C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1945 2151
1946The second argument is the optional C<AnyEvent::TLS> object that is used 2152The second argument is the optional C<AnyEvent::TLS> object that is used
1968 my ($self, $tls, $ctx) = @_; 2174 my ($self, $tls, $ctx) = @_;
1969 2175
1970 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught" 2176 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
1971 if $self->{tls}; 2177 if $self->{tls};
1972 2178
2179 unless (defined $AnyEvent::TLS::VERSION) {
2180 eval {
2181 require Net::SSLeay;
2182 require AnyEvent::TLS;
2183 1
2184 } or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system");
2185 }
2186
1973 $self->{tls} = $tls; 2187 $self->{tls} = $tls;
1974 $self->{tls_ctx} = $ctx if @_ > 2; 2188 $self->{tls_ctx} = $ctx if @_ > 2;
1975 2189
1976 return unless $self->{fh}; 2190 return unless $self->{fh};
1977 2191
1978 require Net::SSLeay;
1979
1980 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 2192 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1981 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 2193 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1982 2194
1983 $tls = delete $self->{tls}; 2195 $tls = delete $self->{tls};
1984 $ctx = $self->{tls_ctx}; 2196 $ctx = $self->{tls_ctx};
1985 2197
1986 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 2198 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1987 2199
1988 if ("HASH" eq ref $ctx) { 2200 if ("HASH" eq ref $ctx) {
1989 require AnyEvent::TLS;
1990
1991 if ($ctx->{cache}) { 2201 if ($ctx->{cache}) {
1992 my $key = $ctx+0; 2202 my $key = $ctx+0;
1993 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx; 2203 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
1994 } else { 2204 } else {
1995 $ctx = new AnyEvent::TLS %$ctx; 2205 $ctx = new AnyEvent::TLS %$ctx;
2228handles requests until the server gets some QUIT command, causing it to 2438handles requests until the server gets some QUIT command, causing it to
2229close the connection first (highly desirable for a busy TCP server). A 2439close the connection first (highly desirable for a busy TCP server). A
2230client dropping the connection is an error, which means this variant can 2440client dropping the connection is an error, which means this variant can
2231detect an unexpected detection close. 2441detect an unexpected detection close.
2232 2442
2233To handle this case, always make sure you have a on-empty read queue, by 2443To handle this case, always make sure you have a non-empty read queue, by
2234pushing the "read request start" handler on it: 2444pushing the "read request start" handler on it:
2235 2445
2236 # we assume a request starts with a single line 2446 # we assume a request starts with a single line
2237 my @start_request; @start_request = (line => sub { 2447 my @start_request; @start_request = (line => sub {
2238 my ($hdl, $line) = @_; 2448 my ($hdl, $line) = @_;
2336C<low_water_mark> this will be called precisely when all data has been 2546C<low_water_mark> this will be called precisely when all data has been
2337written to the socket: 2547written to the socket:
2338 2548
2339 $handle->push_write (...); 2549 $handle->push_write (...);
2340 $handle->on_drain (sub { 2550 $handle->on_drain (sub {
2341 AE::log debug => "all data submitted to the kernel\n"; 2551 AE::log debug => "All data submitted to the kernel.";
2342 undef $handle; 2552 undef $handle;
2343 }); 2553 });
2344 2554
2345If you just want to queue some data and then signal EOF to the other side, 2555If you just want to queue some data and then signal EOF to the other side,
2346consider using C<< ->push_shutdown >> instead. 2556consider using C<< ->push_shutdown >> instead.
2430When you have intermediate CA certificates that your clients might not 2640When you have intermediate CA certificates that your clients might not
2431know about, just append them to the C<cert_file>. 2641know about, just append them to the C<cert_file>.
2432 2642
2433=back 2643=back
2434 2644
2435
2436=head1 SUBCLASSING AnyEvent::Handle 2645=head1 SUBCLASSING AnyEvent::Handle
2437 2646
2438In many cases, you might want to subclass AnyEvent::Handle. 2647In many cases, you might want to subclass AnyEvent::Handle.
2439 2648
2440To make this easier, a given version of AnyEvent::Handle uses these 2649To make this easier, a given version of AnyEvent::Handle uses these
2466 2675
2467Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 2676Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
2468 2677
2469=cut 2678=cut
2470 2679
24711; # End of AnyEvent::Handle 26801
2681

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines