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.226 by root, Mon Dec 12 12:56:04 2011 UTC vs.
Revision 1.237 by root, Tue Jul 30 23:14:32 2013 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
128=item on_connect => $cb->($handle, $host, $port, $retry->()) 128=item on_connect => $cb->($handle, $host, $port, $retry->())
129 129
130This callback is called when a connection has been successfully established. 130This callback is called when a connection has been successfully established.
131 131
132The peer's numeric host and port (the socket peername) are passed as 132The peer's numeric host and port (the socket peername) are passed as
133parameters, together with a retry callback. 133parameters, together with a retry callback. At the time it is called the
134read and write queues, EOF status, TLS status and similar properties of
135the handle will have been reset.
134 136
137It is not allowed to use the read or write queues while the handle object
138is connecting.
139
135If, for some reason, the handle is not acceptable, calling C<$retry> 140If, for some reason, the handle is not acceptable, calling C<$retry> will
136will continue with the next connection target (in case of multi-homed 141continue with the next connection target (in case of multi-homed hosts or
137hosts or SRV records there can be multiple connection endpoints). At the 142SRV records there can be multiple connection endpoints). The C<$retry>
138time it is called the read and write queues, eof status, tls status and 143callback can be invoked after the connect callback returns, i.e. one can
139similar properties of the handle will have been reset. 144start a handshake and then decide to retry with the next host if the
145handshake fails.
140 146
141In most cases, you should ignore the C<$retry> parameter. 147In most cases, you should ignore the C<$retry> parameter.
142 148
143=item on_connect_error => $cb->($handle, $message) 149=item on_connect_error => $cb->($handle, $message)
144 150
164with 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
165cases 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
166often easiest to not report C<EPIPE> errors in this callback. 172often easiest to not report C<EPIPE> errors in this callback.
167 173
168AnyEvent::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
169against, 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.
170recommended to always output the C<$message> argument in human-readable 176
171error 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>.
172 184
173Non-fatal errors can be retried by returning, but it is recommended 185Non-fatal errors can be retried by returning, but it is recommended
174to simply ignore this parameter and instead abondon the handle object 186to simply ignore this parameter and instead abondon the handle object
175when this callback is invoked. Examples of non-fatal errors are timeouts 187when this callback is invoked. Examples of non-fatal errors are timeouts
176C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>). 188C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
224If an EOF condition has been detected but no C<on_eof> callback has been 236If an EOF condition has been detected but no C<on_eof> callback has been
225set, then a fatal error will be raised with C<$!> set to <0>. 237set, then a fatal error will be raised with C<$!> set to <0>.
226 238
227=item on_drain => $cb->($handle) 239=item on_drain => $cb->($handle)
228 240
229This sets the callback that is called when the write buffer becomes empty 241This sets the callback that is called once when the write buffer becomes
230(or immediately if the buffer is empty already). 242empty (and immediately when the handle object is created).
231 243
232To append to the write buffer, use the C<< ->push_write >> method. 244To append to the write buffer, use the C<< ->push_write >> method.
233 245
234This callback is useful when you don't want to put all of your write data 246This callback is useful when you don't want to put all of your write data
235into the queue at once, for example, when you want to write the contents 247into the queue at once, for example, when you want to write the contents
417appropriate error message. 429appropriate error message.
418 430
419TLS mode requires Net::SSLeay to be installed (it will be loaded 431TLS mode requires Net::SSLeay to be installed (it will be loaded
420automatically 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
421have 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
422to 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.
423 436
424Unlike 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
425C<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>
426mode. 439mode.
427 440
880 893
881The write queue is very simple: you can add data to its end, and 894The write queue is very simple: you can add data to its end, and
882AnyEvent::Handle will automatically try to get rid of it for you. 895AnyEvent::Handle will automatically try to get rid of it for you.
883 896
884When data could be written and the write buffer is shorter then the low 897When data could be written and the write buffer is shorter then the low
885water mark, the C<on_drain> callback will be invoked. 898water mark, the C<on_drain> callback will be invoked once.
886 899
887=over 4 900=over 4
888 901
889=item $handle->on_drain ($cb) 902=item $handle->on_drain ($cb)
890 903
1472 1485
1473register_read_type line => sub { 1486register_read_type line => sub {
1474 my ($self, $cb, $eol) = @_; 1487 my ($self, $cb, $eol) = @_;
1475 1488
1476 if (@_ < 3) { 1489 if (@_ < 3) {
1477 # this is more than twice as fast as the generic code below 1490 # this is faster then the generic code below
1478 sub { 1491 sub {
1479 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return; 1492 (my $pos = index $_[0]{rbuf}, "\012") >= 0
1493 or return;
1480 1494
1495 (my $str = substr $_[0]{rbuf}, 0, $pos + 1, "") =~ s/(\015?\012)\Z// or die;
1481 $cb->($_[0], $1, $2); 1496 $cb->($_[0], $str, "$1");
1482 1 1497 1
1483 } 1498 }
1484 } else { 1499 } else {
1485 $eol = quotemeta $eol unless ref $eol; 1500 $eol = quotemeta $eol unless ref $eol;
1486 $eol = qr|^(.*?)($eol)|s; 1501 $eol = qr|^(.*?)($eol)|s;
1487 1502
1488 sub { 1503 sub {
1489 $_[0]{rbuf} =~ s/$eol// or return; 1504 $_[0]{rbuf} =~ s/$eol// or return;
1490 1505
1491 $cb->($_[0], $1, $2); 1506 $cb->($_[0], "$1", "$2");
1492 1 1507 1
1493 } 1508 }
1494 } 1509 }
1495}; 1510};
1496 1511
1724 1739
1725 # bypass unshift if we already have the remaining chunk 1740 # bypass unshift if we already have the remaining chunk
1726 if ($format + $len <= length $_[0]{rbuf}) { 1741 if ($format + $len <= length $_[0]{rbuf}) {
1727 my $data = substr $_[0]{rbuf}, $format, $len; 1742 my $data = substr $_[0]{rbuf}, $format, $len;
1728 substr $_[0]{rbuf}, 0, $format + $len, ""; 1743 substr $_[0]{rbuf}, 0, $format + $len, "";
1744
1729 $cb->($_[0], Storable::thaw ($data)); 1745 eval { $cb->($_[0], Storable::thaw ($data)); 1 }
1746 or return $_[0]->_error (Errno::EBADMSG);
1730 } else { 1747 } else {
1731 # remove prefix 1748 # remove prefix
1732 substr $_[0]{rbuf}, 0, $format, ""; 1749 substr $_[0]{rbuf}, 0, $format, "";
1733 1750
1734 # read remaining chunk 1751 # read remaining chunk
1735 $_[0]->unshift_read (chunk => $len, sub { 1752 $_[0]->unshift_read (chunk => $len, sub {
1736 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1753 eval { $cb->($_[0], Storable::thaw ($_[1])); 1 }
1737 $cb->($_[0], $ref);
1738 } else {
1739 $_[0]->_error (Errno::EBADMSG); 1754 or $_[0]->_error (Errno::EBADMSG);
1740 }
1741 }); 1755 });
1742 } 1756 }
1743 1757
1744 1 1758 1
1745 } 1759 }
1760};
1761
1762=item tls_detect => $cb->($handle, $detect, $major, $minor)
1763
1764Checks the input stream for a valid SSL or TLS handshake TLSPaintext
1765record without consuming anything. Only SSL version 3 or higher
1766is handled, up to the fictituous protocol 4.x (but both SSL3+ and
1767SSL2-compatible framing is supported).
1768
1769If it detects that the input data is likely TLS, it calls the callback
1770with a true value for C<$detect> and the (on-wire) TLS version as second
1771and third argument (C<$major> is C<3>, and C<$minor> is 0..3 for SSL
17723.0, TLS 1.0, 1.1 and 1.2, respectively). If it detects the input to
1773be definitely not TLS, it calls the callback with a false value for
1774C<$detect>.
1775
1776The callback could use this information to decide whether or not to start
1777TLS negotiation.
1778
1779In all cases the data read so far is passed to the following read
1780handlers.
1781
1782Usually you want to use the C<tls_autostart> read type instead.
1783
1784If you want to design a protocol that works in the presence of TLS
1785dtection, make sure that any non-TLS data doesn't start with the octet 22
1786(ASCII SYN, 16 hex) or 128-255 (i.e. highest bit set). The checks this
1787read type does are a bit more strict, but might losen in the future to
1788accomodate protocol changes.
1789
1790This read type does not rely on L<AnyEvent::TLS> (and thus, not on
1791L<Net::SSLeay>).
1792
1793=item tls_autostart => $tls[, $tls_ctx]
1794
1795Tries to detect a valid SSL or TLS handshake. If one is detected, it tries
1796to start tls by calling C<starttls> with the given arguments.
1797
1798In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has
1799been configured to accept, as servers do not normally send a handshake on
1800their own and ths cannot be detected in this way.
1801
1802See C<tls_detect> above for more details.
1803
1804Example: give the client a chance to start TLS before accepting a text
1805line.
1806
1807 $hdl->push_read (tls_detect => "accept");
1808 $hdl->push_read (line => sub {
1809 print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n";
1810 });
1811
1812=cut
1813
1814register_read_type tls_detect => sub {
1815 my ($self, $cb) = @_;
1816
1817 sub {
1818 # this regex matches a full or partial tls record
1819 if (
1820 # ssl3+: type(22=handshake) major(=3) minor(any) length_hi
1821 $self->{rbuf} =~ /^(?:\z| \x16 (\z| [\x03\x04] (?:\z| . (?:\z| [\x00-\x40] ))))/xs
1822 # ssl2 comapatible: len_hi len_lo type(1) major minor dummy(forlength)
1823 or $self->{rbuf} =~ /^(?:\z| [\x80-\xff] (?:\z| . (?:\z| \x01 (\z| [\x03\x04] (?:\z| . (?:\z| . ))))))/xs
1824 ) {
1825 return if 3 != length $1; # partial match, can't decide yet
1826
1827 # full match, valid TLS record
1828 my ($major, $minor) = unpack "CC", $1;
1829 $cb->($self, "accept", $major + $minor * 0.1);
1830 } else {
1831 # mismatch == guaranteed not TLS
1832 $cb->($self, undef);
1833 }
1834
1835 1
1836 }
1837};
1838
1839register_read_type tls_autostart => sub {
1840 my ($self, @tls) = @_;
1841
1842 $RH{tls_detect}($self, sub {
1843 return unless $_[1];
1844 $_[0]->starttls (@tls);
1845 })
1746}; 1846};
1747 1847
1748=back 1848=back
1749 1849
1750=item custom read types - Package::anyevent_read_type $handle, $cb, @args 1850=item custom read types - Package::anyevent_read_type $handle, $cb, @args
1850 my ($self, $err) = @_; 1950 my ($self, $err) = @_;
1851 1951
1852 return $self->_error ($!, 1) 1952 return $self->_error ($!, 1)
1853 if $err == Net::SSLeay::ERROR_SYSCALL (); 1953 if $err == Net::SSLeay::ERROR_SYSCALL ();
1854 1954
1855 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()); 1955 my $err = Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
1856 1956
1857 # reduce error string to look less scary 1957 # reduce error string to look less scary
1858 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /; 1958 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
1859 1959
1860 if ($self->{_on_starttls}) { 1960 if ($self->{_on_starttls}) {
1926 2026
1927=item $handle->starttls ($tls[, $tls_ctx]) 2027=item $handle->starttls ($tls[, $tls_ctx])
1928 2028
1929Instead of starting TLS negotiation immediately when the AnyEvent::Handle 2029Instead of starting TLS negotiation immediately when the AnyEvent::Handle
1930object is created, you can also do that at a later time by calling 2030object is created, you can also do that at a later time by calling
1931C<starttls>. 2031C<starttls>. See the C<tls> constructor argument for general info.
1932 2032
1933Starting TLS is currently an asynchronous operation - when you push some 2033Starting TLS is currently an asynchronous operation - when you push some
1934write data and then call C<< ->starttls >> then TLS negotiation will start 2034write data and then call C<< ->starttls >> then TLS negotiation will start
1935immediately, after which the queued write data is then sent. 2035immediately, after which the queued write data is then sent. This might
2036change in future versions, so best make sure you have no outstanding write
2037data when calling this method.
1936 2038
1937The first argument is the same as the C<tls> constructor argument (either 2039The first argument is the same as the C<tls> constructor argument (either
1938C<"connect">, C<"accept"> or an existing Net::SSLeay object). 2040C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1939 2041
1940The second argument is the optional C<AnyEvent::TLS> object that is used 2042The second argument is the optional C<AnyEvent::TLS> object that is used
1962 my ($self, $tls, $ctx) = @_; 2064 my ($self, $tls, $ctx) = @_;
1963 2065
1964 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught" 2066 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
1965 if $self->{tls}; 2067 if $self->{tls};
1966 2068
2069 unless (defined $AnyEvent::TLS::VERSION) {
2070 eval {
2071 require Net::SSLeay;
2072 require AnyEvent::TLS;
2073 1
2074 } or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system");
2075 }
2076
1967 $self->{tls} = $tls; 2077 $self->{tls} = $tls;
1968 $self->{tls_ctx} = $ctx if @_ > 2; 2078 $self->{tls_ctx} = $ctx if @_ > 2;
1969 2079
1970 return unless $self->{fh}; 2080 return unless $self->{fh};
1971 2081
1972 require Net::SSLeay;
1973
1974 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 2082 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1975 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 2083 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1976 2084
1977 $tls = delete $self->{tls}; 2085 $tls = delete $self->{tls};
1978 $ctx = $self->{tls_ctx}; 2086 $ctx = $self->{tls_ctx};
1979 2087
1980 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 2088 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1981 2089
1982 if ("HASH" eq ref $ctx) { 2090 if ("HASH" eq ref $ctx) {
1983 require AnyEvent::TLS;
1984
1985 if ($ctx->{cache}) { 2091 if ($ctx->{cache}) {
1986 my $key = $ctx+0; 2092 my $key = $ctx+0;
1987 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx; 2093 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
1988 } else { 2094 } else {
1989 $ctx = new AnyEvent::TLS %$ctx; 2095 $ctx = new AnyEvent::TLS %$ctx;
2222handles requests until the server gets some QUIT command, causing it to 2328handles requests until the server gets some QUIT command, causing it to
2223close the connection first (highly desirable for a busy TCP server). A 2329close the connection first (highly desirable for a busy TCP server). A
2224client dropping the connection is an error, which means this variant can 2330client dropping the connection is an error, which means this variant can
2225detect an unexpected detection close. 2331detect an unexpected detection close.
2226 2332
2227To handle this case, always make sure you have a on-empty read queue, by 2333To handle this case, always make sure you have a non-empty read queue, by
2228pushing the "read request start" handler on it: 2334pushing the "read request start" handler on it:
2229 2335
2230 # we assume a request starts with a single line 2336 # we assume a request starts with a single line
2231 my @start_request; @start_request = (line => sub { 2337 my @start_request; @start_request = (line => sub {
2232 my ($hdl, $line) = @_; 2338 my ($hdl, $line) = @_;
2330C<low_water_mark> this will be called precisely when all data has been 2436C<low_water_mark> this will be called precisely when all data has been
2331written to the socket: 2437written to the socket:
2332 2438
2333 $handle->push_write (...); 2439 $handle->push_write (...);
2334 $handle->on_drain (sub { 2440 $handle->on_drain (sub {
2335 AE::log debug => "all data submitted to the kernel\n"; 2441 AE::log debug => "All data submitted to the kernel.";
2336 undef $handle; 2442 undef $handle;
2337 }); 2443 });
2338 2444
2339If you just want to queue some data and then signal EOF to the other side, 2445If you just want to queue some data and then signal EOF to the other side,
2340consider using C<< ->push_shutdown >> instead. 2446consider using C<< ->push_shutdown >> instead.
2424When you have intermediate CA certificates that your clients might not 2530When you have intermediate CA certificates that your clients might not
2425know about, just append them to the C<cert_file>. 2531know about, just append them to the C<cert_file>.
2426 2532
2427=back 2533=back
2428 2534
2429
2430=head1 SUBCLASSING AnyEvent::Handle 2535=head1 SUBCLASSING AnyEvent::Handle
2431 2536
2432In many cases, you might want to subclass AnyEvent::Handle. 2537In many cases, you might want to subclass AnyEvent::Handle.
2433 2538
2434To make this easier, a given version of AnyEvent::Handle uses these 2539To make this easier, a given version of AnyEvent::Handle uses these
2460 2565
2461Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 2566Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
2462 2567
2463=cut 2568=cut
2464 2569
24651; # End of AnyEvent::Handle 25701
2571

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines