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.143 by root, Mon Jul 6 21:02:34 2009 UTC vs.
Revision 1.153 by root, Fri Jul 17 23:12:20 2009 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3no warnings;
4use strict qw(subs vars);
5
6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 3use Scalar::Util ();
9use Carp (); 4use Carp ();
10use Fcntl ();
11use Errno qw(EAGAIN EINTR); 5use Errno qw(EAGAIN EINTR);
12 6
7use AnyEvent (); BEGIN { AnyEvent::common_sense }
8use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
13=head1 NAME 10=head1 NAME
14 11
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 13
17=cut 14=cut
18 15
19our $VERSION = 4.452; 16our $VERSION = 4.83;
20 17
21=head1 SYNOPSIS 18=head1 SYNOPSIS
22 19
23 use AnyEvent; 20 use AnyEvent;
24 use AnyEvent::Handle; 21 use AnyEvent::Handle;
25 22
26 my $cv = AnyEvent->condvar; 23 my $cv = AnyEvent->condvar;
27 24
28 my $handle = 25 my $hdl; $hdl = new AnyEvent::Handle
29 AnyEvent::Handle->new (
30 fh => \*STDIN, 26 fh => \*STDIN,
31 on_eof => sub { 27 on_error => sub {
28 my ($hdl, $fatal, $msg) = @_;
29 warn "got error $msg\n";
30 $hdl->destroy;
32 $cv->send; 31 $cv->send;
33 },
34 ); 32 );
35 33
36 # send some request line 34 # send some request line
37 $handle->push_write ("getinfo\015\012"); 35 $hdl->push_write ("getinfo\015\012");
38 36
39 # read the response line 37 # read the response line
40 $handle->push_read (line => sub { 38 $hdl->push_read (line => sub {
41 my ($handle, $line) = @_; 39 my ($hdl, $line) = @_;
42 warn "read line <$line>\n"; 40 warn "got line <$line>\n";
43 $cv->send; 41 $cv->send;
44 }); 42 });
45 43
46 $cv->recv; 44 $cv->recv;
47 45
… …
81 79
82=item on_eof => $cb->($handle) 80=item on_eof => $cb->($handle)
83 81
84Set the callback to be called when an end-of-file condition is detected, 82Set the callback to be called when an end-of-file condition is detected,
85i.e. in the case of a socket, when the other side has closed the 83i.e. in the case of a socket, when the other side has closed the
86connection cleanly. 84connection cleanly, and there are no outstanding read requests in the
85queue (if there are read requests, then an EOF counts as an unexpected
86connection close and will be flagged as an error).
87 87
88For sockets, this just means that the other side has stopped sending data, 88For sockets, this just means that the other side has stopped sending data,
89you can still try to write data, and, in fact, one can return from the EOF 89you can still try to write data, and, in fact, one can return from the EOF
90callback and continue writing data, as only the read part has been shut 90callback and continue writing data, as only the read part has been shut
91down. 91down.
92 92
93While not mandatory, it is I<highly> recommended to set an EOF callback,
94otherwise you might end up with a closed socket while you are still
95waiting for data.
96
97If an EOF condition has been detected but no C<on_eof> callback has been 93If an EOF condition has been detected but no C<on_eof> callback has been
98set, then a fatal error will be raised with C<$!> set to <0>. 94set, then a fatal error will be raised with C<$!> set to <0>.
99 95
100=item on_error => $cb->($handle, $fatal, $message) 96=item on_error => $cb->($handle, $fatal, $message)
101 97
102This is the error callback, which is called when, well, some error 98This is the error callback, which is called when, well, some error
103occured, such as not being able to resolve the hostname, failure to 99occured, such as not being able to resolve the hostname, failure to
104connect or a read error. 100connect or a read error.
105 101
106Some errors are fatal (which is indicated by C<$fatal> being true). On 102Some errors are fatal (which is indicated by C<$fatal> being true). On
107fatal errors the handle object will be shut down and will not be usable 103fatal errors the handle object will be destroyed (by a call to C<< ->
108(but you are free to look at the current C<< ->rbuf >>). Examples of fatal 104destroy >>) after invoking the error callback (which means you are free to
109errors are an EOF condition with active (but unsatisifable) read watchers 105examine the handle object). Examples of fatal errors are an EOF condition
110(C<EPIPE>) or I/O errors. 106with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors.
111 107
112AnyEvent::Handle tries to find an appropriate error code for you to check 108AnyEvent::Handle tries to find an appropriate error code for you to check
113against, but in some cases (TLS errors), this does not work well. It is 109against, but in some cases (TLS errors), this does not work well. It is
114recommended to always output the C<$message> argument in human-readable 110recommended to always output the C<$message> argument in human-readable
115error messages (it's usually the same as C<"$!">). 111error messages (it's usually the same as C<"$!">).
… …
141 137
142When an EOF condition is detected then AnyEvent::Handle will first try to 138When an EOF condition is detected then AnyEvent::Handle will first try to
143feed all the remaining data to the queued callbacks and C<on_read> before 139feed all the remaining data to the queued callbacks and C<on_read> before
144calling the C<on_eof> callback. If no progress can be made, then a fatal 140calling the C<on_eof> callback. If no progress can be made, then a fatal
145error will be raised (with C<$!> set to C<EPIPE>). 141error will be raised (with C<$!> set to C<EPIPE>).
142
143Note that, unlike requests in the read queue, an C<on_read> callback
144doesn't mean you I<require> some data: if there is an EOF and there
145are outstanding read requests then an error will be flagged. With an
146C<on_read> callback, the C<on_eof> callback will be invoked.
146 147
147=item on_drain => $cb->($handle) 148=item on_drain => $cb->($handle)
148 149
149This sets the callback that is called when the write buffer becomes empty 150This sets the callback that is called when the write buffer becomes empty
150(or when the callback is set and the buffer is empty already). 151(or when the callback is set and the buffer is empty already).
… …
249 250
250A string used to identify the remote site - usually the DNS hostname 251A string used to identify the remote site - usually the DNS hostname
251(I<not> IDN!) used to create the connection, rarely the IP address. 252(I<not> IDN!) used to create the connection, rarely the IP address.
252 253
253Apart from being useful in error messages, this string is also used in TLS 254Apart from being useful in error messages, this string is also used in TLS
254peername verification (see C<verify_peername> in L<AnyEvent::TLS>). 255peername verification (see C<verify_peername> in L<AnyEvent::TLS>). This
256verification will be skipped when C<peername> is not specified or
257C<undef>.
255 258
256=item tls => "accept" | "connect" | Net::SSLeay::SSL object 259=item tls => "accept" | "connect" | Net::SSLeay::SSL object
257 260
258When this parameter is given, it enables TLS (SSL) mode, that means 261When this parameter is given, it enables TLS (SSL) mode, that means
259AnyEvent will start a TLS handshake as soon as the conenction has been 262AnyEvent will start a TLS handshake as soon as the conenction has been
… …
367 if $self->{on_read}; 370 if $self->{on_read};
368 371
369 $self->{fh} && $self 372 $self->{fh} && $self
370} 373}
371 374
372sub _shutdown { 375#sub _shutdown {
373 my ($self) = @_; 376# my ($self) = @_;
374 377#
375 delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)}; 378# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
376 $self->{_eof} = 1; # tell starttls et. al to stop trying 379# $self->{_eof} = 1; # tell starttls et. al to stop trying
377 380#
378 &_freetls; 381# &_freetls;
379} 382#}
380 383
381sub _error { 384sub _error {
382 my ($self, $errno, $fatal, $message) = @_; 385 my ($self, $errno, $fatal, $message) = @_;
383 386
384 $self->_shutdown
385 if $fatal;
386
387 $! = $errno; 387 $! = $errno;
388 $message ||= "$!"; 388 $message ||= "$!";
389 389
390 if ($self->{on_error}) { 390 if ($self->{on_error}) {
391 $self->{on_error}($self, $fatal, $message); 391 $self->{on_error}($self, $fatal, $message);
392 $self->destroy if $fatal;
392 } elsif ($self->{fh}) { 393 } elsif ($self->{fh}) {
394 $self->destroy;
393 Carp::croak "AnyEvent::Handle uncaught error: $message"; 395 Carp::croak "AnyEvent::Handle uncaught error: $message";
394 } 396 }
395} 397}
396 398
397=item $fh = $handle->fh 399=item $fh = $handle->fh
… …
512 $self->{_activity} = $NOW; 514 $self->{_activity} = $NOW;
513 515
514 if ($self->{on_timeout}) { 516 if ($self->{on_timeout}) {
515 $self->{on_timeout}($self); 517 $self->{on_timeout}($self);
516 } else { 518 } else {
517 $self->_error (&Errno::ETIMEDOUT); 519 $self->_error (Errno::ETIMEDOUT);
518 } 520 }
519 521
520 # callback could have changed timeout value, optimise 522 # callback could have changed timeout value, optimise
521 return unless $self->{timeout}; 523 return unless $self->{timeout};
522 524
… …
585 Scalar::Util::weaken $self; 587 Scalar::Util::weaken $self;
586 588
587 my $cb = sub { 589 my $cb = sub {
588 my $len = syswrite $self->{fh}, $self->{wbuf}; 590 my $len = syswrite $self->{fh}, $self->{wbuf};
589 591
590 if ($len >= 0) { 592 if (defined $len) {
591 substr $self->{wbuf}, 0, $len, ""; 593 substr $self->{wbuf}, 0, $len, "";
592 594
593 $self->{_activity} = AnyEvent->now; 595 $self->{_activity} = AnyEvent->now;
594 596
595 $self->{on_drain}($self) 597 $self->{on_drain}($self)
… …
864 866
865 if ( 867 if (
866 defined $self->{rbuf_max} 868 defined $self->{rbuf_max}
867 && $self->{rbuf_max} < length $self->{rbuf} 869 && $self->{rbuf_max} < length $self->{rbuf}
868 ) { 870 ) {
869 $self->_error (&Errno::ENOSPC, 1), return; 871 $self->_error (Errno::ENOSPC, 1), return;
870 } 872 }
871 873
872 while () { 874 while () {
873 # we need to use a separate tls read buffer, as we must not receive data while 875 # we need to use a separate tls read buffer, as we must not receive data while
874 # we are draining the buffer, and this can only happen with TLS. 876 # we are draining the buffer, and this can only happen with TLS.
… …
878 880
879 if (my $cb = shift @{ $self->{_queue} }) { 881 if (my $cb = shift @{ $self->{_queue} }) {
880 unless ($cb->($self)) { 882 unless ($cb->($self)) {
881 if ($self->{_eof}) { 883 if ($self->{_eof}) {
882 # no progress can be made (not enough data and no data forthcoming) 884 # no progress can be made (not enough data and no data forthcoming)
883 $self->_error (&Errno::EPIPE, 1), return; 885 $self->_error (Errno::EPIPE, 1), return;
884 } 886 }
885 887
886 unshift @{ $self->{_queue} }, $cb; 888 unshift @{ $self->{_queue} }, $cb;
887 last; 889 last;
888 } 890 }
… …
896 && !@{ $self->{_queue} } # and the queue is still empty 898 && !@{ $self->{_queue} } # and the queue is still empty
897 && $self->{on_read} # but we still have on_read 899 && $self->{on_read} # but we still have on_read
898 ) { 900 ) {
899 # no further data will arrive 901 # no further data will arrive
900 # so no progress can be made 902 # so no progress can be made
901 $self->_error (&Errno::EPIPE, 1), return 903 $self->_error (Errno::EPIPE, 1), return
902 if $self->{_eof}; 904 if $self->{_eof};
903 905
904 last; # more data might arrive 906 last; # more data might arrive
905 } 907 }
906 } else { 908 } else {
… …
1156 return 1; 1158 return 1;
1157 } 1159 }
1158 1160
1159 # reject 1161 # reject
1160 if ($reject && $$rbuf =~ $reject) { 1162 if ($reject && $$rbuf =~ $reject) {
1161 $self->_error (&Errno::EBADMSG); 1163 $self->_error (Errno::EBADMSG);
1162 } 1164 }
1163 1165
1164 # skip 1166 # skip
1165 if ($skip && $$rbuf =~ $skip) { 1167 if ($skip && $$rbuf =~ $skip) {
1166 $data .= substr $$rbuf, 0, $+[0], ""; 1168 $data .= substr $$rbuf, 0, $+[0], "";
… …
1182 my ($self, $cb) = @_; 1184 my ($self, $cb) = @_;
1183 1185
1184 sub { 1186 sub {
1185 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 1187 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
1186 if ($_[0]{rbuf} =~ /[^0-9]/) { 1188 if ($_[0]{rbuf} =~ /[^0-9]/) {
1187 $self->_error (&Errno::EBADMSG); 1189 $self->_error (Errno::EBADMSG);
1188 } 1190 }
1189 return; 1191 return;
1190 } 1192 }
1191 1193
1192 my $len = $1; 1194 my $len = $1;
… …
1195 my $string = $_[1]; 1197 my $string = $_[1];
1196 $_[0]->unshift_read (chunk => 1, sub { 1198 $_[0]->unshift_read (chunk => 1, sub {
1197 if ($_[1] eq ",") { 1199 if ($_[1] eq ",") {
1198 $cb->($_[0], $string); 1200 $cb->($_[0], $string);
1199 } else { 1201 } else {
1200 $self->_error (&Errno::EBADMSG); 1202 $self->_error (Errno::EBADMSG);
1201 } 1203 }
1202 }); 1204 });
1203 }); 1205 });
1204 1206
1205 1 1207 1
… …
1295 $json->incr_skip; 1297 $json->incr_skip;
1296 1298
1297 $self->{rbuf} = $json->incr_text; 1299 $self->{rbuf} = $json->incr_text;
1298 $json->incr_text = ""; 1300 $json->incr_text = "";
1299 1301
1300 $self->_error (&Errno::EBADMSG); 1302 $self->_error (Errno::EBADMSG);
1301 1303
1302 () 1304 ()
1303 } else { 1305 } else {
1304 $self->{rbuf} = ""; 1306 $self->{rbuf} = "";
1305 1307
… …
1342 # read remaining chunk 1344 # read remaining chunk
1343 $_[0]->unshift_read (chunk => $len, sub { 1345 $_[0]->unshift_read (chunk => $len, sub {
1344 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1346 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1345 $cb->($_[0], $ref); 1347 $cb->($_[0], $ref);
1346 } else { 1348 } else {
1347 $self->_error (&Errno::EBADMSG); 1349 $self->_error (Errno::EBADMSG);
1348 } 1350 }
1349 }); 1351 });
1350 } 1352 }
1351 1353
1352 1 1354 1
… …
1450 if ($self->{_on_starttls}) { 1452 if ($self->{_on_starttls}) {
1451 (delete $self->{_on_starttls})->($self, undef, $err); 1453 (delete $self->{_on_starttls})->($self, undef, $err);
1452 &_freetls; 1454 &_freetls;
1453 } else { 1455 } else {
1454 &_freetls; 1456 &_freetls;
1455 $self->_error (&Errno::EPROTO, 1, $err); 1457 $self->_error (Errno::EPROTO, 1, $err);
1456 } 1458 }
1457} 1459}
1458 1460
1459# poll the write BIO and send the data if applicable 1461# poll the write BIO and send the data if applicable
1460# also decode read data if possible 1462# also decode read data if possible
… …
1669callbacks, as well as code outside. It does I<NOT> work in a read or write 1671callbacks, as well as code outside. It does I<NOT> work in a read or write
1670callback, so when you want to destroy the AnyEvent::Handle object from 1672callback, so when you want to destroy the AnyEvent::Handle object from
1671within such an callback. You I<MUST> call C<< ->destroy >> explicitly in 1673within such an callback. You I<MUST> call C<< ->destroy >> explicitly in
1672that case. 1674that case.
1673 1675
1676Destroying the handle object in this way has the advantage that callbacks
1677will be removed as well, so if those are the only reference holders (as
1678is common), then one doesn't need to do anything special to break any
1679reference cycles.
1680
1674The handle might still linger in the background and write out remaining 1681The handle might still linger in the background and write out remaining
1675data, as specified by the C<linger> option, however. 1682data, as specified by the C<linger> option, however.
1676 1683
1677=cut 1684=cut
1678 1685
… …
1745 1752
1746 $handle->on_read (sub { }); 1753 $handle->on_read (sub { });
1747 $handle->on_eof (undef); 1754 $handle->on_eof (undef);
1748 $handle->on_error (sub { 1755 $handle->on_error (sub {
1749 my $data = delete $_[0]{rbuf}; 1756 my $data = delete $_[0]{rbuf};
1750 undef $handle;
1751 }); 1757 });
1752 1758
1753The reason to use C<on_error> is that TCP connections, due to latencies 1759The reason to use C<on_error> is that TCP connections, due to latencies
1754and packets loss, might get closed quite violently with an error, when in 1760and packets loss, might get closed quite violently with an error, when in
1755fact, all data has been received. 1761fact, all data has been received.
… …
1780 1786
1781If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS, 1787If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS,
1782simply connect to it and then create the AnyEvent::Handle with the C<tls> 1788simply connect to it and then create the AnyEvent::Handle with the C<tls>
1783parameter: 1789parameter:
1784 1790
1791 tcp_connect $host, $port, sub {
1792 my ($fh) = @_;
1793
1785 my $handle = new AnyEvent::Handle 1794 my $handle = new AnyEvent::Handle
1786 fh => $fh, 1795 fh => $fh,
1787 tls => "connect", 1796 tls => "connect",
1788 on_error => sub { ... }; 1797 on_error => sub { ... };
1789 1798
1790 $handle->push_write (...); 1799 $handle->push_write (...);
1800 };
1791 1801
1792=item I want to contact a TLS/SSL server, I do care about security. 1802=item I want to contact a TLS/SSL server, I do care about security.
1793 1803
1794Then you #x##TODO# 1804Then you should additionally enable certificate verification, including
1805peername verification, if the protocol you use supports it (see
1806L<AnyEvent::TLS>, C<verify_peername>).
1795 1807
1796 1808E.g. for HTTPS:
1809
1810 tcp_connect $host, $port, sub {
1811 my ($fh) = @_;
1812
1813 my $handle = new AnyEvent::Handle
1814 fh => $fh,
1815 peername => $host,
1816 tls => "connect",
1817 tls_ctx => { verify => 1, verify_peername => "https" },
1818 ...
1819
1820Note that you must specify the hostname you connected to (or whatever
1821"peername" the protocol needs) as the C<peername> argument, otherwise no
1822peername verification will be done.
1823
1824The above will use the system-dependent default set of trusted CA
1825certificates. If you want to check against a specific CA, add the
1826C<ca_file> (or C<ca_cert>) arguments to C<tls_ctx>:
1827
1828 tls_ctx => {
1829 verify => 1,
1830 verify_peername => "https",
1831 ca_file => "my-ca-cert.pem",
1832 },
1833
1834=item I want to create a TLS/SSL server, how do I do that?
1835
1836Well, you first need to get a server certificate and key. You have
1837three options: a) ask a CA (buy one, use cacert.org etc.) b) create a
1838self-signed certificate (cheap. check the search engine of your choice,
1839there are many tutorials on the net) or c) make your own CA (tinyca2 is a
1840nice program for that purpose).
1841
1842Then create a file with your private key (in PEM format, see
1843L<AnyEvent::TLS>), followed by the certificate (also in PEM format). The
1844file should then look like this:
1845
1846 -----BEGIN RSA PRIVATE KEY-----
1847 ...header data
1848 ... lots of base64'y-stuff
1849 -----END RSA PRIVATE KEY-----
1850
1851 -----BEGIN CERTIFICATE-----
1852 ... lots of base64'y-stuff
1853 -----END CERTIFICATE-----
1854
1855The important bits are the "PRIVATE KEY" and "CERTIFICATE" parts. Then
1856specify this file as C<cert_file>:
1857
1858 tcp_server undef, $port, sub {
1859 my ($fh) = @_;
1860
1861 my $handle = new AnyEvent::Handle
1862 fh => $fh,
1863 tls => "accept",
1864 tls_ctx => { cert_file => "my-server-keycert.pem" },
1865 ...
1866
1867When you have intermediate CA certificates that your clients might not
1868know about, just append them to the C<cert_file>.
1797 1869
1798=back 1870=back
1799 1871
1800 1872
1801=head1 SUBCLASSING AnyEvent::Handle 1873=head1 SUBCLASSING AnyEvent::Handle

Diff Legend

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