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.37 by root, Mon May 26 20:02:22 2008 UTC vs.
Revision 1.61 by root, Fri Jun 6 10:23:50 2008 UTC

2 2
3no warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
10use Fcntl (); 10use Fcntl ();
11use Errno qw/EAGAIN EINTR/; 11use Errno qw(EAGAIN EINTR);
12 12
13=head1 NAME 13=head1 NAME
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 = '0.04'; 19our $VERSION = 4.14;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
73The filehandle this L<AnyEvent::Handle> object will operate on. 73The filehandle this L<AnyEvent::Handle> object will operate on.
74 74
75NOTE: The filehandle will be set to non-blocking (using 75NOTE: The filehandle will be set to non-blocking (using
76AnyEvent::Util::fh_nonblocking). 76AnyEvent::Util::fh_nonblocking).
77 77
78=item on_eof => $cb->($self) 78=item on_eof => $cb->($handle)
79 79
80Set the callback to be called on EOF. 80Set the callback to be called when an end-of-file condition is detcted,
81i.e. in the case of a socket, when the other side has closed the
82connection cleanly.
81 83
82While not mandatory, it is highly recommended to set an eof callback, 84While not mandatory, it is highly recommended to set an eof callback,
83otherwise you might end up with a closed socket while you are still 85otherwise you might end up with a closed socket while you are still
84waiting for data. 86waiting for data.
85 87
86=item on_error => $cb->($self) 88=item on_error => $cb->($handle, $fatal)
87 89
88This is the fatal error callback, that is called when, well, a fatal error 90This is the error callback, which is called when, well, some error
89occurs, such as not being able to resolve the hostname, failure to connect 91occured, such as not being able to resolve the hostname, failure to
90or a read error. 92connect or a read error.
91 93
92The object will not be in a usable state when this callback has been 94Some errors are fatal (which is indicated by C<$fatal> being true). On
93called. 95fatal errors the handle object will be shut down and will not be
96usable. Non-fatal errors can be retried by simply returning, but it is
97recommended to simply ignore this parameter and instead abondon the handle
98object when this callback is invoked.
94 99
95On callback entrance, the value of C<$!> contains the operating system 100On callback entrance, the value of C<$!> contains the operating system
96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>). 101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97
98The callbakc should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
100 102
101While not mandatory, it is I<highly> recommended to set this callback, as 103While not mandatory, it is I<highly> recommended to set this callback, as
102you will not be notified of errors otherwise. The default simply calls 104you will not be notified of errors otherwise. The default simply calls
103die. 105C<croak>.
104 106
105=item on_read => $cb->($self) 107=item on_read => $cb->($handle)
106 108
107This sets the default read callback, which is called when data arrives 109This sets the default read callback, which is called when data arrives
108and no read request is in the queue. 110and no read request is in the queue (unlike read queue callbacks, this
111callback will only be called when at least one octet of data is in the
112read buffer).
109 113
110To access (and remove data from) the read buffer, use the C<< ->rbuf >> 114To access (and remove data from) the read buffer, use the C<< ->rbuf >>
111method or access the C<$self->{rbuf}> member directly. 115method or access the C<$handle->{rbuf}> member directly.
112 116
113When an EOF condition is detected then AnyEvent::Handle will first try to 117When an EOF condition is detected then AnyEvent::Handle will first try to
114feed all the remaining data to the queued callbacks and C<on_read> before 118feed all the remaining data to the queued callbacks and C<on_read> before
115calling the C<on_eof> callback. If no progress can be made, then a fatal 119calling the C<on_eof> callback. If no progress can be made, then a fatal
116error will be raised (with C<$!> set to C<EPIPE>). 120error will be raised (with C<$!> set to C<EPIPE>).
117 121
118=item on_drain => $cb->() 122=item on_drain => $cb->($handle)
119 123
120This sets the callback that is called when the write buffer becomes empty 124This sets the callback that is called when the write buffer becomes empty
121(or when the callback is set and the buffer is empty already). 125(or when the callback is set and the buffer is empty already).
122 126
123To append to the write buffer, use the C<< ->push_write >> method. 127To append to the write buffer, use the C<< ->push_write >> method.
128
129=item timeout => $fractional_seconds
130
131If non-zero, then this enables an "inactivity" timeout: whenever this many
132seconds 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
134missing, an C<ETIMEDOUT> error will be raised).
135
136Note 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
138idle then you should disable the timout temporarily or ignore the timeout
139in the C<on_timeout> callback.
140
141Zero (the default) disables this timeout.
142
143=item on_timeout => $cb->($handle)
144
145Called whenever the inactivity timeout passes. If you return from this
146callback, then the timeout will be reset as if some activity had happened,
147so this condition is not fatal in any way.
124 148
125=item rbuf_max => <bytes> 149=item rbuf_max => <bytes>
126 150
127If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 151If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
128when the read buffer ever (strictly) exceeds this size. This is useful to 152when the read buffer ever (strictly) exceeds this size. This is useful to
135isn't finished). 159isn't finished).
136 160
137=item read_size => <bytes> 161=item read_size => <bytes>
138 162
139The default read block size (the amount of bytes this module will try to read 163The default read block size (the amount of bytes this module will try to read
140on each [loop iteration). Default: C<4096>. 164during each (loop iteration). Default: C<8192>.
141 165
142=item low_water_mark => <bytes> 166=item low_water_mark => <bytes>
143 167
144Sets the amount of bytes (default: C<0>) that make up an "empty" write 168Sets the amount of bytes (default: C<0>) that make up an "empty" write
145buffer: If the write reaches this size or gets even samller it is 169buffer: If the write reaches this size or gets even samller it is
168 192
169Use the given Net::SSLeay::CTX object to create the new TLS connection 193Use the given Net::SSLeay::CTX object to create the new TLS connection
170(unless a connection object was specified directly). If this parameter is 194(unless a connection object was specified directly). If this parameter is
171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 195missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
172 196
197=item json => JSON or JSON::XS object
198
199This is the json coder object used by the C<json> read and write types.
200
201If 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.
203
204Note 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.
206
207=item filter_r => $cb
208
209=item filter_w => $cb
210
211These exist, but are undocumented at this time.
212
173=back 213=back
174 214
175=cut 215=cut
176 216
177sub new { 217sub new {
186 if ($self->{tls}) { 226 if ($self->{tls}) {
187 require Net::SSLeay; 227 require Net::SSLeay;
188 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 228 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
189 } 229 }
190 230
191 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 231 $self->{_activity} = AnyEvent->now;
192 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 232 $self->_timeout;
233
193 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 234 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
194 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
195
196 $self->start_read;
197 235
198 $self 236 $self
199} 237}
200 238
201sub _shutdown { 239sub _shutdown {
202 my ($self) = @_; 240 my ($self) = @_;
203 241
242 delete $self->{_tw};
204 delete $self->{rw}; 243 delete $self->{_rw};
205 delete $self->{ww}; 244 delete $self->{_ww};
206 delete $self->{fh}; 245 delete $self->{fh};
207}
208 246
247 $self->stoptls;
248}
249
209sub error { 250sub _error {
210 my ($self) = @_; 251 my ($self, $errno, $fatal) = @_;
211 252
212 {
213 local $!;
214 $self->_shutdown; 253 $self->_shutdown
215 } 254 if $fatal;
216 255
217 $self->{on_error}($self) 256 $! = $errno;
257
218 if $self->{on_error}; 258 if ($self->{on_error}) {
219 259 $self->{on_error}($self, $fatal);
260 } else {
220 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 261 Carp::croak "AnyEvent::Handle uncaught error: $!";
262 }
221} 263}
222 264
223=item $fh = $handle->fh 265=item $fh = $handle->fh
224 266
225This method returns the file handle of the L<AnyEvent::Handle> object. 267This method returns the file handle of the L<AnyEvent::Handle> object.
226 268
227=cut 269=cut
228 270
229sub fh { $_[0]->{fh} } 271sub fh { $_[0]{fh} }
230 272
231=item $handle->on_error ($cb) 273=item $handle->on_error ($cb)
232 274
233Replace the current C<on_error> callback (see the C<on_error> constructor argument). 275Replace the current C<on_error> callback (see the C<on_error> constructor argument).
234 276
244 286
245=cut 287=cut
246 288
247sub on_eof { 289sub on_eof {
248 $_[0]{on_eof} = $_[1]; 290 $_[0]{on_eof} = $_[1];
291}
292
293=item $handle->on_timeout ($cb)
294
295Replace the current C<on_timeout> callback, or disables the callback
296(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
297argument.
298
299=cut
300
301sub on_timeout {
302 $_[0]{on_timeout} = $_[1];
303}
304
305#############################################################################
306
307=item $handle->timeout ($seconds)
308
309Configures (or disables) the inactivity timeout.
310
311=cut
312
313sub timeout {
314 my ($self, $timeout) = @_;
315
316 $self->{timeout} = $timeout;
317 $self->_timeout;
318}
319
320# reset the timeout watcher, as neccessary
321# also check for time-outs
322sub _timeout {
323 my ($self) = @_;
324
325 if ($self->{timeout}) {
326 my $NOW = AnyEvent->now;
327
328 # when would the timeout trigger?
329 my $after = $self->{_activity} + $self->{timeout} - $NOW;
330
331 # now or in the past already?
332 if ($after <= 0) {
333 $self->{_activity} = $NOW;
334
335 if ($self->{on_timeout}) {
336 $self->{on_timeout}($self);
337 } else {
338 $self->_error (&Errno::ETIMEDOUT);
339 }
340
341 # callback could have changed timeout value, optimise
342 return unless $self->{timeout};
343
344 # calculate new after
345 $after = $self->{timeout};
346 }
347
348 Scalar::Util::weaken $self;
349 return unless $self; # ->error could have destroyed $self
350
351 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
352 delete $self->{_tw};
353 $self->_timeout;
354 });
355 } else {
356 delete $self->{_tw};
357 }
249} 358}
250 359
251############################################################################# 360#############################################################################
252 361
253=back 362=back
290=cut 399=cut
291 400
292sub _drain_wbuf { 401sub _drain_wbuf {
293 my ($self) = @_; 402 my ($self) = @_;
294 403
295 if (!$self->{ww} && length $self->{wbuf}) { 404 if (!$self->{_ww} && length $self->{wbuf}) {
296 405
297 Scalar::Util::weaken $self; 406 Scalar::Util::weaken $self;
298 407
299 my $cb = sub { 408 my $cb = sub {
300 my $len = syswrite $self->{fh}, $self->{wbuf}; 409 my $len = syswrite $self->{fh}, $self->{wbuf};
301 410
302 if ($len >= 0) { 411 if ($len >= 0) {
303 substr $self->{wbuf}, 0, $len, ""; 412 substr $self->{wbuf}, 0, $len, "";
413
414 $self->{_activity} = AnyEvent->now;
304 415
305 $self->{on_drain}($self) 416 $self->{on_drain}($self)
306 if $self->{low_water_mark} >= length $self->{wbuf} 417 if $self->{low_water_mark} >= length $self->{wbuf}
307 && $self->{on_drain}; 418 && $self->{on_drain};
308 419
309 delete $self->{ww} unless length $self->{wbuf}; 420 delete $self->{_ww} unless length $self->{wbuf};
310 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) { 421 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
311 $self->error; 422 $self->_error ($!, 1);
312 } 423 }
313 }; 424 };
314 425
315 # try to write data immediately 426 # try to write data immediately
316 $cb->(); 427 $cb->();
317 428
318 # if still data left in wbuf, we need to poll 429 # if still data left in wbuf, we need to poll
319 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 430 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
320 if length $self->{wbuf}; 431 if length $self->{wbuf};
321 }; 432 };
322} 433}
323 434
324our %WH; 435our %WH;
336 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 447 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
337 ->($self, @_); 448 ->($self, @_);
338 } 449 }
339 450
340 if ($self->{filter_w}) { 451 if ($self->{filter_w}) {
341 $self->{filter_w}->($self, \$_[0]); 452 $self->{filter_w}($self, \$_[0]);
342 } else { 453 } else {
343 $self->{wbuf} .= $_[0]; 454 $self->{wbuf} .= $_[0];
344 $self->_drain_wbuf; 455 $self->_drain_wbuf;
345 } 456 }
346} 457}
347 458
348=item $handle->push_write (type => @args) 459=item $handle->push_write (type => @args)
349 460
350=item $handle->unshift_write (type => @args)
351
352Instead of formatting your data yourself, you can also let this module do 461Instead of formatting your data yourself, you can also let this module do
353the job by specifying a type and type-specific arguments. 462the job by specifying a type and type-specific arguments.
354 463
355Predefined types are (if you have ideas for additional types, feel free to 464Predefined types are (if you have ideas for additional types, feel free to
356drop by and tell us): 465drop by and tell us):
360=item netstring => $string 469=item netstring => $string
361 470
362Formats the given value as netstring 471Formats the given value as netstring
363(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 472(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
364 473
365=back
366
367=cut 474=cut
368 475
369register_write_type netstring => sub { 476register_write_type netstring => sub {
370 my ($self, $string) = @_; 477 my ($self, $string) = @_;
371 478
372 sprintf "%d:%s,", (length $string), $string 479 sprintf "%d:%s,", (length $string), $string
373}; 480};
374 481
482=item packstring => $format, $data
483
484An octet string prefixed with an encoded length. The encoding C<$format>
485uses the same format as a Perl C<pack> format, but must specify a single
486integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
487optional C<!>, C<< < >> or C<< > >> modifier).
488
489=cut
490
491register_write_type packstring => sub {
492 my ($self, $format, $string) = @_;
493
494 pack "$format/a", $string
495};
496
497=item json => $array_or_hashref
498
499Encodes the given hash or array reference into a JSON object. Unless you
500provide your own JSON object, this means it will be encoded to JSON text
501in UTF-8.
502
503JSON objects (and arrays) are self-delimiting, so you can write JSON at
504one end of a handle and read them at the other end without using any
505additional framing.
506
507The generated JSON text is guaranteed not to contain any newlines: While
508this module doesn't need delimiters after or between JSON texts to be
509able to read them, many other languages depend on that.
510
511A simple RPC protocol that interoperates easily with others is to send
512JSON arrays (or objects, although arrays are usually the better choice as
513they mimic how function argument passing works) and a newline after each
514JSON text:
515
516 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
517 $handle->push_write ("\012");
518
519An AnyEvent::Handle receiver would simply use the C<json> read type and
520rely on the fact that the newline will be skipped as leading whitespace:
521
522 $handle->push_read (json => sub { my $array = $_[1]; ... });
523
524Other languages could read single lines terminated by a newline and pass
525this line into their JSON decoder of choice.
526
527=cut
528
529register_write_type json => sub {
530 my ($self, $ref) = @_;
531
532 require JSON;
533
534 $self->{json} ? $self->{json}->encode ($ref)
535 : JSON::encode_json ($ref)
536};
537
538=back
539
375=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args) 540=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
376 541
377This function (not method) lets you add your own types to C<push_write>. 542This function (not method) lets you add your own types to C<push_write>.
378Whenever the given C<type> is used, C<push_write> will invoke the code 543Whenever the given C<type> is used, C<push_write> will invoke the code
379reference with the handle object and the remaining arguments. 544reference with the handle object and the remaining arguments.
380 545
404enough is there) from the read buffer (C<< $handle->rbuf >>) if you want 569enough is there) from the read buffer (C<< $handle->rbuf >>) if you want
405or not. 570or not.
406 571
407In the more complex case, you want to queue multiple callbacks. In this 572In the more complex case, you want to queue multiple callbacks. In this
408case, AnyEvent::Handle will call the first queued callback each time new 573case, AnyEvent::Handle will call the first queued callback each time new
409data arrives and removes it when it has done its job (see C<push_read>, 574data arrives (also the first time it is queued) and removes it when it has
410below). 575done its job (see C<push_read>, below).
411 576
412This way you can, for example, push three line-reads, followed by reading 577This way you can, for example, push three line-reads, followed by reading
413a chunk of data, and AnyEvent::Handle will execute them in order. 578a chunk of data, and AnyEvent::Handle will execute them in order.
414 579
415Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by 580Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by
416the specified number of bytes which give an XML datagram. 581the specified number of bytes which give an XML datagram.
417 582
418 # in the default state, expect some header bytes 583 # in the default state, expect some header bytes
419 $handle->on_read (sub { 584 $handle->on_read (sub {
420 # some data is here, now queue the length-header-read (4 octets) 585 # some data is here, now queue the length-header-read (4 octets)
421 shift->unshift_read_chunk (4, sub { 586 shift->unshift_read (chunk => 4, sub {
422 # header arrived, decode 587 # header arrived, decode
423 my $len = unpack "N", $_[1]; 588 my $len = unpack "N", $_[1];
424 589
425 # now read the payload 590 # now read the payload
426 shift->unshift_read_chunk ($len, sub { 591 shift->unshift_read (chunk => $len, sub {
427 my $xml = $_[1]; 592 my $xml = $_[1];
428 # handle xml 593 # handle xml
429 }); 594 });
430 }); 595 });
431 }); 596 });
438 603
439 # request one 604 # request one
440 $handle->push_write ("request 1\015\012"); 605 $handle->push_write ("request 1\015\012");
441 606
442 # we expect "ERROR" or "OK" as response, so push a line read 607 # we expect "ERROR" or "OK" as response, so push a line read
443 $handle->push_read_line (sub { 608 $handle->push_read (line => sub {
444 # if we got an "OK", we have to _prepend_ another line, 609 # if we got an "OK", we have to _prepend_ another line,
445 # so it will be read before the second request reads its 64 bytes 610 # so it will be read before the second request reads its 64 bytes
446 # which are already in the queue when this callback is called 611 # which are already in the queue when this callback is called
447 # we don't do this in case we got an error 612 # we don't do this in case we got an error
448 if ($_[1] eq "OK") { 613 if ($_[1] eq "OK") {
449 $_[0]->unshift_read_line (sub { 614 $_[0]->unshift_read (line => sub {
450 my $response = $_[1]; 615 my $response = $_[1];
451 ... 616 ...
452 }); 617 });
453 } 618 }
454 }); 619 });
455 620
456 # request two 621 # request two
457 $handle->push_write ("request 2\015\012"); 622 $handle->push_write ("request 2\015\012");
458 623
459 # simply read 64 bytes, always 624 # simply read 64 bytes, always
460 $handle->push_read_chunk (64, sub { 625 $handle->push_read (chunk => 64, sub {
461 my $response = $_[1]; 626 my $response = $_[1];
462 ... 627 ...
463 }); 628 });
464 629
465=over 4 630=over 4
466 631
467=cut 632=cut
468 633
469sub _drain_rbuf { 634sub _drain_rbuf {
470 my ($self) = @_; 635 my ($self) = @_;
636
637 local $self->{_in_drain} = 1;
471 638
472 if ( 639 if (
473 defined $self->{rbuf_max} 640 defined $self->{rbuf_max}
474 && $self->{rbuf_max} < length $self->{rbuf} 641 && $self->{rbuf_max} < length $self->{rbuf}
475 ) { 642 ) {
476 $! = &Errno::ENOSPC; 643 return $self->_error (&Errno::ENOSPC, 1);
477 $self->error;
478 } 644 }
479 645
480 return if $self->{in_drain}; 646 while () {
481 local $self->{in_drain} = 1;
482
483 while (my $len = length $self->{rbuf}) {
484 no strict 'refs'; 647 no strict 'refs';
648
649 my $len = length $self->{rbuf};
650
485 if (my $cb = shift @{ $self->{queue} }) { 651 if (my $cb = shift @{ $self->{_queue} }) {
486 unless ($cb->($self)) { 652 unless ($cb->($self)) {
487 if ($self->{eof}) { 653 if ($self->{_eof}) {
488 # no progress can be made (not enough data and no data forthcoming) 654 # no progress can be made (not enough data and no data forthcoming)
489 $! = &Errno::EPIPE; 655 $self->_error (&Errno::EPIPE, 1), last;
490 $self->error;
491 } 656 }
492 657
493 unshift @{ $self->{queue} }, $cb; 658 unshift @{ $self->{_queue} }, $cb;
494 return; 659 last;
495 } 660 }
496 } elsif ($self->{on_read}) { 661 } elsif ($self->{on_read}) {
662 last unless $len;
663
497 $self->{on_read}($self); 664 $self->{on_read}($self);
498 665
499 if ( 666 if (
500 $self->{eof} # if no further data will arrive
501 && $len == length $self->{rbuf} # and no data has been consumed 667 $len == length $self->{rbuf} # if no data has been consumed
502 && !@{ $self->{queue} } # and the queue is still empty 668 && !@{ $self->{_queue} } # and the queue is still empty
503 && $self->{on_read} # and we still want to read data 669 && $self->{on_read} # but we still have on_read
504 ) { 670 ) {
671 # no further data will arrive
505 # then no progress can be made 672 # so no progress can be made
506 $! = &Errno::EPIPE; 673 $self->_error (&Errno::EPIPE, 1), last
507 $self->error; 674 if $self->{_eof};
675
676 last; # more data might arrive
508 } 677 }
509 } else { 678 } else {
510 # read side becomes idle 679 # read side becomes idle
511 delete $self->{rw}; 680 delete $self->{_rw};
512 return; 681 last;
513 } 682 }
514 } 683 }
515 684
516 if ($self->{eof}) {
517 $self->_shutdown;
518 $self->{on_eof}($self) 685 $self->{on_eof}($self)
519 if $self->{on_eof}; 686 if $self->{_eof} && $self->{on_eof};
687
688 # may need to restart read watcher
689 unless ($self->{_rw}) {
690 $self->start_read
691 if $self->{on_read} || @{ $self->{_queue} };
520 } 692 }
521} 693}
522 694
523=item $handle->on_read ($cb) 695=item $handle->on_read ($cb)
524 696
530 702
531sub on_read { 703sub on_read {
532 my ($self, $cb) = @_; 704 my ($self, $cb) = @_;
533 705
534 $self->{on_read} = $cb; 706 $self->{on_read} = $cb;
707 $self->_drain_rbuf if $cb && !$self->{_in_drain};
535} 708}
536 709
537=item $handle->rbuf 710=item $handle->rbuf
538 711
539Returns the read buffer (as a modifiable lvalue). 712Returns the read buffer (as a modifiable lvalue).
587 760
588 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 761 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
589 ->($self, $cb, @_); 762 ->($self, $cb, @_);
590 } 763 }
591 764
592 push @{ $self->{queue} }, $cb; 765 push @{ $self->{_queue} }, $cb;
593 $self->_drain_rbuf; 766 $self->_drain_rbuf unless $self->{_in_drain};
594} 767}
595 768
596sub unshift_read { 769sub unshift_read {
597 my $self = shift; 770 my $self = shift;
598 my $cb = pop; 771 my $cb = pop;
603 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 776 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
604 ->($self, $cb, @_); 777 ->($self, $cb, @_);
605 } 778 }
606 779
607 780
608 unshift @{ $self->{queue} }, $cb; 781 unshift @{ $self->{_queue} }, $cb;
609 $self->_drain_rbuf; 782 $self->_drain_rbuf unless $self->{_in_drain};
610} 783}
611 784
612=item $handle->push_read (type => @args, $cb) 785=item $handle->push_read (type => @args, $cb)
613 786
614=item $handle->unshift_read (type => @args, $cb) 787=item $handle->unshift_read (type => @args, $cb)
620Predefined types are (if you have ideas for additional types, feel free to 793Predefined types are (if you have ideas for additional types, feel free to
621drop by and tell us): 794drop by and tell us):
622 795
623=over 4 796=over 4
624 797
625=item chunk => $octets, $cb->($self, $data) 798=item chunk => $octets, $cb->($handle, $data)
626 799
627Invoke the callback only once C<$octets> bytes have been read. Pass the 800Invoke the callback only once C<$octets> bytes have been read. Pass the
628data read to the callback. The callback will never be called with less 801data read to the callback. The callback will never be called with less
629data. 802data.
630 803
653 826
654sub unshift_read_chunk { 827sub unshift_read_chunk {
655 $_[0]->unshift_read (chunk => $_[1], $_[2]); 828 $_[0]->unshift_read (chunk => $_[1], $_[2]);
656} 829}
657 830
658=item line => [$eol, ]$cb->($self, $line, $eol) 831=item line => [$eol, ]$cb->($handle, $line, $eol)
659 832
660The callback will be called only once a full line (including the end of 833The callback will be called only once a full line (including the end of
661line marker, C<$eol>) has been read. This line (excluding the end of line 834line marker, C<$eol>) has been read. This line (excluding the end of line
662marker) will be passed to the callback as second argument (C<$line>), and 835marker) will be passed to the callback as second argument (C<$line>), and
663the end of line marker as the third argument (C<$eol>). 836the end of line marker as the third argument (C<$eol>).
700sub unshift_read_line { 873sub unshift_read_line {
701 my $self = shift; 874 my $self = shift;
702 $self->unshift_read (line => @_); 875 $self->unshift_read (line => @_);
703} 876}
704 877
705=item netstring => $cb->($string)
706
707A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
708
709Throws an error with C<$!> set to EBADMSG on format violations.
710
711=cut
712
713register_read_type netstring => sub {
714 my ($self, $cb) = @_;
715
716 sub {
717 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
718 if ($_[0]{rbuf} =~ /[^0-9]/) {
719 $! = &Errno::EBADMSG;
720 $self->error;
721 }
722 return;
723 }
724
725 my $len = $1;
726
727 $self->unshift_read (chunk => $len, sub {
728 my $string = $_[1];
729 $_[0]->unshift_read (chunk => 1, sub {
730 if ($_[1] eq ",") {
731 $cb->($_[0], $string);
732 } else {
733 $! = &Errno::EBADMSG;
734 $self->error;
735 }
736 });
737 });
738
739 1
740 }
741};
742
743=item regex => $accept[, $reject[, $skip], $cb->($data) 878=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
744 879
745Makes a regex match against the regex object C<$accept> and returns 880Makes a regex match against the regex object C<$accept> and returns
746everything up to and including the match. 881everything up to and including the match.
747 882
748Example: read a single line terminated by '\n'. 883Example: read a single line terminated by '\n'.
796 return 1; 931 return 1;
797 } 932 }
798 933
799 # reject 934 # reject
800 if ($reject && $$rbuf =~ $reject) { 935 if ($reject && $$rbuf =~ $reject) {
801 $! = &Errno::EBADMSG; 936 $self->_error (&Errno::EBADMSG);
802 $self->error;
803 } 937 }
804 938
805 # skip 939 # skip
806 if ($skip && $$rbuf =~ $skip) { 940 if ($skip && $$rbuf =~ $skip) {
807 $data .= substr $$rbuf, 0, $+[0], ""; 941 $data .= substr $$rbuf, 0, $+[0], "";
809 943
810 () 944 ()
811 } 945 }
812}; 946};
813 947
948=item netstring => $cb->($handle, $string)
949
950A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
951
952Throws an error with C<$!> set to EBADMSG on format violations.
953
954=cut
955
956register_read_type netstring => sub {
957 my ($self, $cb) = @_;
958
959 sub {
960 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
961 if ($_[0]{rbuf} =~ /[^0-9]/) {
962 $self->_error (&Errno::EBADMSG);
963 }
964 return;
965 }
966
967 my $len = $1;
968
969 $self->unshift_read (chunk => $len, sub {
970 my $string = $_[1];
971 $_[0]->unshift_read (chunk => 1, sub {
972 if ($_[1] eq ",") {
973 $cb->($_[0], $string);
974 } else {
975 $self->_error (&Errno::EBADMSG);
976 }
977 });
978 });
979
980 1
981 }
982};
983
984=item packstring => $format, $cb->($handle, $string)
985
986An octet string prefixed with an encoded length. The encoding C<$format>
987uses the same format as a Perl C<pack> format, but must specify a single
988integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
989optional C<!>, C<< < >> or C<< > >> modifier).
990
991DNS over TCP uses a prefix of C<n>, EPP uses a prefix of C<N>.
992
993Example: read a block of data prefixed by its length in BER-encoded
994format (very efficient).
995
996 $handle->push_read (packstring => "w", sub {
997 my ($handle, $data) = @_;
998 });
999
1000=cut
1001
1002register_read_type packstring => sub {
1003 my ($self, $cb, $format) = @_;
1004
1005 sub {
1006 # 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} })
1008 or return;
1009
1010 # remove prefix
1011 substr $_[0]->{rbuf}, 0, (length pack $format, $len), "";
1012
1013 # read rest
1014 $_[0]->unshift_read (chunk => $len, $cb);
1015
1016 1
1017 }
1018};
1019
1020=item json => $cb->($handle, $hash_or_arrayref)
1021
1022Reads a JSON object or array, decodes it and passes it to the callback.
1023
1024If a C<json> object was passed to the constructor, then that will be used
1025for the final decode, otherwise it will create a JSON coder expecting UTF-8.
1026
1027This read type uses the incremental parser available with JSON version
10282.09 (and JSON::XS version 2.2) and above. You have to provide a
1029dependency on your own: this module will load the JSON module, but
1030AnyEvent does not depend on it itself.
1031
1032Since JSON texts are fully self-delimiting, the C<json> read and write
1033types are an ideal simple RPC protocol: just exchange JSON datagrams. See
1034the C<json> write type description, above, for an actual example.
1035
1036=cut
1037
1038register_read_type json => sub {
1039 my ($self, $cb, $accept, $reject, $skip) = @_;
1040
1041 require JSON;
1042
1043 my $data;
1044 my $rbuf = \$self->{rbuf};
1045
1046 my $json = $self->{json} ||= JSON->new->utf8;
1047
1048 sub {
1049 my $ref = $json->incr_parse ($self->{rbuf});
1050
1051 if ($ref) {
1052 $self->{rbuf} = $json->incr_text;
1053 $json->incr_text = "";
1054 $cb->($self, $ref);
1055
1056 1
1057 } else {
1058 $self->{rbuf} = "";
1059 ()
1060 }
1061 }
1062};
1063
814=back 1064=back
815 1065
816=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args) 1066=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
817 1067
818This function (not method) lets you add your own types to C<push_read>. 1068This function (not method) lets you add your own types to C<push_read>.
819 1069
820Whenever the given C<type> is used, C<push_read> will invoke the code 1070Whenever the given C<type> is used, C<push_read> will invoke the code
821reference with the handle object, the callback and the remaining 1071reference with the handle object, the callback and the remaining
823 1073
824The code reference is supposed to return a callback (usually a closure) 1074The code reference is supposed to return a callback (usually a closure)
825that works as a plain read callback (see C<< ->push_read ($cb) >>). 1075that works as a plain read callback (see C<< ->push_read ($cb) >>).
826 1076
827It should invoke the passed callback when it is done reading (remember to 1077It should invoke the passed callback when it is done reading (remember to
828pass C<$self> as first argument as all other callbacks do that). 1078pass C<$handle> as first argument as all other callbacks do that).
829 1079
830Note that this is a function, and all types registered this way will be 1080Note that this is a function, and all types registered this way will be
831global, so try to use unique names. 1081global, so try to use unique names.
832 1082
833For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>, 1083For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
836=item $handle->stop_read 1086=item $handle->stop_read
837 1087
838=item $handle->start_read 1088=item $handle->start_read
839 1089
840In rare cases you actually do not want to read anything from the 1090In rare cases you actually do not want to read anything from the
841socket. In this case you can call C<stop_read>. Neither C<on_read> no 1091socket. In this case you can call C<stop_read>. Neither C<on_read> nor
842any queued callbacks will be executed then. To start reading again, call 1092any queued callbacks will be executed then. To start reading again, call
843C<start_read>. 1093C<start_read>.
844 1094
1095Note that AnyEvent::Handle will automatically C<start_read> for you when
1096you change the C<on_read> callback or push/unshift a read callback, and it
1097will automatically C<stop_read> for you when neither C<on_read> is set nor
1098there are any read requests in the queue.
1099
845=cut 1100=cut
846 1101
847sub stop_read { 1102sub stop_read {
848 my ($self) = @_; 1103 my ($self) = @_;
849 1104
850 delete $self->{rw}; 1105 delete $self->{_rw};
851} 1106}
852 1107
853sub start_read { 1108sub start_read {
854 my ($self) = @_; 1109 my ($self) = @_;
855 1110
856 unless ($self->{rw} || $self->{eof}) { 1111 unless ($self->{_rw} || $self->{_eof}) {
857 Scalar::Util::weaken $self; 1112 Scalar::Util::weaken $self;
858 1113
859 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1114 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
860 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1115 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
861 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1116 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
862 1117
863 if ($len > 0) { 1118 if ($len > 0) {
1119 $self->{_activity} = AnyEvent->now;
1120
864 $self->{filter_r} 1121 $self->{filter_r}
865 ? $self->{filter_r}->($self, $rbuf) 1122 ? $self->{filter_r}($self, $rbuf)
866 : $self->_drain_rbuf; 1123 : $self->{_in_drain} || $self->_drain_rbuf;
867 1124
868 } elsif (defined $len) { 1125 } elsif (defined $len) {
869 delete $self->{rw}; 1126 delete $self->{_rw};
870 $self->{eof} = 1; 1127 $self->{_eof} = 1;
871 $self->_drain_rbuf; 1128 $self->_drain_rbuf unless $self->{_in_drain};
872 1129
873 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) { 1130 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
874 return $self->error; 1131 return $self->_error ($!, 1);
875 } 1132 }
876 }); 1133 });
877 } 1134 }
878} 1135}
879 1136
880sub _dotls { 1137sub _dotls {
881 my ($self) = @_; 1138 my ($self) = @_;
882 1139
1140 my $buf;
1141
883 if (length $self->{tls_wbuf}) { 1142 if (length $self->{_tls_wbuf}) {
884 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) { 1143 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
885 substr $self->{tls_wbuf}, 0, $len, ""; 1144 substr $self->{_tls_wbuf}, 0, $len, "";
886 } 1145 }
887 } 1146 }
888 1147
889 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 1148 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
890 $self->{wbuf} .= $buf; 1149 $self->{wbuf} .= $buf;
891 $self->_drain_wbuf; 1150 $self->_drain_wbuf;
892 } 1151 }
893 1152
894 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1153 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1154 if (length $buf) {
895 $self->{rbuf} .= $buf; 1155 $self->{rbuf} .= $buf;
896 $self->_drain_rbuf; 1156 $self->_drain_rbuf unless $self->{_in_drain};
1157 } else {
1158 # let's treat SSL-eof as we treat normal EOF
1159 $self->{_eof} = 1;
1160 $self->_shutdown;
1161 return;
1162 }
897 } 1163 }
898 1164
899 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1165 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
900 1166
901 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1167 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
902 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1168 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
903 $self->error; 1169 return $self->_error ($!, 1);
904 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1170 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
905 $! = &Errno::EIO; 1171 return $self->_error (&Errno::EIO, 1);
906 $self->error;
907 } 1172 }
908 1173
909 # all others are fine for our purposes 1174 # all others are fine for our purposes
910 } 1175 }
911} 1176}
920C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1185C<"connect">, C<"accept"> or an existing Net::SSLeay object).
921 1186
922The second argument is the optional C<Net::SSLeay::CTX> object that is 1187The second argument is the optional C<Net::SSLeay::CTX> object that is
923used when AnyEvent::Handle has to create its own TLS connection object. 1188used when AnyEvent::Handle has to create its own TLS connection object.
924 1189
925=cut 1190The TLS connection object will end up in C<< $handle->{tls} >> after this
1191call and can be used or changed to your liking. Note that the handshake
1192might have already started when this function returns.
926 1193
927# TODO: maybe document... 1194=cut
1195
928sub starttls { 1196sub starttls {
929 my ($self, $ssl, $ctx) = @_; 1197 my ($self, $ssl, $ctx) = @_;
930 1198
931 $self->stoptls; 1199 $self->stoptls;
932 1200
947 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1215 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
948 Net::SSLeay::CTX_set_mode ($self->{tls}, 1216 Net::SSLeay::CTX_set_mode ($self->{tls},
949 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1217 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
950 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1218 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
951 1219
952 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1220 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
953 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1221 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
954 1222
955 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 1223 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
956 1224
957 $self->{filter_w} = sub { 1225 $self->{filter_w} = sub {
958 $_[0]{tls_wbuf} .= ${$_[1]}; 1226 $_[0]{_tls_wbuf} .= ${$_[1]};
959 &_dotls; 1227 &_dotls;
960 }; 1228 };
961 $self->{filter_r} = sub { 1229 $self->{filter_r} = sub {
962 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 1230 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
963 &_dotls; 1231 &_dotls;
964 }; 1232 };
965} 1233}
966 1234
967=item $handle->stoptls 1235=item $handle->stoptls
973 1241
974sub stoptls { 1242sub stoptls {
975 my ($self) = @_; 1243 my ($self) = @_;
976 1244
977 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1245 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
1246
978 delete $self->{tls_rbio}; 1247 delete $self->{_rbio};
979 delete $self->{tls_wbio}; 1248 delete $self->{_wbio};
980 delete $self->{tls_wbuf}; 1249 delete $self->{_tls_wbuf};
981 delete $self->{filter_r}; 1250 delete $self->{filter_r};
982 delete $self->{filter_w}; 1251 delete $self->{filter_w};
983} 1252}
984 1253
985sub DESTROY { 1254sub DESTROY {
1023 } 1292 }
1024} 1293}
1025 1294
1026=back 1295=back
1027 1296
1297=head1 SUBCLASSING AnyEvent::Handle
1298
1299In many cases, you might want to subclass AnyEvent::Handle.
1300
1301To make this easier, a given version of AnyEvent::Handle uses these
1302conventions:
1303
1304=over 4
1305
1306=item * all constructor arguments become object members.
1307
1308At 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
1310mutated later on (for example C<tls> will hold the TLS connection object).
1311
1312=item * other object member names are prefixed with an C<_>.
1313
1314All object members not explicitly documented (internal use) are prefixed
1315with an underscore character, so the remaining non-C<_>-namespace is free
1316for use for subclasses.
1317
1318=item * all members not documented here and not prefixed with an underscore
1319are free to use in subclasses.
1320
1321Of course, new versions of AnyEvent::Handle may introduce more "public"
1322member variables, but thats just life, at least it is documented.
1323
1324=back
1325
1028=head1 AUTHOR 1326=head1 AUTHOR
1029 1327
1030Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 1328Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
1031 1329
1032=cut 1330=cut

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines