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.152 by root, Fri Jul 17 14:57:03 2009 UTC

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

Diff Legend

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