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.32 by root, Sun May 25 01:10:54 2008 UTC vs.
Revision 1.42 by root, Tue May 27 06:23:15 2008 UTC

… …
2 2
3no warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAEAGAIN); 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
… …
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
… …
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> or C<EBADMSG>).
97 97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
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.
… …
165 168
166Use the given Net::SSLeay::CTX object to create the new TLS connection 169Use the given Net::SSLeay::CTX object to create the new TLS connection
167(unless a connection object was specified directly). If this parameter is 170(unless a connection object was specified directly). If this parameter is
168missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
169 172
173=item json => JSON or JSON::XS object
174
175This is the json coder object used by the C<json> read and write types.
176
177If you don't supply it, then AnyEvent::Handle will create and use a
178suitable one, which will write and expect UTF-8 encoded JSON texts.
179
180Note that you are responsible to depend on the JSON module if you want to
181use this functionality, as AnyEvent does not have a dependency itself.
182
183=item filter_r => $cb
184
185=item filter_w => $cb
186
187These exist, but are undocumented at this time.
188
170=back 189=back
171 190
172=cut 191=cut
173 192
174sub new { 193sub new {
… …
196} 215}
197 216
198sub _shutdown { 217sub _shutdown {
199 my ($self) = @_; 218 my ($self) = @_;
200 219
201 delete $self->{rw}; 220 delete $self->{_rw};
202 delete $self->{ww}; 221 delete $self->{_ww};
203 delete $self->{fh}; 222 delete $self->{fh};
204} 223}
205 224
206sub error { 225sub error {
207 my ($self) = @_; 226 my ($self) = @_;
… …
209 { 228 {
210 local $!; 229 local $!;
211 $self->_shutdown; 230 $self->_shutdown;
212 } 231 }
213 232
214 if ($self->{on_error}) {
215 $self->{on_error}($self); 233 $self->{on_error}($self)
216 } else { 234 if $self->{on_error};
235
217 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 236 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
218 }
219} 237}
220 238
221=item $fh = $handle->fh 239=item $fh = $handle->fh
222 240
223This method returns the file handle of the L<AnyEvent::Handle> object. 241This method returns the file handle of the L<AnyEvent::Handle> object.
224 242
225=cut 243=cut
226 244
227sub fh { $_[0]->{fh} } 245sub fh { $_[0]{fh} }
228 246
229=item $handle->on_error ($cb) 247=item $handle->on_error ($cb)
230 248
231Replace the current C<on_error> callback (see the C<on_error> constructor argument). 249Replace the current C<on_error> callback (see the C<on_error> constructor argument).
232 250
… …
288=cut 306=cut
289 307
290sub _drain_wbuf { 308sub _drain_wbuf {
291 my ($self) = @_; 309 my ($self) = @_;
292 310
293 if (!$self->{ww} && length $self->{wbuf}) { 311 if (!$self->{_ww} && length $self->{wbuf}) {
312
294 Scalar::Util::weaken $self; 313 Scalar::Util::weaken $self;
314
295 my $cb = sub { 315 my $cb = sub {
296 my $len = syswrite $self->{fh}, $self->{wbuf}; 316 my $len = syswrite $self->{fh}, $self->{wbuf};
297 317
298 if ($len >= 0) { 318 if ($len >= 0) {
299 substr $self->{wbuf}, 0, $len, ""; 319 substr $self->{wbuf}, 0, $len, "";
300 320
301 $self->{on_drain}($self) 321 $self->{on_drain}($self)
302 if $self->{low_water_mark} >= length $self->{wbuf} 322 if $self->{low_water_mark} >= length $self->{wbuf}
303 && $self->{on_drain}; 323 && $self->{on_drain};
304 324
305 delete $self->{ww} unless length $self->{wbuf}; 325 delete $self->{_ww} unless length $self->{wbuf};
306 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEAGAIN) { 326 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
307 $self->error; 327 $self->error;
308 } 328 }
309 }; 329 };
310 330
331 # try to write data immediately
332 $cb->();
333
334 # if still data left in wbuf, we need to poll
311 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 335 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
312 336 if length $self->{wbuf};
313 $cb->($self);
314 }; 337 };
315} 338}
316 339
317our %WH; 340our %WH;
318 341
… …
363 my ($self, $string) = @_; 386 my ($self, $string) = @_;
364 387
365 sprintf "%d:%s,", (length $string), $string 388 sprintf "%d:%s,", (length $string), $string
366}; 389};
367 390
391=item json => $array_or_hashref
392
393Encodes the given hash or array reference into a JSON object. Unless you
394provide your own JSON object, this means it will be encoded to JSON text
395in UTF-8.
396
397JSON objects (and arrays) are self-delimiting, so you can write JSON at
398one end of a handle and read them at the other end without using any
399additional framing.
400
401The generated JSON text is guaranteed not to contain any newlines: While
402this module doesn't need delimiters after or between JSON texts to be
403able to read them, many other languages depend on that.
404
405A simple RPC protocol that interoperates easily with others is to send
406JSON arrays (or objects, although arrays are usually the better choice as
407they mimic how function argument passing works) and a newline after each
408JSON text:
409
410 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
411 $handle->push_write ("\012");
412
413An AnyEvent::Handle receiver would simply use the C<json> read type and
414rely on the fact that the newline will be skipped as leading whitespace:
415
416 $handle->push_read (json => sub { my $array = $_[1]; ... });
417
418Other languages could read single lines terminated by a newline and pass
419this line into their JSON decoder of choice.
420
421=cut
422
423register_write_type json => sub {
424 my ($self, $ref) = @_;
425
426 require JSON;
427
428 $self->{json} ? $self->{json}->encode ($ref)
429 : JSON::encode_json ($ref)
430};
431
368=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args) 432=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
369 433
370This function (not method) lets you add your own types to C<push_write>. 434This function (not method) lets you add your own types to C<push_write>.
371Whenever the given C<type> is used, C<push_write> will invoke the code 435Whenever the given C<type> is used, C<push_write> will invoke the code
372reference with the handle object and the remaining arguments. 436reference with the handle object and the remaining arguments.
373 437
… …
464 528
465 if ( 529 if (
466 defined $self->{rbuf_max} 530 defined $self->{rbuf_max}
467 && $self->{rbuf_max} < length $self->{rbuf} 531 && $self->{rbuf_max} < length $self->{rbuf}
468 ) { 532 ) {
469 $! = &Errno::ENOSPC; return $self->error; 533 $! = &Errno::ENOSPC;
534 $self->error;
470 } 535 }
471 536
472 return if $self->{in_drain}; 537 return if $self->{in_drain};
473 local $self->{in_drain} = 1; 538 local $self->{in_drain} = 1;
474 539
475 while (my $len = length $self->{rbuf}) { 540 while (my $len = length $self->{rbuf}) {
476 no strict 'refs'; 541 no strict 'refs';
477 if (my $cb = shift @{ $self->{queue} }) { 542 if (my $cb = shift @{ $self->{_queue} }) {
478 unless ($cb->($self)) { 543 unless ($cb->($self)) {
479 if ($self->{eof}) { 544 if ($self->{_eof}) {
480 # no progress can be made (not enough data and no data forthcoming) 545 # no progress can be made (not enough data and no data forthcoming)
481 $! = &Errno::EPIPE; return $self->error; 546 $! = &Errno::EPIPE;
547 $self->error;
482 } 548 }
483 549
484 unshift @{ $self->{queue} }, $cb; 550 unshift @{ $self->{_queue} }, $cb;
485 return; 551 return;
486 } 552 }
487 } elsif ($self->{on_read}) { 553 } elsif ($self->{on_read}) {
488 $self->{on_read}($self); 554 $self->{on_read}($self);
489 555
490 if ( 556 if (
491 $self->{eof} # if no further data will arrive 557 $self->{_eof} # if no further data will arrive
492 && $len == length $self->{rbuf} # and no data has been consumed 558 && $len == length $self->{rbuf} # and no data has been consumed
493 && !@{ $self->{queue} } # and the queue is still empty 559 && !@{ $self->{_queue} } # and the queue is still empty
494 && $self->{on_read} # and we still want to read data 560 && $self->{on_read} # and we still want to read data
495 ) { 561 ) {
496 # then no progress can be made 562 # then no progress can be made
497 $! = &Errno::EPIPE; return $self->error; 563 $! = &Errno::EPIPE;
564 $self->error;
498 } 565 }
499 } else { 566 } else {
500 # read side becomes idle 567 # read side becomes idle
501 delete $self->{rw}; 568 delete $self->{_rw};
502 return; 569 return;
503 } 570 }
504 } 571 }
505 572
506 if ($self->{eof}) { 573 if ($self->{_eof}) {
507 $self->_shutdown; 574 $self->_shutdown;
508 $self->{on_eof}($self) 575 $self->{on_eof}($self)
509 if $self->{on_eof}; 576 if $self->{on_eof};
510 } 577 }
511} 578}
… …
577 644
578 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 645 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
579 ->($self, $cb, @_); 646 ->($self, $cb, @_);
580 } 647 }
581 648
582 push @{ $self->{queue} }, $cb; 649 push @{ $self->{_queue} }, $cb;
583 $self->_drain_rbuf; 650 $self->_drain_rbuf;
584} 651}
585 652
586sub unshift_read { 653sub unshift_read {
587 my $self = shift; 654 my $self = shift;
… …
593 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 660 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
594 ->($self, $cb, @_); 661 ->($self, $cb, @_);
595 } 662 }
596 663
597 664
598 unshift @{ $self->{queue} }, $cb; 665 unshift @{ $self->{_queue} }, $cb;
599 $self->_drain_rbuf; 666 $self->_drain_rbuf;
600} 667}
601 668
602=item $handle->push_read (type => @args, $cb) 669=item $handle->push_read (type => @args, $cb)
603 670
… …
610Predefined types are (if you have ideas for additional types, feel free to 677Predefined types are (if you have ideas for additional types, feel free to
611drop by and tell us): 678drop by and tell us):
612 679
613=over 4 680=over 4
614 681
615=item chunk => $octets, $cb->($self, $data) 682=item chunk => $octets, $cb->($handle, $data)
616 683
617Invoke the callback only once C<$octets> bytes have been read. Pass the 684Invoke the callback only once C<$octets> bytes have been read. Pass the
618data read to the callback. The callback will never be called with less 685data read to the callback. The callback will never be called with less
619data. 686data.
620 687
… …
643 710
644sub unshift_read_chunk { 711sub unshift_read_chunk {
645 $_[0]->unshift_read (chunk => $_[1], $_[2]); 712 $_[0]->unshift_read (chunk => $_[1], $_[2]);
646} 713}
647 714
648=item line => [$eol, ]$cb->($self, $line, $eol) 715=item line => [$eol, ]$cb->($handle, $line, $eol)
649 716
650The callback will be called only once a full line (including the end of 717The callback will be called only once a full line (including the end of
651line marker, C<$eol>) has been read. This line (excluding the end of line 718line marker, C<$eol>) has been read. This line (excluding the end of line
652marker) will be passed to the callback as second argument (C<$line>), and 719marker) will be passed to the callback as second argument (C<$line>), and
653the end of line marker as the third argument (C<$eol>). 720the end of line marker as the third argument (C<$eol>).
… …
690sub unshift_read_line { 757sub unshift_read_line {
691 my $self = shift; 758 my $self = shift;
692 $self->unshift_read (line => @_); 759 $self->unshift_read (line => @_);
693} 760}
694 761
695=item netstring => $cb->($string) 762=item netstring => $cb->($handle, $string)
696 763
697A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement). 764A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
698 765
699Throws an error with C<$!> set to EBADMSG on format violations. 766Throws an error with C<$!> set to EBADMSG on format violations.
700 767
… …
728 795
729 1 796 1
730 } 797 }
731}; 798};
732 799
800=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
801
802Makes a regex match against the regex object C<$accept> and returns
803everything up to and including the match.
804
805Example: read a single line terminated by '\n'.
806
807 $handle->push_read (regex => qr<\n>, sub { ... });
808
809If C<$reject> is given and not undef, then it determines when the data is
810to be rejected: it is matched against the data when the C<$accept> regex
811does not match and generates an C<EBADMSG> error when it matches. This is
812useful to quickly reject wrong data (to avoid waiting for a timeout or a
813receive buffer overflow).
814
815Example: expect a single decimal number followed by whitespace, reject
816anything else (not the use of an anchor).
817
818 $handle->push_read (regex => qr<^[0-9]+\s>, qr<[^0-9]>, sub { ... });
819
820If C<$skip> is given and not C<undef>, then it will be matched against
821the receive buffer when neither C<$accept> nor C<$reject> match,
822and everything preceding and including the match will be accepted
823unconditionally. This is useful to skip large amounts of data that you
824know cannot be matched, so that the C<$accept> or C<$reject> regex do not
825have to start matching from the beginning. This is purely an optimisation
826and is usually worth only when you expect more than a few kilobytes.
827
828Example: expect a http header, which ends at C<\015\012\015\012>. Since we
829expect the header to be very large (it isn't in practise, but...), we use
830a skip regex to skip initial portions. The skip regex is tricky in that
831it only accepts something not ending in either \015 or \012, as these are
832required for the accept regex.
833
834 $handle->push_read (regex =>
835 qr<\015\012\015\012>,
836 undef, # no reject
837 qr<^.*[^\015\012]>,
838 sub { ... });
839
840=cut
841
842register_read_type regex => sub {
843 my ($self, $cb, $accept, $reject, $skip) = @_;
844
845 my $data;
846 my $rbuf = \$self->{rbuf};
847
848 sub {
849 # accept
850 if ($$rbuf =~ $accept) {
851 $data .= substr $$rbuf, 0, $+[0], "";
852 $cb->($self, $data);
853 return 1;
854 }
855
856 # reject
857 if ($reject && $$rbuf =~ $reject) {
858 $! = &Errno::EBADMSG;
859 $self->error;
860 }
861
862 # skip
863 if ($skip && $$rbuf =~ $skip) {
864 $data .= substr $$rbuf, 0, $+[0], "";
865 }
866
867 ()
868 }
869};
870
871=item json => $cb->($handle, $hash_or_arrayref)
872
873Reads a JSON object or array, decodes it and passes it to the callback.
874
875If a C<json> object was passed to the constructor, then that will be used
876for the final decode, otherwise it will create a JSON coder expecting UTF-8.
877
878This read type uses the incremental parser available with JSON version
8792.09 (and JSON::XS version 2.2) and above. You have to provide a
880dependency on your own: this module will load the JSON module, but
881AnyEvent does not depend on it itself.
882
883Since JSON texts are fully self-delimiting, the C<json> read and write
884types are an ideal simple RPC protocol: just exchange JSON datagrams. See
885the C<json> write type description, above, for an actual example.
886
887=cut
888
889register_read_type json => sub {
890 my ($self, $cb, $accept, $reject, $skip) = @_;
891
892 require JSON;
893
894 my $data;
895 my $rbuf = \$self->{rbuf};
896
897 my $json = $self->{json} ||= JSON->new->utf8;
898
899 sub {
900 my $ref = $json->incr_parse ($self->{rbuf});
901
902 if ($ref) {
903 $self->{rbuf} = $json->incr_text;
904 $json->incr_text = "";
905 $cb->($self, $ref);
906
907 1
908 } else {
909 $self->{rbuf} = "";
910 ()
911 }
912 }
913};
914
733=back 915=back
734 916
735=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args) 917=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
736 918
737This function (not method) lets you add your own types to C<push_read>. 919This function (not method) lets you add your own types to C<push_read>.
738 920
739Whenever the given C<type> is used, C<push_read> will invoke the code 921Whenever the given C<type> is used, C<push_read> will invoke the code
740reference with the handle object, the callback and the remaining 922reference with the handle object, the callback and the remaining
… …
742 924
743The code reference is supposed to return a callback (usually a closure) 925The code reference is supposed to return a callback (usually a closure)
744that works as a plain read callback (see C<< ->push_read ($cb) >>). 926that works as a plain read callback (see C<< ->push_read ($cb) >>).
745 927
746It should invoke the passed callback when it is done reading (remember to 928It should invoke the passed callback when it is done reading (remember to
747pass C<$self> as first argument as all other callbacks do that). 929pass C<$handle> as first argument as all other callbacks do that).
748 930
749Note that this is a function, and all types registered this way will be 931Note that this is a function, and all types registered this way will be
750global, so try to use unique names. 932global, so try to use unique names.
751 933
752For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>, 934For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
… …
764=cut 946=cut
765 947
766sub stop_read { 948sub stop_read {
767 my ($self) = @_; 949 my ($self) = @_;
768 950
769 delete $self->{rw}; 951 delete $self->{_rw};
770} 952}
771 953
772sub start_read { 954sub start_read {
773 my ($self) = @_; 955 my ($self) = @_;
774 956
775 unless ($self->{rw} || $self->{eof}) { 957 unless ($self->{_rw} || $self->{_eof}) {
776 Scalar::Util::weaken $self; 958 Scalar::Util::weaken $self;
777 959
778 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 960 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
779 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 961 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
780 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 962 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
781 963
782 if ($len > 0) { 964 if ($len > 0) {
783 $self->{filter_r} 965 $self->{filter_r}
784 ? $self->{filter_r}->($self, $rbuf) 966 ? $self->{filter_r}->($self, $rbuf)
785 : $self->_drain_rbuf; 967 : $self->_drain_rbuf;
786 968
787 } elsif (defined $len) { 969 } elsif (defined $len) {
788 delete $self->{rw}; 970 delete $self->{_rw};
789 $self->{eof} = 1; 971 $self->{_eof} = 1;
790 $self->_drain_rbuf; 972 $self->_drain_rbuf;
791 973
792 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAEAGAIN) { 974 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
793 return $self->error; 975 return $self->error;
794 } 976 }
795 }); 977 });
796 } 978 }
797} 979}
798 980
799sub _dotls { 981sub _dotls {
800 my ($self) = @_; 982 my ($self) = @_;
801 983
802 if (length $self->{tls_wbuf}) { 984 if (length $self->{_tls_wbuf}) {
803 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) { 985 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
804 substr $self->{tls_wbuf}, 0, $len, ""; 986 substr $self->{_tls_wbuf}, 0, $len, "";
805 } 987 }
806 } 988 }
807 989
808 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 990 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
809 $self->{wbuf} .= $buf; 991 $self->{wbuf} .= $buf;
810 $self->_drain_wbuf; 992 $self->_drain_wbuf;
811 } 993 }
812 994
813 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 995 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
… …
839C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1021C<"connect">, C<"accept"> or an existing Net::SSLeay object).
840 1022
841The second argument is the optional C<Net::SSLeay::CTX> object that is 1023The second argument is the optional C<Net::SSLeay::CTX> object that is
842used when AnyEvent::Handle has to create its own TLS connection object. 1024used when AnyEvent::Handle has to create its own TLS connection object.
843 1025
1026The TLS connection object will end up in C<< $handle->{tls} >> after this
1027call and can be used or changed to your liking. Note that the handshake
1028might have already started when this function returns.
1029
844=cut 1030=cut
845 1031
846# TODO: maybe document... 1032# TODO: maybe document...
847sub starttls { 1033sub starttls {
848 my ($self, $ssl, $ctx) = @_; 1034 my ($self, $ssl, $ctx) = @_;
… …
863 # but the openssl maintainers basically said: "trust us, it just works". 1049 # but the openssl maintainers basically said: "trust us, it just works".
864 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1050 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
865 # and mismaintained ssleay-module doesn't even offer them). 1051 # and mismaintained ssleay-module doesn't even offer them).
866 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1052 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
867 Net::SSLeay::CTX_set_mode ($self->{tls}, 1053 Net::SSLeay::CTX_set_mode ($self->{tls},
868 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1054 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
869 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1055 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
870 1056
871 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1057 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
872 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1058 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
873 1059
874 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 1060 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
875 1061
876 $self->{filter_w} = sub { 1062 $self->{filter_w} = sub {
877 $_[0]{tls_wbuf} .= ${$_[1]}; 1063 $_[0]{_tls_wbuf} .= ${$_[1]};
878 &_dotls; 1064 &_dotls;
879 }; 1065 };
880 $self->{filter_r} = sub { 1066 $self->{filter_r} = sub {
881 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 1067 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
882 &_dotls; 1068 &_dotls;
883 }; 1069 };
884} 1070}
885 1071
886=item $handle->stoptls 1072=item $handle->stoptls
… …
892 1078
893sub stoptls { 1079sub stoptls {
894 my ($self) = @_; 1080 my ($self) = @_;
895 1081
896 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1082 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
1083
897 delete $self->{tls_rbio}; 1084 delete $self->{_rbio};
898 delete $self->{tls_wbio}; 1085 delete $self->{_wbio};
899 delete $self->{tls_wbuf}; 1086 delete $self->{_tls_wbuf};
900 delete $self->{filter_r}; 1087 delete $self->{filter_r};
901 delete $self->{filter_w}; 1088 delete $self->{filter_w};
902} 1089}
903 1090
904sub DESTROY { 1091sub DESTROY {
… …
942 } 1129 }
943} 1130}
944 1131
945=back 1132=back
946 1133
1134=head1 SUBCLASSING AnyEvent::Handle
1135
1136In many cases, you might want to subclass AnyEvent::Handle.
1137
1138To make this easier, a given version of AnyEvent::Handle uses these
1139conventions:
1140
1141=over 4
1142
1143=item * all constructor arguments become object members.
1144
1145At least initially, when you pass a C<tls>-argument to the constructor it
1146will end up in C<< $handle->{tls} >>. Those members might be changes or
1147mutated later on (for example C<tls> will hold the TLS connection object).
1148
1149=item * other object member names are prefixed with an C<_>.
1150
1151All object members not explicitly documented (internal use) are prefixed
1152with an underscore character, so the remaining non-C<_>-namespace is free
1153for use for subclasses.
1154
1155=item * all members not documented here and not prefixed with an underscore
1156are free to use in subclasses.
1157
1158Of course, new versions of AnyEvent::Handle may introduce more "public"
1159member variables, but thats just life, at least it is documented.
1160
1161=back
1162
947=head1 AUTHOR 1163=head1 AUTHOR
948 1164
949Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 1165Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
950 1166
951=cut 1167=cut

Diff Legend

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