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.61 by root, Fri Jun 6 10:23:50 2008 UTC vs.
Revision 1.91 by root, Wed Oct 1 07:40: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.14; 19our $VERSION = 4.3;
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
59argument. 62argument.
60 63
64=head2 SIGPIPE is not handled by this module
65
66SIGPIPE is not handled by this module, so one of the practical
67requirements of using it is to ignore SIGPIPE (C<$SIG{PIPE} =
68'IGNORE'>). At least, this is highly recommend in a networked program: If
69you use AnyEvent::Handle in a filter program (like sort), exiting on
70SIGPIPE is probably the right thing to do.
71
61=head1 METHODS 72=head1 METHODS
62 73
63=over 4 74=over 4
64 75
65=item B<new (%args)> 76=item B<new (%args)>
70 81
71=item fh => $filehandle [MANDATORY] 82=item fh => $filehandle [MANDATORY]
72 83
73The filehandle this L<AnyEvent::Handle> object will operate on. 84The filehandle this L<AnyEvent::Handle> object will operate on.
74 85
75NOTE: The filehandle will be set to non-blocking (using 86NOTE: The filehandle will be set to non-blocking mode (using
76AnyEvent::Util::fh_nonblocking). 87C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
88that mode.
77 89
78=item on_eof => $cb->($handle) 90=item on_eof => $cb->($handle)
79 91
80Set the callback to be called when an end-of-file condition is detcted, 92Set 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 93i.e. in the case of a socket, when the other side has closed the
82connection cleanly. 94connection cleanly.
83 95
96For sockets, this just means that the other side has stopped sending data,
97you can still try to write data, and, in fact, one can return from the eof
98callback and continue writing data, as only the read part has been shut
99down.
100
84While not mandatory, it is highly recommended to set an eof callback, 101While 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 102otherwise you might end up with a closed socket while you are still
86waiting for data. 103waiting for data.
104
105If an EOF condition has been detected but no C<on_eof> callback has been
106set, then a fatal error will be raised with C<$!> set to <0>.
87 107
88=item on_error => $cb->($handle, $fatal) 108=item on_error => $cb->($handle, $fatal)
89 109
90This is the error callback, which is called when, well, some error 110This is the error callback, which is called when, well, some error
91occured, such as not being able to resolve the hostname, failure to 111occured, such as not being able to resolve the hostname, failure to
92connect or a read error. 112connect or a read error.
93 113
94Some errors are fatal (which is indicated by C<$fatal> being true). On 114Some 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 115fatal errors the handle object will be shut down and will not be usable
116(but you are free to look at the current C<< ->rbuf >>). Examples of fatal
117errors are an EOF condition with active (but unsatisifable) read watchers
118(C<EPIPE>) or I/O errors.
119
96usable. Non-fatal errors can be retried by simply returning, but it is 120Non-fatal errors can be retried by simply returning, but it is recommended
97recommended to simply ignore this parameter and instead abondon the handle 121to simply ignore this parameter and instead abondon the handle object
98object when this callback is invoked. 122when this callback is invoked. Examples of non-fatal errors are timeouts
123C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
99 124
100On callback entrance, the value of C<$!> contains the operating system 125On callback entrance, the value of C<$!> contains the operating system
101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>). 126error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
102 127
103While not mandatory, it is I<highly> recommended to set this callback, as 128While not mandatory, it is I<highly> recommended to set this callback, as
124This sets the callback that is called when the write buffer becomes empty 149This sets the callback that is called when the write buffer becomes empty
125(or when the callback is set and the buffer is empty already). 150(or when the callback is set and the buffer is empty already).
126 151
127To append to the write buffer, use the C<< ->push_write >> method. 152To append to the write buffer, use the C<< ->push_write >> method.
128 153
154This callback is useful when you don't want to put all of your write data
155into the queue at once, for example, when you want to write the contents
156of some file to the socket you might not want to read the whole file into
157memory and push it into the queue, but instead only read more data from
158the file when the write queue becomes empty.
159
129=item timeout => $fractional_seconds 160=item timeout => $fractional_seconds
130 161
131If non-zero, then this enables an "inactivity" timeout: whenever this many 162If non-zero, then this enables an "inactivity" timeout: whenever this many
132seconds pass without a successful read or write on the underlying file 163seconds pass without a successful read or write on the underlying file
133handle, the C<on_timeout> callback will be invoked (and if that one is 164handle, the C<on_timeout> callback will be invoked (and if that one is
134missing, an C<ETIMEDOUT> error will be raised). 165missing, a non-fatal C<ETIMEDOUT> error will be raised).
135 166
136Note that timeout processing is also active when you currently do not have 167Note that timeout processing is also active when you currently do not have
137any outstanding read or write requests: If you plan to keep the connection 168any outstanding read or write requests: If you plan to keep the connection
138idle then you should disable the timout temporarily or ignore the timeout 169idle then you should disable the timout temporarily or ignore the timeout
139in the C<on_timeout> callback. 170in the C<on_timeout> callback, in which case AnyEvent::Handle will simply
171restart the timeout.
140 172
141Zero (the default) disables this timeout. 173Zero (the default) disables this timeout.
142 174
143=item on_timeout => $cb->($handle) 175=item on_timeout => $cb->($handle)
144 176
148 180
149=item rbuf_max => <bytes> 181=item rbuf_max => <bytes>
150 182
151If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 183If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
152when the read buffer ever (strictly) exceeds this size. This is useful to 184when the read buffer ever (strictly) exceeds this size. This is useful to
153avoid denial-of-service attacks. 185avoid some forms of denial-of-service attacks.
154 186
155For example, a server accepting connections from untrusted sources should 187For example, a server accepting connections from untrusted sources should
156be configured to accept only so-and-so much data that it cannot act on 188be configured to accept only so-and-so much data that it cannot act on
157(for example, when expecting a line, an attacker could send an unlimited 189(for example, when expecting a line, an attacker could send an unlimited
158amount of data without a callback ever being called as long as the line 190amount of data without a callback ever being called as long as the line
159isn't finished). 191isn't finished).
160 192
193=item autocork => <boolean>
194
195When disabled (the default), then C<push_write> will try to immediately
196write the data to the handle, if possible. This avoids having to register
197a write watcher and wait for the next event loop iteration, but can
198be inefficient if you write multiple small chunks (on the wire, this
199disadvantage is usually avoided by your kernel's nagle algorithm, see
200C<no_delay>, but this option can save costly syscalls).
201
202When enabled, then writes will always be queued till the next event loop
203iteration. This is efficient when you do many small writes per iteration,
204but less efficient when you do a single write only per iteration (or when
205the write buffer often is full). It also increases write latency.
206
207=item no_delay => <boolean>
208
209When doing small writes on sockets, your operating system kernel might
210wait a bit for more data before actually sending it out. This is called
211the Nagle algorithm, and usually it is beneficial.
212
213In some situations you want as low a delay as possible, which can be
214accomplishd by setting this option to a true value.
215
216The default is your opertaing system's default behaviour (most likely
217enabled), this option explicitly enables or disables it, if possible.
218
161=item read_size => <bytes> 219=item read_size => <bytes>
162 220
163The default read block size (the amount of bytes this module will try to read 221The default read block size (the amount of bytes this module will
164during each (loop iteration). Default: C<8192>. 222try to read during each loop iteration, which affects memory
223requirements). Default: C<8192>.
165 224
166=item low_water_mark => <bytes> 225=item low_water_mark => <bytes>
167 226
168Sets the amount of bytes (default: C<0>) that make up an "empty" write 227Sets the amount of bytes (default: C<0>) that make up an "empty" write
169buffer: If the write reaches this size or gets even samller it is 228buffer: If the write reaches this size or gets even samller it is
170considered empty. 229considered empty.
171 230
231Sometimes it can be beneficial (for performance reasons) to add data to
232the write buffer before it is fully drained, but this is a rare case, as
233the operating system kernel usually buffers data as well, so the default
234is good in almost all cases.
235
236=item linger => <seconds>
237
238If non-zero (default: C<3600>), then the destructor of the
239AnyEvent::Handle object will check whether there is still outstanding
240write data and will install a watcher that will write this data to the
241socket. No errors will be reported (this mostly matches how the operating
242system treats outstanding data at socket close time).
243
244This will not work for partial TLS data that could not be encoded
245yet. This data will be lost.
246
172=item tls => "accept" | "connect" | Net::SSLeay::SSL object 247=item tls => "accept" | "connect" | Net::SSLeay::SSL object
173 248
174When this parameter is given, it enables TLS (SSL) mode, that means it 249When this parameter is given, it enables TLS (SSL) mode, that means
175will start making tls handshake and will transparently encrypt/decrypt 250AnyEvent will start a TLS handshake as soon as the conenction has been
176data. 251established and will transparently encrypt/decrypt data afterwards.
177 252
178TLS mode requires Net::SSLeay to be installed (it will be loaded 253TLS mode requires Net::SSLeay to be installed (it will be loaded
179automatically when you try to create a TLS handle). 254automatically when you try to create a TLS handle): this module doesn't
255have a dependency on that module, so if your module requires it, you have
256to add the dependency yourself.
180 257
181For the TLS server side, use C<accept>, and for the TLS client side of a 258Unlike TCP, TLS has a server and client side: for the TLS server side, use
182connection, use C<connect> mode. 259C<accept>, and for the TLS client side of a connection, use C<connect>
260mode.
183 261
184You can also provide your own TLS connection object, but you have 262You can also provide your own TLS connection object, but you have
185to make sure that you call either C<Net::SSLeay::set_connect_state> 263to make sure that you call either C<Net::SSLeay::set_connect_state>
186or C<Net::SSLeay::set_accept_state> on it before you pass it to 264or C<Net::SSLeay::set_accept_state> on it before you pass it to
187AnyEvent::Handle. 265AnyEvent::Handle.
188 266
189See the C<starttls> method if you need to start TLs negotiation later. 267See the C<< ->starttls >> method for when need to start TLS negotiation later.
190 268
191=item tls_ctx => $ssl_ctx 269=item tls_ctx => $ssl_ctx
192 270
193Use the given Net::SSLeay::CTX object to create the new TLS connection 271Use the given C<Net::SSLeay::CTX> object to create the new TLS connection
194(unless a connection object was specified directly). If this parameter is 272(unless a connection object was specified directly). If this parameter is
195missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 273missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
196 274
197=item json => JSON or JSON::XS object 275=item json => JSON or JSON::XS object
198 276
199This is the json coder object used by the C<json> read and write types. 277This is the json coder object used by the C<json> read and write types.
200 278
201If you don't supply it, then AnyEvent::Handle will create and use a 279If you don't supply it, then AnyEvent::Handle will create and use a
202suitable one, which will write and expect UTF-8 encoded JSON texts. 280suitable one (on demand), which will write and expect UTF-8 encoded JSON
281texts.
203 282
204Note that you are responsible to depend on the JSON module if you want to 283Note that you are responsible to depend on the JSON module if you want to
205use this functionality, as AnyEvent does not have a dependency itself. 284use this functionality, as AnyEvent does not have a dependency itself.
206 285
207=item filter_r => $cb 286=item filter_r => $cb
208 287
209=item filter_w => $cb 288=item filter_w => $cb
210 289
211These exist, but are undocumented at this time. 290These exist, but are undocumented at this time. (They are used internally
291by the TLS code).
212 292
213=back 293=back
214 294
215=cut 295=cut
216 296
229 } 309 }
230 310
231 $self->{_activity} = AnyEvent->now; 311 $self->{_activity} = AnyEvent->now;
232 $self->_timeout; 312 $self->_timeout;
233 313
234 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 314 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain};
315 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
316
317 $self->start_read
318 if $self->{on_read};
235 319
236 $self 320 $self
237} 321}
238 322
239sub _shutdown { 323sub _shutdown {
243 delete $self->{_rw}; 327 delete $self->{_rw};
244 delete $self->{_ww}; 328 delete $self->{_ww};
245 delete $self->{fh}; 329 delete $self->{fh};
246 330
247 $self->stoptls; 331 $self->stoptls;
332
333 delete $self->{on_read};
334 delete $self->{_queue};
248} 335}
249 336
250sub _error { 337sub _error {
251 my ($self, $errno, $fatal) = @_; 338 my ($self, $errno, $fatal) = @_;
252 339
262 } 349 }
263} 350}
264 351
265=item $fh = $handle->fh 352=item $fh = $handle->fh
266 353
267This method returns the file handle of the L<AnyEvent::Handle> object. 354This method returns the file handle used to create the L<AnyEvent::Handle> object.
268 355
269=cut 356=cut
270 357
271sub fh { $_[0]{fh} } 358sub fh { $_[0]{fh} }
272 359
290 $_[0]{on_eof} = $_[1]; 377 $_[0]{on_eof} = $_[1];
291} 378}
292 379
293=item $handle->on_timeout ($cb) 380=item $handle->on_timeout ($cb)
294 381
295Replace the current C<on_timeout> callback, or disables the callback 382Replace the current C<on_timeout> callback, or disables the callback (but
296(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor 383not the timeout) if C<$cb> = C<undef>. See the C<timeout> constructor
297argument. 384argument and method.
298 385
299=cut 386=cut
300 387
301sub on_timeout { 388sub on_timeout {
302 $_[0]{on_timeout} = $_[1]; 389 $_[0]{on_timeout} = $_[1];
390}
391
392=item $handle->autocork ($boolean)
393
394Enables or disables the current autocork behaviour (see C<autocork>
395constructor argument).
396
397=cut
398
399=item $handle->no_delay ($boolean)
400
401Enables or disables the C<no_delay> setting (see constructor argument of
402the same name for details).
403
404=cut
405
406sub no_delay {
407 $_[0]{no_delay} = $_[1];
408
409 eval {
410 local $SIG{__DIE__};
411 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1];
412 };
303} 413}
304 414
305############################################################################# 415#############################################################################
306 416
307=item $handle->timeout ($seconds) 417=item $handle->timeout ($seconds)
422 $self->_error ($!, 1); 532 $self->_error ($!, 1);
423 } 533 }
424 }; 534 };
425 535
426 # try to write data immediately 536 # try to write data immediately
427 $cb->(); 537 $cb->() unless $self->{autocork};
428 538
429 # if still data left in wbuf, we need to poll 539 # if still data left in wbuf, we need to poll
430 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 540 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
431 if length $self->{wbuf}; 541 if length $self->{wbuf};
432 }; 542 };
489=cut 599=cut
490 600
491register_write_type packstring => sub { 601register_write_type packstring => sub {
492 my ($self, $format, $string) = @_; 602 my ($self, $format, $string) = @_;
493 603
494 pack "$format/a", $string 604 pack "$format/a*", $string
495}; 605};
496 606
497=item json => $array_or_hashref 607=item json => $array_or_hashref
498 608
499Encodes the given hash or array reference into a JSON object. Unless you 609Encodes the given hash or array reference into a JSON object. Unless you
533 643
534 $self->{json} ? $self->{json}->encode ($ref) 644 $self->{json} ? $self->{json}->encode ($ref)
535 : JSON::encode_json ($ref) 645 : JSON::encode_json ($ref)
536}; 646};
537 647
648=item storable => $reference
649
650Freezes the given reference using L<Storable> and writes it to the
651handle. Uses the C<nfreeze> format.
652
653=cut
654
655register_write_type storable => sub {
656 my ($self, $ref) = @_;
657
658 require Storable;
659
660 pack "w/a*", Storable::nfreeze ($ref)
661};
662
538=back 663=back
539 664
540=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 665=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
541 666
542This function (not method) lets you add your own types to C<push_write>. 667This function (not method) lets you add your own types to C<push_write>.
564ways, the "simple" way, using only C<on_read> and the "complex" way, using 689ways, the "simple" way, using only C<on_read> and the "complex" way, using
565a queue. 690a queue.
566 691
567In the simple case, you just install an C<on_read> callback and whenever 692In the simple case, you just install an C<on_read> callback and whenever
568new data arrives, it will be called. You can then remove some data (if 693new data arrives, it will be called. You can then remove some data (if
569enough is there) from the read buffer (C<< $handle->rbuf >>) if you want 694enough is there) from the read buffer (C<< $handle->rbuf >>). Or you cna
570or not. 695leave the data there if you want to accumulate more (e.g. when only a
696partial message has been received so far).
571 697
572In the more complex case, you want to queue multiple callbacks. In this 698In the more complex case, you want to queue multiple callbacks. In this
573case, AnyEvent::Handle will call the first queued callback each time new 699case, AnyEvent::Handle will call the first queued callback each time new
574data arrives (also the first time it is queued) and removes it when it has 700data arrives (also the first time it is queued) and removes it when it has
575done its job (see C<push_read>, below). 701done its job (see C<push_read>, below).
593 # handle xml 719 # handle xml
594 }); 720 });
595 }); 721 });
596 }); 722 });
597 723
598Example 2: Implement a client for a protocol that replies either with 724Example 2: Implement a client for a protocol that replies either with "OK"
599"OK" and another line or "ERROR" for one request, and 64 bytes for the 725and another line or "ERROR" for the first request that is sent, and 64
600second request. Due tot he availability of a full queue, we can just 726bytes for the second request. Due to the availability of a queue, we can
601pipeline sending both requests and manipulate the queue as necessary in 727just pipeline sending both requests and manipulate the queue as necessary
602the callbacks: 728in the callbacks.
603 729
604 # request one 730When the first callback is called and sees an "OK" response, it will
731C<unshift> another line-read. This line-read will be queued I<before> the
73264-byte chunk callback.
733
734 # request one, returns either "OK + extra line" or "ERROR"
605 $handle->push_write ("request 1\015\012"); 735 $handle->push_write ("request 1\015\012");
606 736
607 # we expect "ERROR" or "OK" as response, so push a line read 737 # we expect "ERROR" or "OK" as response, so push a line read
608 $handle->push_read (line => sub { 738 $handle->push_read (line => sub {
609 # if we got an "OK", we have to _prepend_ another line, 739 # if we got an "OK", we have to _prepend_ another line,
616 ... 746 ...
617 }); 747 });
618 } 748 }
619 }); 749 });
620 750
621 # request two 751 # request two, simply returns 64 octets
622 $handle->push_write ("request 2\015\012"); 752 $handle->push_write ("request 2\015\012");
623 753
624 # simply read 64 bytes, always 754 # simply read 64 bytes, always
625 $handle->push_read (chunk => 64, sub { 755 $handle->push_read (chunk => 64, sub {
626 my $response = $_[1]; 756 my $response = $_[1];
638 768
639 if ( 769 if (
640 defined $self->{rbuf_max} 770 defined $self->{rbuf_max}
641 && $self->{rbuf_max} < length $self->{rbuf} 771 && $self->{rbuf_max} < length $self->{rbuf}
642 ) { 772 ) {
643 return $self->_error (&Errno::ENOSPC, 1); 773 $self->_error (&Errno::ENOSPC, 1), return;
644 } 774 }
645 775
646 while () { 776 while () {
647 no strict 'refs';
648
649 my $len = length $self->{rbuf}; 777 my $len = length $self->{rbuf};
650 778
651 if (my $cb = shift @{ $self->{_queue} }) { 779 if (my $cb = shift @{ $self->{_queue} }) {
652 unless ($cb->($self)) { 780 unless ($cb->($self)) {
653 if ($self->{_eof}) { 781 if ($self->{_eof}) {
654 # no progress can be made (not enough data and no data forthcoming) 782 # no progress can be made (not enough data and no data forthcoming)
655 $self->_error (&Errno::EPIPE, 1), last; 783 $self->_error (&Errno::EPIPE, 1), return;
656 } 784 }
657 785
658 unshift @{ $self->{_queue} }, $cb; 786 unshift @{ $self->{_queue} }, $cb;
659 last; 787 last;
660 } 788 }
668 && !@{ $self->{_queue} } # and the queue is still empty 796 && !@{ $self->{_queue} } # and the queue is still empty
669 && $self->{on_read} # but we still have on_read 797 && $self->{on_read} # but we still have on_read
670 ) { 798 ) {
671 # no further data will arrive 799 # no further data will arrive
672 # so no progress can be made 800 # so no progress can be made
673 $self->_error (&Errno::EPIPE, 1), last 801 $self->_error (&Errno::EPIPE, 1), return
674 if $self->{_eof}; 802 if $self->{_eof};
675 803
676 last; # more data might arrive 804 last; # more data might arrive
677 } 805 }
678 } else { 806 } else {
680 delete $self->{_rw}; 808 delete $self->{_rw};
681 last; 809 last;
682 } 810 }
683 } 811 }
684 812
813 if ($self->{_eof}) {
814 if ($self->{on_eof}) {
685 $self->{on_eof}($self) 815 $self->{on_eof}($self)
686 if $self->{_eof} && $self->{on_eof}; 816 } else {
817 $self->_error (0, 1);
818 }
819 }
687 820
688 # may need to restart read watcher 821 # may need to restart read watcher
689 unless ($self->{_rw}) { 822 unless ($self->{_rw}) {
690 $self->start_read 823 $self->start_read
691 if $self->{on_read} || @{ $self->{_queue} }; 824 if $self->{on_read} || @{ $self->{_queue} };
817 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 950 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
818 1 951 1
819 } 952 }
820}; 953};
821 954
822# compatibility with older API
823sub push_read_chunk {
824 $_[0]->push_read (chunk => $_[1], $_[2]);
825}
826
827sub unshift_read_chunk {
828 $_[0]->unshift_read (chunk => $_[1], $_[2]);
829}
830
831=item line => [$eol, ]$cb->($handle, $line, $eol) 955=item line => [$eol, ]$cb->($handle, $line, $eol)
832 956
833The callback will be called only once a full line (including the end of 957The callback will be called only once a full line (including the end of
834line marker, C<$eol>) has been read. This line (excluding the end of line 958line marker, C<$eol>) has been read. This line (excluding the end of line
835marker) will be passed to the callback as second argument (C<$line>), and 959marker) will be passed to the callback as second argument (C<$line>), and
850=cut 974=cut
851 975
852register_read_type line => sub { 976register_read_type line => sub {
853 my ($self, $cb, $eol) = @_; 977 my ($self, $cb, $eol) = @_;
854 978
855 $eol = qr|(\015?\012)| if @_ < 3; 979 if (@_ < 3) {
980 # this is more than twice as fast as the generic code below
981 sub {
982 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
983
984 $cb->($_[0], $1, $2);
985 1
986 }
987 } else {
856 $eol = quotemeta $eol unless ref $eol; 988 $eol = quotemeta $eol unless ref $eol;
857 $eol = qr|^(.*?)($eol)|s; 989 $eol = qr|^(.*?)($eol)|s;
858 990
859 sub { 991 sub {
860 $_[0]{rbuf} =~ s/$eol// or return; 992 $_[0]{rbuf} =~ s/$eol// or return;
861 993
862 $cb->($_[0], $1, $2); 994 $cb->($_[0], $1, $2);
995 1
863 1 996 }
864 } 997 }
865}; 998};
866
867# compatibility with older API
868sub push_read_line {
869 my $self = shift;
870 $self->push_read (line => @_);
871}
872
873sub unshift_read_line {
874 my $self = shift;
875 $self->unshift_read (line => @_);
876}
877 999
878=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 1000=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
879 1001
880Makes a regex match against the regex object C<$accept> and returns 1002Makes a regex match against the regex object C<$accept> and returns
881everything up to and including the match. 1003everything up to and including the match.
1002register_read_type packstring => sub { 1124register_read_type packstring => sub {
1003 my ($self, $cb, $format) = @_; 1125 my ($self, $cb, $format) = @_;
1004 1126
1005 sub { 1127 sub {
1006 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1128 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1007 defined (my $len = eval { unpack $format, $_[0]->{rbuf} }) 1129 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1008 or return; 1130 or return;
1009 1131
1132 $format = length pack $format, $len;
1133
1134 # bypass unshift if we already have the remaining chunk
1135 if ($format + $len <= length $_[0]{rbuf}) {
1136 my $data = substr $_[0]{rbuf}, $format, $len;
1137 substr $_[0]{rbuf}, 0, $format + $len, "";
1138 $cb->($_[0], $data);
1139 } else {
1010 # remove prefix 1140 # remove prefix
1011 substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; 1141 substr $_[0]{rbuf}, 0, $format, "";
1012 1142
1013 # read rest 1143 # read remaining chunk
1014 $_[0]->unshift_read (chunk => $len, $cb); 1144 $_[0]->unshift_read (chunk => $len, $cb);
1145 }
1015 1146
1016 1 1147 1
1017 } 1148 }
1018}; 1149};
1019 1150
1034the C<json> write type description, above, for an actual example. 1165the C<json> write type description, above, for an actual example.
1035 1166
1036=cut 1167=cut
1037 1168
1038register_read_type json => sub { 1169register_read_type json => sub {
1039 my ($self, $cb, $accept, $reject, $skip) = @_; 1170 my ($self, $cb) = @_;
1040 1171
1041 require JSON; 1172 require JSON;
1042 1173
1043 my $data; 1174 my $data;
1044 my $rbuf = \$self->{rbuf}; 1175 my $rbuf = \$self->{rbuf};
1059 () 1190 ()
1060 } 1191 }
1061 } 1192 }
1062}; 1193};
1063 1194
1195=item storable => $cb->($handle, $ref)
1196
1197Deserialises a L<Storable> frozen representation as written by the
1198C<storable> write type (BER-encoded length prefix followed by nfreeze'd
1199data).
1200
1201Raises C<EBADMSG> error if the data could not be decoded.
1202
1203=cut
1204
1205register_read_type storable => sub {
1206 my ($self, $cb) = @_;
1207
1208 require Storable;
1209
1210 sub {
1211 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1212 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1213 or return;
1214
1215 my $format = length pack "w", $len;
1216
1217 # bypass unshift if we already have the remaining chunk
1218 if ($format + $len <= length $_[0]{rbuf}) {
1219 my $data = substr $_[0]{rbuf}, $format, $len;
1220 substr $_[0]{rbuf}, 0, $format + $len, "";
1221 $cb->($_[0], Storable::thaw ($data));
1222 } else {
1223 # remove prefix
1224 substr $_[0]{rbuf}, 0, $format, "";
1225
1226 # read remaining chunk
1227 $_[0]->unshift_read (chunk => $len, sub {
1228 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1229 $cb->($_[0], $ref);
1230 } else {
1231 $self->_error (&Errno::EBADMSG);
1232 }
1233 });
1234 }
1235
1236 1
1237 }
1238};
1239
1064=back 1240=back
1065 1241
1066=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args) 1242=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
1067 1243
1068This function (not method) lets you add your own types to C<push_read>. 1244This function (not method) lets you add your own types to C<push_read>.
1143 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1319 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
1144 substr $self->{_tls_wbuf}, 0, $len, ""; 1320 substr $self->{_tls_wbuf}, 0, $len, "";
1145 } 1321 }
1146 } 1322 }
1147 1323
1148 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1149 $self->{wbuf} .= $buf;
1150 $self->_drain_wbuf;
1151 }
1152
1153 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { 1324 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1154 if (length $buf) { 1325 unless (length $buf) {
1155 $self->{rbuf} .= $buf;
1156 $self->_drain_rbuf unless $self->{_in_drain};
1157 } else {
1158 # let's treat SSL-eof as we treat normal EOF 1326 # let's treat SSL-eof as we treat normal EOF
1327 delete $self->{_rw};
1159 $self->{_eof} = 1; 1328 $self->{_eof} = 1;
1160 $self->_shutdown;
1161 return;
1162 } 1329 }
1330
1331 $self->{rbuf} .= $buf;
1332 $self->_drain_rbuf unless $self->{_in_drain};
1333
1334 $self->{tls} or return; # tls could have gone away
1163 } 1335 }
1164 1336
1165 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1337 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1166 1338
1167 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1339 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1171 return $self->_error (&Errno::EIO, 1); 1343 return $self->_error (&Errno::EIO, 1);
1172 } 1344 }
1173 1345
1174 # all others are fine for our purposes 1346 # all others are fine for our purposes
1175 } 1347 }
1348
1349 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1350 $self->{wbuf} .= $buf;
1351 $self->_drain_wbuf;
1352 }
1176} 1353}
1177 1354
1178=item $handle->starttls ($tls[, $tls_ctx]) 1355=item $handle->starttls ($tls[, $tls_ctx])
1179 1356
1180Instead of starting TLS negotiation immediately when the AnyEvent::Handle 1357Instead of starting TLS negotiation immediately when the AnyEvent::Handle
1211 # basically, this is deep magic (because SSL_read should have the same issues) 1388 # basically, this is deep magic (because SSL_read should have the same issues)
1212 # but the openssl maintainers basically said: "trust us, it just works". 1389 # but the openssl maintainers basically said: "trust us, it just works".
1213 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1390 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1214 # and mismaintained ssleay-module doesn't even offer them). 1391 # and mismaintained ssleay-module doesn't even offer them).
1215 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1392 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
1393 #
1394 # in short: this is a mess.
1395 #
1396 # note that we do not try to kepe the length constant between writes as we are required to do.
1397 # we assume that most (but not all) of this insanity only applies to non-blocking cases,
1398 # and we drive openssl fully in blocking mode here.
1216 Net::SSLeay::CTX_set_mode ($self->{tls}, 1399 Net::SSLeay::CTX_set_mode ($self->{tls},
1217 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1400 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1218 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1401 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1219 1402
1220 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1403 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1228 }; 1411 };
1229 $self->{filter_r} = sub { 1412 $self->{filter_r} = sub {
1230 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]}); 1413 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
1231 &_dotls; 1414 &_dotls;
1232 }; 1415 };
1416
1417 &_dotls; # need to trigger the initial negotiation exchange
1233} 1418}
1234 1419
1235=item $handle->stoptls 1420=item $handle->stoptls
1236 1421
1237Destroys the SSL connection, if any. Partial read or write data will be 1422Destroys the SSL connection, if any. Partial read or write data will be
1253 1438
1254sub DESTROY { 1439sub DESTROY {
1255 my $self = shift; 1440 my $self = shift;
1256 1441
1257 $self->stoptls; 1442 $self->stoptls;
1443
1444 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1445
1446 if ($linger && length $self->{wbuf}) {
1447 my $fh = delete $self->{fh};
1448 my $wbuf = delete $self->{wbuf};
1449
1450 my @linger;
1451
1452 push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub {
1453 my $len = syswrite $fh, $wbuf, length $wbuf;
1454
1455 if ($len > 0) {
1456 substr $wbuf, 0, $len, "";
1457 } else {
1458 @linger = (); # end
1459 }
1460 });
1461 push @linger, AnyEvent->timer (after => $linger, cb => sub {
1462 @linger = ();
1463 });
1464 }
1258} 1465}
1259 1466
1260=item AnyEvent::Handle::TLS_CTX 1467=item AnyEvent::Handle::TLS_CTX
1261 1468
1262This function creates and returns the Net::SSLeay::CTX object used by 1469This function creates and returns the Net::SSLeay::CTX object used by
1304=over 4 1511=over 4
1305 1512
1306=item * all constructor arguments become object members. 1513=item * all constructor arguments become object members.
1307 1514
1308At least initially, when you pass a C<tls>-argument to the constructor it 1515At least initially, when you pass a C<tls>-argument to the constructor it
1309will end up in C<< $handle->{tls} >>. Those members might be changes or 1516will end up in C<< $handle->{tls} >>. Those members might be changed or
1310mutated later on (for example C<tls> will hold the TLS connection object). 1517mutated later on (for example C<tls> will hold the TLS connection object).
1311 1518
1312=item * other object member names are prefixed with an C<_>. 1519=item * other object member names are prefixed with an C<_>.
1313 1520
1314All object members not explicitly documented (internal use) are prefixed 1521All object members not explicitly documented (internal use) are prefixed

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines