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.75 by root, Fri Jul 18 02:14:44 2008 UTC vs.
Revision 1.87 by root, Thu Aug 21 20:52:39 2008 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3no warnings; 3no warnings;
4use strict; 4use strict qw(subs vars);
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
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.22; 19our $VERSION = 4.232;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
49 49
50This module is a helper module to make it easier to do event-based I/O on 50This module is a helper module to make it easier to do event-based I/O on
51filehandles. For utility functions for doing non-blocking connects and accepts 51filehandles. For utility functions for doing non-blocking connects and accepts
52on sockets see L<AnyEvent::Util>. 52on sockets see L<AnyEvent::Util>.
53 53
54The L<AnyEvent::Intro> tutorial contains some well-documented
55AnyEvent::Handle examples.
56
54In the following, when the documentation refers to of "bytes" then this 57In the following, when the documentation refers to of "bytes" then this
55means characters. As sysread and syswrite are used for all I/O, their 58means characters. As sysread and syswrite are used for all I/O, their
56treatment of characters applies to this module as well. 59treatment of characters applies to this module as well.
57 60
58All callbacks will be invoked with the handle object as their first 61All callbacks will be invoked with the handle object as their first
70 73
71=item fh => $filehandle [MANDATORY] 74=item fh => $filehandle [MANDATORY]
72 75
73The filehandle this L<AnyEvent::Handle> object will operate on. 76The filehandle this L<AnyEvent::Handle> object will operate on.
74 77
75NOTE: The filehandle will be set to non-blocking (using 78NOTE: The filehandle will be set to non-blocking mode (using
76AnyEvent::Util::fh_nonblocking). 79C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
80that mode.
77 81
78=item on_eof => $cb->($handle) 82=item on_eof => $cb->($handle)
79 83
80Set the callback to be called when an end-of-file condition is detected, 84Set the callback to be called when an end-of-file condition is detected,
81i.e. in the case of a socket, when the other side has closed the 85i.e. in the case of a socket, when the other side has closed the
82connection cleanly. 86connection cleanly.
83 87
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
90callback and continue writing data, as only the read part has been shut
91down.
92
84While not mandatory, it is highly recommended to set an eof callback, 93While not mandatory, it is I<highly> recommended to set an eof callback,
85otherwise you might end up with a closed socket while you are still 94otherwise you might end up with a closed socket while you are still
86waiting for data. 95waiting for data.
96
97If 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>.
87 99
88=item on_error => $cb->($handle, $fatal) 100=item on_error => $cb->($handle, $fatal)
89 101
90This is the error callback, which is called when, well, some error 102This is the error callback, which is called when, well, some error
91occured, such as not being able to resolve the hostname, failure to 103occured, such as not being able to resolve the hostname, failure to
92connect or a read error. 104connect or a read error.
93 105
94Some errors are fatal (which is indicated by C<$fatal> being true). On 106Some errors are fatal (which is indicated by C<$fatal> being true). On
95fatal errors the handle object will be shut down and will not be 107fatal errors the handle object will be shut down and will not be usable
108(but you are free to look at the current C< ->rbuf >). Examples of fatal
109errors are an EOF condition with active (but unsatisifable) read watchers
110(C<EPIPE>) or I/O errors.
111
96usable. Non-fatal errors can be retried by simply returning, but it is 112Non-fatal errors can be retried by simply returning, but it is recommended
97recommended to simply ignore this parameter and instead abondon the handle 113to simply ignore this parameter and instead abondon the handle object
98object when this callback is invoked. 114when this callback is invoked. Examples of non-fatal errors are timeouts
115C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
99 116
100On callback entrance, the value of C<$!> contains the operating system 117On callback entrance, the value of C<$!> contains the operating system
101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>). 118error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
102 119
103While not mandatory, it is I<highly> recommended to set this callback, as 120While not mandatory, it is I<highly> recommended to set this callback, as
210This will not work for partial TLS data that could not yet been 227This will not work for partial TLS data that could not yet been
211encoded. This data will be lost. 228encoded. This data will be lost.
212 229
213=item tls => "accept" | "connect" | Net::SSLeay::SSL object 230=item tls => "accept" | "connect" | Net::SSLeay::SSL object
214 231
215When this parameter is given, it enables TLS (SSL) mode, that means it 232When this parameter is given, it enables TLS (SSL) mode, that means
216will start making tls handshake and will transparently encrypt/decrypt 233AnyEvent will start a TLS handshake and will transparently encrypt/decrypt
217data. 234data.
218 235
219TLS mode requires Net::SSLeay to be installed (it will be loaded 236TLS mode requires Net::SSLeay to be installed (it will be loaded
220automatically when you try to create a TLS handle). 237automatically when you try to create a TLS handle).
221 238
222For the TLS server side, use C<accept>, and for the TLS client side of a 239Unlike TCP, TLS has a server and client side: for the TLS server side, use
223connection, use C<connect> mode. 240C<accept>, and for the TLS client side of a connection, use C<connect>
241mode.
224 242
225You can also provide your own TLS connection object, but you have 243You can also provide your own TLS connection object, but you have
226to make sure that you call either C<Net::SSLeay::set_connect_state> 244to make sure that you call either C<Net::SSLeay::set_connect_state>
227or C<Net::SSLeay::set_accept_state> on it before you pass it to 245or C<Net::SSLeay::set_accept_state> on it before you pass it to
228AnyEvent::Handle. 246AnyEvent::Handle.
229 247
230See the C<starttls> method if you need to start TLS negotiation later. 248See the C<starttls> method for when need to start TLS negotiation later.
231 249
232=item tls_ctx => $ssl_ctx 250=item tls_ctx => $ssl_ctx
233 251
234Use the given Net::SSLeay::CTX object to create the new TLS connection 252Use the given Net::SSLeay::CTX object to create the new TLS connection
235(unless a connection object was specified directly). If this parameter is 253(unless a connection object was specified directly). If this parameter is
238=item json => JSON or JSON::XS object 256=item json => JSON or JSON::XS object
239 257
240This is the json coder object used by the C<json> read and write types. 258This is the json coder object used by the C<json> read and write types.
241 259
242If you don't supply it, then AnyEvent::Handle will create and use a 260If you don't supply it, then AnyEvent::Handle will create and use a
243suitable one, which will write and expect UTF-8 encoded JSON texts. 261suitable one (on demand), which will write and expect UTF-8 encoded JSON
262texts.
244 263
245Note that you are responsible to depend on the JSON module if you want to 264Note that you are responsible to depend on the JSON module if you want to
246use this functionality, as AnyEvent does not have a dependency itself. 265use this functionality, as AnyEvent does not have a dependency itself.
247 266
248=item filter_r => $cb 267=item filter_r => $cb
249 268
250=item filter_w => $cb 269=item filter_w => $cb
251 270
252These exist, but are undocumented at this time. 271These exist, but are undocumented at this time. (They are used internally
272by the TLS code).
253 273
254=back 274=back
255 275
256=cut 276=cut
257 277
288 delete $self->{_rw}; 308 delete $self->{_rw};
289 delete $self->{_ww}; 309 delete $self->{_ww};
290 delete $self->{fh}; 310 delete $self->{fh};
291 311
292 $self->stoptls; 312 $self->stoptls;
313
314 delete $self->{on_read};
315 delete $self->{_queue};
293} 316}
294 317
295sub _error { 318sub _error {
296 my ($self, $errno, $fatal) = @_; 319 my ($self, $errno, $fatal) = @_;
297 320
726 749
727 if ( 750 if (
728 defined $self->{rbuf_max} 751 defined $self->{rbuf_max}
729 && $self->{rbuf_max} < length $self->{rbuf} 752 && $self->{rbuf_max} < length $self->{rbuf}
730 ) { 753 ) {
731 return $self->_error (&Errno::ENOSPC, 1); 754 $self->_error (&Errno::ENOSPC, 1), return;
732 } 755 }
733 756
734 while () { 757 while () {
735 no strict 'refs';
736
737 my $len = length $self->{rbuf}; 758 my $len = length $self->{rbuf};
738 759
739 if (my $cb = shift @{ $self->{_queue} }) { 760 if (my $cb = shift @{ $self->{_queue} }) {
740 unless ($cb->($self)) { 761 unless ($cb->($self)) {
741 if ($self->{_eof}) { 762 if ($self->{_eof}) {
742 # no progress can be made (not enough data and no data forthcoming) 763 # no progress can be made (not enough data and no data forthcoming)
743 $self->_error (&Errno::EPIPE, 1), last; 764 $self->_error (&Errno::EPIPE, 1), return;
744 } 765 }
745 766
746 unshift @{ $self->{_queue} }, $cb; 767 unshift @{ $self->{_queue} }, $cb;
747 last; 768 last;
748 } 769 }
756 && !@{ $self->{_queue} } # and the queue is still empty 777 && !@{ $self->{_queue} } # and the queue is still empty
757 && $self->{on_read} # but we still have on_read 778 && $self->{on_read} # but we still have on_read
758 ) { 779 ) {
759 # no further data will arrive 780 # no further data will arrive
760 # so no progress can be made 781 # so no progress can be made
761 $self->_error (&Errno::EPIPE, 1), last 782 $self->_error (&Errno::EPIPE, 1), return
762 if $self->{_eof}; 783 if $self->{_eof};
763 784
764 last; # more data might arrive 785 last; # more data might arrive
765 } 786 }
766 } else { 787 } else {
768 delete $self->{_rw}; 789 delete $self->{_rw};
769 last; 790 last;
770 } 791 }
771 } 792 }
772 793
794 if ($self->{_eof}) {
795 if ($self->{on_eof}) {
773 $self->{on_eof}($self) 796 $self->{on_eof}($self)
774 if $self->{_eof} && $self->{on_eof}; 797 } else {
798 $self->_error (0, 1);
799 }
800 }
775 801
776 # may need to restart read watcher 802 # may need to restart read watcher
777 unless ($self->{_rw}) { 803 unless ($self->{_rw}) {
778 $self->start_read 804 $self->start_read
779 if $self->{on_read} || @{ $self->{_queue} }; 805 if $self->{on_read} || @{ $self->{_queue} };
905 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 931 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
906 1 932 1
907 } 933 }
908}; 934};
909 935
910# compatibility with older API
911sub push_read_chunk {
912 $_[0]->push_read (chunk => $_[1], $_[2]);
913}
914
915sub unshift_read_chunk {
916 $_[0]->unshift_read (chunk => $_[1], $_[2]);
917}
918
919=item line => [$eol, ]$cb->($handle, $line, $eol) 936=item line => [$eol, ]$cb->($handle, $line, $eol)
920 937
921The callback will be called only once a full line (including the end of 938The callback will be called only once a full line (including the end of
922line marker, C<$eol>) has been read. This line (excluding the end of line 939line marker, C<$eol>) has been read. This line (excluding the end of line
923marker) will be passed to the callback as second argument (C<$line>), and 940marker) will be passed to the callback as second argument (C<$line>), and
938=cut 955=cut
939 956
940register_read_type line => sub { 957register_read_type line => sub {
941 my ($self, $cb, $eol) = @_; 958 my ($self, $cb, $eol) = @_;
942 959
943 $eol = qr|(\015?\012)| if @_ < 3; 960 if (@_ < 3) {
961 # this is more than twice as fast as the generic code below
962 sub {
963 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
964
965 $cb->($_[0], $1, $2);
966 1
967 }
968 } else {
944 $eol = quotemeta $eol unless ref $eol; 969 $eol = quotemeta $eol unless ref $eol;
945 $eol = qr|^(.*?)($eol)|s; 970 $eol = qr|^(.*?)($eol)|s;
946 971
947 sub { 972 sub {
948 $_[0]{rbuf} =~ s/$eol// or return; 973 $_[0]{rbuf} =~ s/$eol// or return;
949 974
950 $cb->($_[0], $1, $2); 975 $cb->($_[0], $1, $2);
976 1
951 1 977 }
952 } 978 }
953}; 979};
954
955# compatibility with older API
956sub push_read_line {
957 my $self = shift;
958 $self->push_read (line => @_);
959}
960
961sub unshift_read_line {
962 my $self = shift;
963 $self->unshift_read (line => @_);
964}
965 980
966=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 981=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
967 982
968Makes a regex match against the regex object C<$accept> and returns 983Makes a regex match against the regex object C<$accept> and returns
969everything up to and including the match. 984everything up to and including the match.
1090register_read_type packstring => sub { 1105register_read_type packstring => sub {
1091 my ($self, $cb, $format) = @_; 1106 my ($self, $cb, $format) = @_;
1092 1107
1093 sub { 1108 sub {
1094 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1109 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1095 defined (my $len = eval { unpack $format, $_[0]->{rbuf} }) 1110 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1096 or return; 1111 or return;
1097 1112
1113 $format = length pack $format, $len;
1114
1115 # bypass unshift if we already have the remaining chunk
1116 if ($format + $len <= length $_[0]{rbuf}) {
1117 my $data = substr $_[0]{rbuf}, $format, $len;
1118 substr $_[0]{rbuf}, 0, $format + $len, "";
1119 $cb->($_[0], $data);
1120 } else {
1098 # remove prefix 1121 # remove prefix
1099 substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; 1122 substr $_[0]{rbuf}, 0, $format, "";
1100 1123
1101 # read rest 1124 # read remaining chunk
1102 $_[0]->unshift_read (chunk => $len, $cb); 1125 $_[0]->unshift_read (chunk => $len, $cb);
1126 }
1103 1127
1104 1 1128 1
1105 } 1129 }
1106}; 1130};
1107 1131
1164 1188
1165 require Storable; 1189 require Storable;
1166 1190
1167 sub { 1191 sub {
1168 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1192 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1169 defined (my $len = eval { unpack "w", $_[0]->{rbuf} }) 1193 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1170 or return; 1194 or return;
1171 1195
1196 my $format = length pack "w", $len;
1197
1198 # bypass unshift if we already have the remaining chunk
1199 if ($format + $len <= length $_[0]{rbuf}) {
1200 my $data = substr $_[0]{rbuf}, $format, $len;
1201 substr $_[0]{rbuf}, 0, $format + $len, "";
1202 $cb->($_[0], Storable::thaw ($data));
1203 } else {
1172 # remove prefix 1204 # remove prefix
1173 substr $_[0]->{rbuf}, 0, (length pack "w", $len), ""; 1205 substr $_[0]{rbuf}, 0, $format, "";
1174 1206
1175 # read rest 1207 # read remaining chunk
1176 $_[0]->unshift_read (chunk => $len, sub { 1208 $_[0]->unshift_read (chunk => $len, sub {
1177 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1209 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1178 $cb->($_[0], $ref); 1210 $cb->($_[0], $ref);
1179 } else { 1211 } else {
1180 $self->_error (&Errno::EBADMSG); 1212 $self->_error (&Errno::EBADMSG);
1213 }
1181 } 1214 });
1182 }); 1215 }
1216
1217 1
1183 } 1218 }
1184}; 1219};
1185 1220
1186=back 1221=back
1187 1222
1333 # basically, this is deep magic (because SSL_read should have the same issues) 1368 # basically, this is deep magic (because SSL_read should have the same issues)
1334 # but the openssl maintainers basically said: "trust us, it just works". 1369 # but the openssl maintainers basically said: "trust us, it just works".
1335 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1370 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1336 # and mismaintained ssleay-module doesn't even offer them). 1371 # and mismaintained ssleay-module doesn't even offer them).
1337 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1372 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
1373 #
1374 # in short: this is a mess.
1375 #
1376 # note that we do not try to kepe the length constant between writes as we are required to do.
1377 # we assume that most (but not all) of this insanity only applies to non-blocking cases,
1378 # and we drive openssl fully in blocking mode here.
1338 Net::SSLeay::CTX_set_mode ($self->{tls}, 1379 Net::SSLeay::CTX_set_mode ($self->{tls},
1339 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1380 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1340 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1381 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1341 1382
1342 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1383 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines