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.36 by root, Mon May 26 18:26:52 2008 UTC vs.
Revision 1.45 by root, Thu May 29 00:20:39 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
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 on EOF.
81 81
82While not mandatory, it is highly recommended to set an eof callback, 82While not mandatory, it is highly recommended to set an eof callback,
83otherwise you might end up with a closed socket while you are still 83otherwise you might end up with a closed socket while you are still
84waiting for data. 84waiting for data.
85 85
86=item on_error => $cb->($self) 86=item on_error => $cb->($handle)
87 87
88This is the fatal error callback, that is called when, well, a fatal error 88This is the fatal error callback, that is called when, well, a fatal error
89occurs, such as not being able to resolve the hostname, failure to connect 89occurs, such as not being able to resolve the hostname, failure to connect
90or a read error. 90or a read error.
91 91
92The object will not be in a usable state when this callback has been 92The object will not be in a usable state when this callback has been
93called. 93called.
94 94
95On callback entrance, the value of C<$!> contains the operating system 95On callback entrance, the value of C<$!> contains the operating system
96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>). 96error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
97 100
98While not mandatory, it is I<highly> recommended to set this callback, as 101While not mandatory, it is I<highly> recommended to set this callback, as
99you will not be notified of errors otherwise. The default simply calls 102you will not be notified of errors otherwise. The default simply calls
100die. 103die.
101 104
102=item on_read => $cb->($self) 105=item on_read => $cb->($handle)
103 106
104This sets the default read callback, which is called when data arrives 107This sets the default read callback, which is called when data arrives
105and no read request is in the queue. 108and no read request is in the queue.
106 109
107To access (and remove data from) the read buffer, use the C<< ->rbuf >> 110To access (and remove data from) the read buffer, use the C<< ->rbuf >>
108method or access the C<$self->{rbuf}> member directly. 111method or access the C<$handle->{rbuf}> member directly.
109 112
110When an EOF condition is detected then AnyEvent::Handle will first try to 113When an EOF condition is detected then AnyEvent::Handle will first try to
111feed all the remaining data to the queued callbacks and C<on_read> before 114feed all the remaining data to the queued callbacks and C<on_read> before
112calling the C<on_eof> callback. If no progress can be made, then a fatal 115calling the C<on_eof> callback. If no progress can be made, then a fatal
113error will be raised (with C<$!> set to C<EPIPE>). 116error will be raised (with C<$!> set to C<EPIPE>).
114 117
115=item on_drain => $cb->() 118=item on_drain => $cb->($handle)
116 119
117This sets the callback that is called when the write buffer becomes empty 120This sets the callback that is called when the write buffer becomes empty
118(or when the callback is set and the buffer is empty already). 121(or when the callback is set and the buffer is empty already).
119 122
120To append to the write buffer, use the C<< ->push_write >> method. 123To append to the write buffer, use the C<< ->push_write >> method.
124
125=item timeout => $fractional_seconds
126
127If non-zero, then this enables an "inactivity" timeout: whenever this many
128seconds pass without a successful read or write on the underlying file
129handle, the C<on_timeout> callback will be invoked (and if that one is
130missing, an C<ETIMEDOUT> error will be raised).
131
132Note that timeout processing is also active when you currently do not have
133any outstanding read or write requests: If you plan to keep the connection
134idle then you should disable the timout temporarily or ignore the timeout
135in the C<on_timeout> callback.
136
137Zero (the default) disables this timeout.
138
139=item on_timeout => $cb->($handle)
140
141Called whenever the inactivity timeout passes. If you return from this
142callback, then the timeout will be reset as if some activity had happened,
143so this condition is not fatal in any way.
121 144
122=item rbuf_max => <bytes> 145=item rbuf_max => <bytes>
123 146
124If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 147If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
125when the read buffer ever (strictly) exceeds this size. This is useful to 148when the read buffer ever (strictly) exceeds this size. This is useful to
165 188
166Use the given Net::SSLeay::CTX object to create the new TLS connection 189Use the given Net::SSLeay::CTX object to create the new TLS connection
167(unless a connection object was specified directly). If this parameter is 190(unless a connection object was specified directly). If this parameter is
168missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 191missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
169 192
193=item json => JSON or JSON::XS object
194
195This is the json coder object used by the C<json> read and write types.
196
197If you don't supply it, then AnyEvent::Handle will create and use a
198suitable one, which will write and expect UTF-8 encoded JSON texts.
199
200Note that you are responsible to depend on the JSON module if you want to
201use this functionality, as AnyEvent does not have a dependency itself.
202
203=item filter_r => $cb
204
205=item filter_w => $cb
206
207These exist, but are undocumented at this time.
208
170=back 209=back
171 210
172=cut 211=cut
173 212
174sub new { 213sub new {
183 if ($self->{tls}) { 222 if ($self->{tls}) {
184 require Net::SSLeay; 223 require Net::SSLeay;
185 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 224 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
186 } 225 }
187 226
188 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 227# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
189 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 228# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
229# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
190 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 230 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
191 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 231
232 $self->{_activity} = AnyEvent->now;
233 $self->_timeout;
192 234
193 $self->start_read; 235 $self->start_read;
194 236
195 $self 237 $self
196} 238}
197 239
198sub _shutdown { 240sub _shutdown {
199 my ($self) = @_; 241 my ($self) = @_;
200 242
201 delete $self->{rw}; 243 delete $self->{_rw};
202 delete $self->{ww}; 244 delete $self->{_ww};
203 delete $self->{fh}; 245 delete $self->{fh};
204} 246}
205 247
206sub error { 248sub error {
207 my ($self) = @_; 249 my ($self) = @_;
209 { 251 {
210 local $!; 252 local $!;
211 $self->_shutdown; 253 $self->_shutdown;
212 } 254 }
213 255
214 if ($self->{on_error}) {
215 $self->{on_error}($self); 256 $self->{on_error}($self)
216 } else { 257 if $self->{on_error};
258
217 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 259 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
218 }
219} 260}
220 261
221=item $fh = $handle->fh 262=item $fh = $handle->fh
222 263
223This method returns the file handle of the L<AnyEvent::Handle> object. 264This method returns the file handle of the L<AnyEvent::Handle> object.
224 265
225=cut 266=cut
226 267
227sub fh { $_[0]->{fh} } 268sub fh { $_[0]{fh} }
228 269
229=item $handle->on_error ($cb) 270=item $handle->on_error ($cb)
230 271
231Replace the current C<on_error> callback (see the C<on_error> constructor argument). 272Replace the current C<on_error> callback (see the C<on_error> constructor argument).
232 273
242 283
243=cut 284=cut
244 285
245sub on_eof { 286sub on_eof {
246 $_[0]{on_eof} = $_[1]; 287 $_[0]{on_eof} = $_[1];
288}
289
290=item $handle->on_timeout ($cb)
291
292Replace the current C<on_timeout> callback, or disables the callback
293(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
294argument.
295
296=cut
297
298sub on_timeout {
299 $_[0]{on_timeout} = $_[1];
300}
301
302#############################################################################
303
304=item $handle->timeout ($seconds)
305
306Configures (or disables) the inactivity timeout.
307
308=cut
309
310sub timeout {
311 my ($self, $timeout) = @_;
312
313 $self->{timeout} = $timeout;
314 $self->_timeout;
315}
316
317# reset the timeout watcher, as neccessary
318# also check for time-outs
319sub _timeout {
320 my ($self) = @_;
321
322 if ($self->{timeout}) {
323 my $NOW = AnyEvent->now;
324
325 # when would the timeout trigger?
326 my $after = $self->{_activity} + $self->{timeout} - $NOW;
327
328 # now or in the past already?
329 if ($after <= 0) {
330 $self->{_activity} = $NOW;
331
332 if ($self->{on_timeout}) {
333 $self->{on_timeout}->($self);
334 } else {
335 $! = Errno::ETIMEDOUT;
336 $self->error;
337 }
338
339 # callbakx could have changed timeout value, optimise
340 return unless $self->{timeout};
341
342 # calculate new after
343 $after = $self->{timeout};
344 }
345
346 Scalar::Util::weaken $self;
347
348 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
349 delete $self->{_tw};
350 $self->_timeout;
351 });
352 } else {
353 delete $self->{_tw};
354 }
247} 355}
248 356
249############################################################################# 357#############################################################################
250 358
251=back 359=back
288=cut 396=cut
289 397
290sub _drain_wbuf { 398sub _drain_wbuf {
291 my ($self) = @_; 399 my ($self) = @_;
292 400
293 if (!$self->{ww} && length $self->{wbuf}) { 401 if (!$self->{_ww} && length $self->{wbuf}) {
294 402
295 Scalar::Util::weaken $self; 403 Scalar::Util::weaken $self;
296 404
297 my $cb = sub { 405 my $cb = sub {
298 my $len = syswrite $self->{fh}, $self->{wbuf}; 406 my $len = syswrite $self->{fh}, $self->{wbuf};
299 407
300 if ($len >= 0) { 408 if ($len >= 0) {
301 substr $self->{wbuf}, 0, $len, ""; 409 substr $self->{wbuf}, 0, $len, "";
410
411 $self->{_activity} = AnyEvent->now;
302 412
303 $self->{on_drain}($self) 413 $self->{on_drain}($self)
304 if $self->{low_water_mark} >= length $self->{wbuf} 414 if $self->{low_water_mark} >= length $self->{wbuf}
305 && $self->{on_drain}; 415 && $self->{on_drain};
306 416
307 delete $self->{ww} unless length $self->{wbuf}; 417 delete $self->{_ww} unless length $self->{wbuf};
308 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) { 418 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
309 $self->error; 419 $self->error;
310 } 420 }
311 }; 421 };
312 422
313 # try to write data immediately 423 # try to write data immediately
314 $cb->(); 424 $cb->();
315 425
316 # if still data left in wbuf, we need to poll 426 # if still data left in wbuf, we need to poll
317 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 427 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
318 if length $self->{wbuf}; 428 if length $self->{wbuf};
319 }; 429 };
320} 430}
321 431
322our %WH; 432our %WH;
368 my ($self, $string) = @_; 478 my ($self, $string) = @_;
369 479
370 sprintf "%d:%s,", (length $string), $string 480 sprintf "%d:%s,", (length $string), $string
371}; 481};
372 482
483=item json => $array_or_hashref
484
485Encodes the given hash or array reference into a JSON object. Unless you
486provide your own JSON object, this means it will be encoded to JSON text
487in UTF-8.
488
489JSON objects (and arrays) are self-delimiting, so you can write JSON at
490one end of a handle and read them at the other end without using any
491additional framing.
492
493The generated JSON text is guaranteed not to contain any newlines: While
494this module doesn't need delimiters after or between JSON texts to be
495able to read them, many other languages depend on that.
496
497A simple RPC protocol that interoperates easily with others is to send
498JSON arrays (or objects, although arrays are usually the better choice as
499they mimic how function argument passing works) and a newline after each
500JSON text:
501
502 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
503 $handle->push_write ("\012");
504
505An AnyEvent::Handle receiver would simply use the C<json> read type and
506rely on the fact that the newline will be skipped as leading whitespace:
507
508 $handle->push_read (json => sub { my $array = $_[1]; ... });
509
510Other languages could read single lines terminated by a newline and pass
511this line into their JSON decoder of choice.
512
513=cut
514
515register_write_type json => sub {
516 my ($self, $ref) = @_;
517
518 require JSON;
519
520 $self->{json} ? $self->{json}->encode ($ref)
521 : JSON::encode_json ($ref)
522};
523
373=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args) 524=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
374 525
375This function (not method) lets you add your own types to C<push_write>. 526This function (not method) lets you add your own types to C<push_write>.
376Whenever the given C<type> is used, C<push_write> will invoke the code 527Whenever the given C<type> is used, C<push_write> will invoke the code
377reference with the handle object and the remaining arguments. 528reference with the handle object and the remaining arguments.
378 529
469 620
470 if ( 621 if (
471 defined $self->{rbuf_max} 622 defined $self->{rbuf_max}
472 && $self->{rbuf_max} < length $self->{rbuf} 623 && $self->{rbuf_max} < length $self->{rbuf}
473 ) { 624 ) {
474 $! = &Errno::ENOSPC; return $self->error; 625 $! = &Errno::ENOSPC;
626 $self->error;
475 } 627 }
476 628
477 return if $self->{in_drain}; 629 return if $self->{in_drain};
478 local $self->{in_drain} = 1; 630 local $self->{in_drain} = 1;
479 631
480 while (my $len = length $self->{rbuf}) { 632 while (my $len = length $self->{rbuf}) {
481 no strict 'refs'; 633 no strict 'refs';
482 if (my $cb = shift @{ $self->{queue} }) { 634 if (my $cb = shift @{ $self->{_queue} }) {
483 unless ($cb->($self)) { 635 unless ($cb->($self)) {
484 if ($self->{eof}) { 636 if ($self->{_eof}) {
485 # no progress can be made (not enough data and no data forthcoming) 637 # no progress can be made (not enough data and no data forthcoming)
486 $! = &Errno::EPIPE; return $self->error; 638 $! = &Errno::EPIPE;
639 $self->error;
487 } 640 }
488 641
489 unshift @{ $self->{queue} }, $cb; 642 unshift @{ $self->{_queue} }, $cb;
490 return; 643 return;
491 } 644 }
492 } elsif ($self->{on_read}) { 645 } elsif ($self->{on_read}) {
493 $self->{on_read}($self); 646 $self->{on_read}($self);
494 647
495 if ( 648 if (
496 $self->{eof} # if no further data will arrive 649 $self->{_eof} # if no further data will arrive
497 && $len == length $self->{rbuf} # and no data has been consumed 650 && $len == length $self->{rbuf} # and no data has been consumed
498 && !@{ $self->{queue} } # and the queue is still empty 651 && !@{ $self->{_queue} } # and the queue is still empty
499 && $self->{on_read} # and we still want to read data 652 && $self->{on_read} # and we still want to read data
500 ) { 653 ) {
501 # then no progress can be made 654 # then no progress can be made
502 $! = &Errno::EPIPE; return $self->error; 655 $! = &Errno::EPIPE;
656 $self->error;
503 } 657 }
504 } else { 658 } else {
505 # read side becomes idle 659 # read side becomes idle
506 delete $self->{rw}; 660 delete $self->{_rw};
507 return; 661 return;
508 } 662 }
509 } 663 }
510 664
511 if ($self->{eof}) { 665 if ($self->{_eof}) {
512 $self->_shutdown; 666 $self->_shutdown;
513 $self->{on_eof}($self) 667 $self->{on_eof}($self)
514 if $self->{on_eof}; 668 if $self->{on_eof};
515 } 669 }
516} 670}
582 736
583 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 737 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
584 ->($self, $cb, @_); 738 ->($self, $cb, @_);
585 } 739 }
586 740
587 push @{ $self->{queue} }, $cb; 741 push @{ $self->{_queue} }, $cb;
588 $self->_drain_rbuf; 742 $self->_drain_rbuf;
589} 743}
590 744
591sub unshift_read { 745sub unshift_read {
592 my $self = shift; 746 my $self = shift;
598 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 752 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
599 ->($self, $cb, @_); 753 ->($self, $cb, @_);
600 } 754 }
601 755
602 756
603 unshift @{ $self->{queue} }, $cb; 757 unshift @{ $self->{_queue} }, $cb;
604 $self->_drain_rbuf; 758 $self->_drain_rbuf;
605} 759}
606 760
607=item $handle->push_read (type => @args, $cb) 761=item $handle->push_read (type => @args, $cb)
608 762
615Predefined types are (if you have ideas for additional types, feel free to 769Predefined types are (if you have ideas for additional types, feel free to
616drop by and tell us): 770drop by and tell us):
617 771
618=over 4 772=over 4
619 773
620=item chunk => $octets, $cb->($self, $data) 774=item chunk => $octets, $cb->($handle, $data)
621 775
622Invoke the callback only once C<$octets> bytes have been read. Pass the 776Invoke the callback only once C<$octets> bytes have been read. Pass the
623data read to the callback. The callback will never be called with less 777data read to the callback. The callback will never be called with less
624data. 778data.
625 779
648 802
649sub unshift_read_chunk { 803sub unshift_read_chunk {
650 $_[0]->unshift_read (chunk => $_[1], $_[2]); 804 $_[0]->unshift_read (chunk => $_[1], $_[2]);
651} 805}
652 806
653=item line => [$eol, ]$cb->($self, $line, $eol) 807=item line => [$eol, ]$cb->($handle, $line, $eol)
654 808
655The callback will be called only once a full line (including the end of 809The callback will be called only once a full line (including the end of
656line marker, C<$eol>) has been read. This line (excluding the end of line 810line marker, C<$eol>) has been read. This line (excluding the end of line
657marker) will be passed to the callback as second argument (C<$line>), and 811marker) will be passed to the callback as second argument (C<$line>), and
658the end of line marker as the third argument (C<$eol>). 812the end of line marker as the third argument (C<$eol>).
695sub unshift_read_line { 849sub unshift_read_line {
696 my $self = shift; 850 my $self = shift;
697 $self->unshift_read (line => @_); 851 $self->unshift_read (line => @_);
698} 852}
699 853
700=item netstring => $cb->($string) 854=item netstring => $cb->($handle, $string)
701 855
702A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement). 856A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
703 857
704Throws an error with C<$!> set to EBADMSG on format violations. 858Throws an error with C<$!> set to EBADMSG on format violations.
705 859
733 887
734 1 888 1
735 } 889 }
736}; 890};
737 891
738=item regex => $accept[, $reject[, $skip], $cb->($data) 892=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
739 893
740Makes a regex match against the regex object C<$accept> and returns 894Makes a regex match against the regex object C<$accept> and returns
741everything up to and including the match. 895everything up to and including the match.
742 896
743Example: read a single line terminated by '\n'. 897Example: read a single line terminated by '\n'.
804 958
805 () 959 ()
806 } 960 }
807}; 961};
808 962
963=item json => $cb->($handle, $hash_or_arrayref)
964
965Reads a JSON object or array, decodes it and passes it to the callback.
966
967If a C<json> object was passed to the constructor, then that will be used
968for the final decode, otherwise it will create a JSON coder expecting UTF-8.
969
970This read type uses the incremental parser available with JSON version
9712.09 (and JSON::XS version 2.2) and above. You have to provide a
972dependency on your own: this module will load the JSON module, but
973AnyEvent does not depend on it itself.
974
975Since JSON texts are fully self-delimiting, the C<json> read and write
976types are an ideal simple RPC protocol: just exchange JSON datagrams. See
977the C<json> write type description, above, for an actual example.
978
979=cut
980
981register_read_type json => sub {
982 my ($self, $cb, $accept, $reject, $skip) = @_;
983
984 require JSON;
985
986 my $data;
987 my $rbuf = \$self->{rbuf};
988
989 my $json = $self->{json} ||= JSON->new->utf8;
990
991 sub {
992 my $ref = $json->incr_parse ($self->{rbuf});
993
994 if ($ref) {
995 $self->{rbuf} = $json->incr_text;
996 $json->incr_text = "";
997 $cb->($self, $ref);
998
999 1
1000 } else {
1001 $self->{rbuf} = "";
1002 ()
1003 }
1004 }
1005};
1006
809=back 1007=back
810 1008
811=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args) 1009=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
812 1010
813This function (not method) lets you add your own types to C<push_read>. 1011This function (not method) lets you add your own types to C<push_read>.
814 1012
815Whenever the given C<type> is used, C<push_read> will invoke the code 1013Whenever the given C<type> is used, C<push_read> will invoke the code
816reference with the handle object, the callback and the remaining 1014reference with the handle object, the callback and the remaining
818 1016
819The code reference is supposed to return a callback (usually a closure) 1017The code reference is supposed to return a callback (usually a closure)
820that works as a plain read callback (see C<< ->push_read ($cb) >>). 1018that works as a plain read callback (see C<< ->push_read ($cb) >>).
821 1019
822It should invoke the passed callback when it is done reading (remember to 1020It should invoke the passed callback when it is done reading (remember to
823pass C<$self> as first argument as all other callbacks do that). 1021pass C<$handle> as first argument as all other callbacks do that).
824 1022
825Note that this is a function, and all types registered this way will be 1023Note that this is a function, and all types registered this way will be
826global, so try to use unique names. 1024global, so try to use unique names.
827 1025
828For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>, 1026For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
840=cut 1038=cut
841 1039
842sub stop_read { 1040sub stop_read {
843 my ($self) = @_; 1041 my ($self) = @_;
844 1042
845 delete $self->{rw}; 1043 delete $self->{_rw};
846} 1044}
847 1045
848sub start_read { 1046sub start_read {
849 my ($self) = @_; 1047 my ($self) = @_;
850 1048
851 unless ($self->{rw} || $self->{eof}) { 1049 unless ($self->{_rw} || $self->{_eof}) {
852 Scalar::Util::weaken $self; 1050 Scalar::Util::weaken $self;
853 1051
854 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1052 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
855 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1053 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
856 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1054 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
857 1055
858 if ($len > 0) { 1056 if ($len > 0) {
1057 $self->{_activity} = AnyEvent->now;
1058
859 $self->{filter_r} 1059 $self->{filter_r}
860 ? $self->{filter_r}->($self, $rbuf) 1060 ? $self->{filter_r}->($self, $rbuf)
861 : $self->_drain_rbuf; 1061 : $self->_drain_rbuf;
862 1062
863 } elsif (defined $len) { 1063 } elsif (defined $len) {
864 delete $self->{rw}; 1064 delete $self->{_rw};
1065 delete $self->{_ww};
1066 delete $self->{_tw};
865 $self->{eof} = 1; 1067 $self->{_eof} = 1;
866 $self->_drain_rbuf; 1068 $self->_drain_rbuf;
867 1069
868 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) { 1070 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
869 return $self->error; 1071 return $self->error;
870 } 1072 }
871 }); 1073 });
872 } 1074 }
873} 1075}
874 1076
875sub _dotls { 1077sub _dotls {
876 my ($self) = @_; 1078 my ($self) = @_;
877 1079
878 if (length $self->{tls_wbuf}) { 1080 if (length $self->{_tls_wbuf}) {
879 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) { 1081 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
880 substr $self->{tls_wbuf}, 0, $len, ""; 1082 substr $self->{_tls_wbuf}, 0, $len, "";
881 } 1083 }
882 } 1084 }
883 1085
884 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 1086 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
885 $self->{wbuf} .= $buf; 1087 $self->{wbuf} .= $buf;
886 $self->_drain_wbuf; 1088 $self->_drain_wbuf;
887 } 1089 }
888 1090
889 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1091 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
914The first argument is the same as the C<tls> constructor argument (either 1116The first argument is the same as the C<tls> constructor argument (either
915C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1117C<"connect">, C<"accept"> or an existing Net::SSLeay object).
916 1118
917The second argument is the optional C<Net::SSLeay::CTX> object that is 1119The second argument is the optional C<Net::SSLeay::CTX> object that is
918used when AnyEvent::Handle has to create its own TLS connection object. 1120used when AnyEvent::Handle has to create its own TLS connection object.
1121
1122The TLS connection object will end up in C<< $handle->{tls} >> after this
1123call and can be used or changed to your liking. Note that the handshake
1124might have already started when this function returns.
919 1125
920=cut 1126=cut
921 1127
922# TODO: maybe document... 1128# TODO: maybe document...
923sub starttls { 1129sub starttls {
942 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1148 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
943 Net::SSLeay::CTX_set_mode ($self->{tls}, 1149 Net::SSLeay::CTX_set_mode ($self->{tls},
944 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1150 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
945 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1151 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
946 1152
947 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1153 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
948 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1154 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
949 1155
950 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 1156 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
951 1157
952 $self->{filter_w} = sub { 1158 $self->{filter_w} = sub {
953 $_[0]{tls_wbuf} .= ${$_[1]}; 1159 $_[0]{_tls_wbuf} .= ${$_[1]};
954 &_dotls; 1160 &_dotls;
955 }; 1161 };
956 $self->{filter_r} = sub { 1162 $self->{filter_r} = sub {
957 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 1163 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
958 &_dotls; 1164 &_dotls;
959 }; 1165 };
960} 1166}
961 1167
962=item $handle->stoptls 1168=item $handle->stoptls
968 1174
969sub stoptls { 1175sub stoptls {
970 my ($self) = @_; 1176 my ($self) = @_;
971 1177
972 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1178 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
1179
973 delete $self->{tls_rbio}; 1180 delete $self->{_rbio};
974 delete $self->{tls_wbio}; 1181 delete $self->{_wbio};
975 delete $self->{tls_wbuf}; 1182 delete $self->{_tls_wbuf};
976 delete $self->{filter_r}; 1183 delete $self->{filter_r};
977 delete $self->{filter_w}; 1184 delete $self->{filter_w};
978} 1185}
979 1186
980sub DESTROY { 1187sub DESTROY {
1018 } 1225 }
1019} 1226}
1020 1227
1021=back 1228=back
1022 1229
1230=head1 SUBCLASSING AnyEvent::Handle
1231
1232In many cases, you might want to subclass AnyEvent::Handle.
1233
1234To make this easier, a given version of AnyEvent::Handle uses these
1235conventions:
1236
1237=over 4
1238
1239=item * all constructor arguments become object members.
1240
1241At least initially, when you pass a C<tls>-argument to the constructor it
1242will end up in C<< $handle->{tls} >>. Those members might be changes or
1243mutated later on (for example C<tls> will hold the TLS connection object).
1244
1245=item * other object member names are prefixed with an C<_>.
1246
1247All object members not explicitly documented (internal use) are prefixed
1248with an underscore character, so the remaining non-C<_>-namespace is free
1249for use for subclasses.
1250
1251=item * all members not documented here and not prefixed with an underscore
1252are free to use in subclasses.
1253
1254Of course, new versions of AnyEvent::Handle may introduce more "public"
1255member variables, but thats just life, at least it is documented.
1256
1257=back
1258
1023=head1 AUTHOR 1259=head1 AUTHOR
1024 1260
1025Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 1261Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
1026 1262
1027=cut 1263=cut

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines