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.30 by root, Sat May 24 23:56:26 2008 UTC vs.
Revision 1.40 by root, Tue May 27 05:36:27 2008 UTC

… …
2 2
3no warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util (); 7use AnyEvent::Util qw(WSAWOULDBLOCK);
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
17This module is experimental.
18
19=cut 17=cut
20 18
21our $VERSION = '0.04'; 19our $VERSION = '0.04';
22 20
23=head1 SYNOPSIS 21=head1 SYNOPSIS
… …
25 use AnyEvent; 23 use AnyEvent;
26 use AnyEvent::Handle; 24 use AnyEvent::Handle;
27 25
28 my $cv = AnyEvent->condvar; 26 my $cv = AnyEvent->condvar;
29 27
30 my $ae_fh = AnyEvent::Handle->new (fh => \*STDIN); 28 my $handle =
31
32 #TODO
33
34 # or use the constructor to pass the callback:
35
36 my $ae_fh2 =
37 AnyEvent::Handle->new ( 29 AnyEvent::Handle->new (
38 fh => \*STDIN, 30 fh => \*STDIN,
39 on_eof => sub { 31 on_eof => sub {
40 $cv->broadcast; 32 $cv->broadcast;
41 }, 33 },
42 #TODO
43 ); 34 );
44 35
45 $cv->wait; 36 # send some request line
37 $handle->push_write ("getinfo\015\012");
38
39 # read the response line
40 $handle->push_read (line => sub {
41 my ($handle, $line) = @_;
42 warn "read line <$line>\n";
43 $cv->send;
44 });
45
46 $cv->recv;
46 47
47=head1 DESCRIPTION 48=head1 DESCRIPTION
48 49
49This module is a helper module to make it easier to do event-based I/O on 50This module is a helper module to make it easier to do event-based I/O on
50filehandles. For utility functions for doing non-blocking connects and accepts 51filehandles. For utility functions for doing non-blocking connects and accepts
… …
72The filehandle this L<AnyEvent::Handle> object will operate on. 73The filehandle this L<AnyEvent::Handle> object will operate on.
73 74
74NOTE: The filehandle will be set to non-blocking (using 75NOTE: The filehandle will be set to non-blocking (using
75AnyEvent::Util::fh_nonblocking). 76AnyEvent::Util::fh_nonblocking).
76 77
77=item on_eof => $cb->($self) 78=item on_eof => $cb->($handle)
78 79
79Set the callback to be called on EOF. 80Set the callback to be called on EOF.
80 81
81While not mandatory, it is highly recommended to set an eof callback, 82While not mandatory, it is highly recommended to set an eof callback,
82otherwise 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
83waiting for data. 84waiting for data.
84 85
85=item on_error => $cb->($self) 86=item on_error => $cb->($handle)
86 87
87This 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
88occurs, 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
89or a read error. 90or a read error.
90 91
… …
92called. 93called.
93 94
94On callback entrance, the value of C<$!> contains the operating system 95On callback entrance, the value of C<$!> contains the operating system
95error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>). 96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).
96 97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
100
97While 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
98you will not be notified of errors otherwise. The default simply calls 102you will not be notified of errors otherwise. The default simply calls
99die. 103die.
100 104
101=item on_read => $cb->($self) 105=item on_read => $cb->($handle)
102 106
103This sets the default read callback, which is called when data arrives 107This sets the default read callback, which is called when data arrives
104and no read request is in the queue. 108and no read request is in the queue.
105 109
106To 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 >>
107method or access the C<$self->{rbuf}> member directly. 111method or access the C<$handle->{rbuf}> member directly.
108 112
109When 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
110feed 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
111calling 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
112error will be raised (with C<$!> set to C<EPIPE>). 116error will be raised (with C<$!> set to C<EPIPE>).
113 117
114=item on_drain => $cb->() 118=item on_drain => $cb->($handle)
115 119
116This 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
117(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).
118 122
119To append to the write buffer, use the C<< ->push_write >> method. 123To append to the write buffer, use the C<< ->push_write >> method.
… …
164 168
165Use 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
166(unless a connection object was specified directly). If this parameter is 170(unless a connection object was specified directly). If this parameter is
167missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
168 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 use C<encode_json> and
178C<decode_json>.
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
169=back 189=back
170 190
171=cut 191=cut
172 192
173sub new { 193sub new {
… …
195} 215}
196 216
197sub _shutdown { 217sub _shutdown {
198 my ($self) = @_; 218 my ($self) = @_;
199 219
200 delete $self->{rw}; 220 delete $self->{_rw};
201 delete $self->{ww}; 221 delete $self->{_ww};
202 delete $self->{fh}; 222 delete $self->{fh};
203} 223}
204 224
205sub error { 225sub error {
206 my ($self) = @_; 226 my ($self) = @_;
… …
208 { 228 {
209 local $!; 229 local $!;
210 $self->_shutdown; 230 $self->_shutdown;
211 } 231 }
212 232
213 if ($self->{on_error}) {
214 $self->{on_error}($self); 233 $self->{on_error}($self)
215 } else { 234 if $self->{on_error};
235
216 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 236 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
217 }
218} 237}
219 238
220=item $fh = $handle->fh 239=item $fh = $handle->fh
221 240
222This method returns the file handle of the L<AnyEvent::Handle> object. 241This method returns the file handle of the L<AnyEvent::Handle> object.
223 242
224=cut 243=cut
225 244
226sub fh { $_[0]->{fh} } 245sub fh { $_[0]{fh} }
227 246
228=item $handle->on_error ($cb) 247=item $handle->on_error ($cb)
229 248
230Replace 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).
231 250
… …
287=cut 306=cut
288 307
289sub _drain_wbuf { 308sub _drain_wbuf {
290 my ($self) = @_; 309 my ($self) = @_;
291 310
292 if (!$self->{ww} && length $self->{wbuf}) { 311 if (!$self->{_ww} && length $self->{wbuf}) {
312
293 Scalar::Util::weaken $self; 313 Scalar::Util::weaken $self;
314
294 my $cb = sub { 315 my $cb = sub {
295 my $len = syswrite $self->{fh}, $self->{wbuf}; 316 my $len = syswrite $self->{fh}, $self->{wbuf};
296 317
297 if ($len >= 0) { 318 if ($len >= 0) {
298 substr $self->{wbuf}, 0, $len, ""; 319 substr $self->{wbuf}, 0, $len, "";
299 320
300 $self->{on_drain}($self) 321 $self->{on_drain}($self)
301 if $self->{low_water_mark} >= length $self->{wbuf} 322 if $self->{low_water_mark} >= length $self->{wbuf}
302 && $self->{on_drain}; 323 && $self->{on_drain};
303 324
304 delete $self->{ww} unless length $self->{wbuf}; 325 delete $self->{_ww} unless length $self->{wbuf};
305 } elsif ($! != EAGAIN && $! != EINTR) { 326 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {
306 $self->error; 327 $self->error;
307 } 328 }
308 }; 329 };
309 330
331 # try to write data immediately
332 $cb->();
333
334 # if still data left in wbuf, we need to poll
310 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 335 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
311 336 if length $self->{wbuf};
312 $cb->($self);
313 }; 337 };
314} 338}
315 339
316our %WH; 340our %WH;
317 341
… …
362 my ($self, $string) = @_; 386 my ($self, $string) = @_;
363 387
364 sprintf "%d:%s,", (length $string), $string 388 sprintf "%d:%s,", (length $string), $string
365}; 389};
366 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
401=cut
402
403register_write_type json => sub {
404 my ($self, $ref) = @_;
405
406 require JSON;
407
408 $self->{json} ? $self->{json}->encode ($ref)
409 : JSON::encode_json ($ref)
410};
411
367=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args) 412=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
368 413
369This function (not method) lets you add your own types to C<push_write>. 414This function (not method) lets you add your own types to C<push_write>.
370Whenever the given C<type> is used, C<push_write> will invoke the code 415Whenever the given C<type> is used, C<push_write> will invoke the code
371reference with the handle object and the remaining arguments. 416reference with the handle object and the remaining arguments.
372 417
… …
463 508
464 if ( 509 if (
465 defined $self->{rbuf_max} 510 defined $self->{rbuf_max}
466 && $self->{rbuf_max} < length $self->{rbuf} 511 && $self->{rbuf_max} < length $self->{rbuf}
467 ) { 512 ) {
468 $! = &Errno::ENOSPC; return $self->error; 513 $! = &Errno::ENOSPC;
514 $self->error;
469 } 515 }
470 516
471 return if $self->{in_drain}; 517 return if $self->{in_drain};
472 local $self->{in_drain} = 1; 518 local $self->{in_drain} = 1;
473 519
474 while (my $len = length $self->{rbuf}) { 520 while (my $len = length $self->{rbuf}) {
475 no strict 'refs'; 521 no strict 'refs';
476 if (my $cb = shift @{ $self->{queue} }) { 522 if (my $cb = shift @{ $self->{_queue} }) {
477 unless ($cb->($self)) { 523 unless ($cb->($self)) {
478 if ($self->{eof}) { 524 if ($self->{_eof}) {
479 # no progress can be made (not enough data and no data forthcoming) 525 # no progress can be made (not enough data and no data forthcoming)
480 $! = &Errno::EPIPE; return $self->error; 526 $! = &Errno::EPIPE;
527 $self->error;
481 } 528 }
482 529
483 unshift @{ $self->{queue} }, $cb; 530 unshift @{ $self->{_queue} }, $cb;
484 return; 531 return;
485 } 532 }
486 } elsif ($self->{on_read}) { 533 } elsif ($self->{on_read}) {
487 $self->{on_read}($self); 534 $self->{on_read}($self);
488 535
489 if ( 536 if (
490 $self->{eof} # if no further data will arrive 537 $self->{_eof} # if no further data will arrive
491 && $len == length $self->{rbuf} # and no data has been consumed 538 && $len == length $self->{rbuf} # and no data has been consumed
492 && !@{ $self->{queue} } # and the queue is still empty 539 && !@{ $self->{_queue} } # and the queue is still empty
493 && $self->{on_read} # and we still want to read data 540 && $self->{on_read} # and we still want to read data
494 ) { 541 ) {
495 # then no progress can be made 542 # then no progress can be made
496 $! = &Errno::EPIPE; return $self->error; 543 $! = &Errno::EPIPE;
544 $self->error;
497 } 545 }
498 } else { 546 } else {
499 # read side becomes idle 547 # read side becomes idle
500 delete $self->{rw}; 548 delete $self->{_rw};
501 return; 549 return;
502 } 550 }
503 } 551 }
504 552
505 if ($self->{eof}) { 553 if ($self->{_eof}) {
506 $self->_shutdown; 554 $self->_shutdown;
507 $self->{on_eof}($self) 555 $self->{on_eof}($self)
508 if $self->{on_eof}; 556 if $self->{on_eof};
509 } 557 }
510} 558}
… …
576 624
577 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 625 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
578 ->($self, $cb, @_); 626 ->($self, $cb, @_);
579 } 627 }
580 628
581 push @{ $self->{queue} }, $cb; 629 push @{ $self->{_queue} }, $cb;
582 $self->_drain_rbuf; 630 $self->_drain_rbuf;
583} 631}
584 632
585sub unshift_read { 633sub unshift_read {
586 my $self = shift; 634 my $self = shift;
… …
592 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 640 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
593 ->($self, $cb, @_); 641 ->($self, $cb, @_);
594 } 642 }
595 643
596 644
597 unshift @{ $self->{queue} }, $cb; 645 unshift @{ $self->{_queue} }, $cb;
598 $self->_drain_rbuf; 646 $self->_drain_rbuf;
599} 647}
600 648
601=item $handle->push_read (type => @args, $cb) 649=item $handle->push_read (type => @args, $cb)
602 650
… …
609Predefined types are (if you have ideas for additional types, feel free to 657Predefined types are (if you have ideas for additional types, feel free to
610drop by and tell us): 658drop by and tell us):
611 659
612=over 4 660=over 4
613 661
614=item chunk => $octets, $cb->($self, $data) 662=item chunk => $octets, $cb->($handle, $data)
615 663
616Invoke the callback only once C<$octets> bytes have been read. Pass the 664Invoke the callback only once C<$octets> bytes have been read. Pass the
617data read to the callback. The callback will never be called with less 665data read to the callback. The callback will never be called with less
618data. 666data.
619 667
… …
642 690
643sub unshift_read_chunk { 691sub unshift_read_chunk {
644 $_[0]->unshift_read (chunk => $_[1], $_[2]); 692 $_[0]->unshift_read (chunk => $_[1], $_[2]);
645} 693}
646 694
647=item line => [$eol, ]$cb->($self, $line, $eol) 695=item line => [$eol, ]$cb->($handle, $line, $eol)
648 696
649The callback will be called only once a full line (including the end of 697The callback will be called only once a full line (including the end of
650line marker, C<$eol>) has been read. This line (excluding the end of line 698line marker, C<$eol>) has been read. This line (excluding the end of line
651marker) will be passed to the callback as second argument (C<$line>), and 699marker) will be passed to the callback as second argument (C<$line>), and
652the end of line marker as the third argument (C<$eol>). 700the end of line marker as the third argument (C<$eol>).
… …
689sub unshift_read_line { 737sub unshift_read_line {
690 my $self = shift; 738 my $self = shift;
691 $self->unshift_read (line => @_); 739 $self->unshift_read (line => @_);
692} 740}
693 741
694=item netstring => $cb->($string) 742=item netstring => $cb->($handle, $string)
695 743
696A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement). 744A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
697 745
698Throws an error with C<$!> set to EBADMSG on format violations. 746Throws an error with C<$!> set to EBADMSG on format violations.
699 747
… …
727 775
728 1 776 1
729 } 777 }
730}; 778};
731 779
780=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
781
782Makes a regex match against the regex object C<$accept> and returns
783everything up to and including the match.
784
785Example: read a single line terminated by '\n'.
786
787 $handle->push_read (regex => qr<\n>, sub { ... });
788
789If C<$reject> is given and not undef, then it determines when the data is
790to be rejected: it is matched against the data when the C<$accept> regex
791does not match and generates an C<EBADMSG> error when it matches. This is
792useful to quickly reject wrong data (to avoid waiting for a timeout or a
793receive buffer overflow).
794
795Example: expect a single decimal number followed by whitespace, reject
796anything else (not the use of an anchor).
797
798 $handle->push_read (regex => qr<^[0-9]+\s>, qr<[^0-9]>, sub { ... });
799
800If C<$skip> is given and not C<undef>, then it will be matched against
801the receive buffer when neither C<$accept> nor C<$reject> match,
802and everything preceding and including the match will be accepted
803unconditionally. This is useful to skip large amounts of data that you
804know cannot be matched, so that the C<$accept> or C<$reject> regex do not
805have to start matching from the beginning. This is purely an optimisation
806and is usually worth only when you expect more than a few kilobytes.
807
808Example: expect a http header, which ends at C<\015\012\015\012>. Since we
809expect the header to be very large (it isn't in practise, but...), we use
810a skip regex to skip initial portions. The skip regex is tricky in that
811it only accepts something not ending in either \015 or \012, as these are
812required for the accept regex.
813
814 $handle->push_read (regex =>
815 qr<\015\012\015\012>,
816 undef, # no reject
817 qr<^.*[^\015\012]>,
818 sub { ... });
819
820=cut
821
822register_read_type regex => sub {
823 my ($self, $cb, $accept, $reject, $skip) = @_;
824
825 my $data;
826 my $rbuf = \$self->{rbuf};
827
828 sub {
829 # accept
830 if ($$rbuf =~ $accept) {
831 $data .= substr $$rbuf, 0, $+[0], "";
832 $cb->($self, $data);
833 return 1;
834 }
835
836 # reject
837 if ($reject && $$rbuf =~ $reject) {
838 $! = &Errno::EBADMSG;
839 $self->error;
840 }
841
842 # skip
843 if ($skip && $$rbuf =~ $skip) {
844 $data .= substr $$rbuf, 0, $+[0], "";
845 }
846
847 ()
848 }
849};
850
851=item json => $cb->($handle, $hash_or_arrayref)
852
853Reads a JSON object or array, decodes it and passes it to the callback.
854
855If a C<json> object was passed to the constructor, then that will be used
856for the final decode, otherwise it will create a JSON coder expecting UTF-8.
857
858This read type uses the incremental parser available with JSON version
8592.09 (and JSON::XS version 2.2) and above. You have to provide a
860dependency on your own: this module will load the JSON module, but
861AnyEvent does not depend on it itself.
862
863Since JSON texts are fully self-delimiting, the C<json> read and write
864types are an ideal simple RPC protocol: just exchange JSON datagrams.
865
866=cut
867
868register_read_type json => sub {
869 my ($self, $cb, $accept, $reject, $skip) = @_;
870
871 require JSON;
872
873 my $data;
874 my $rbuf = \$self->{rbuf};
875
876 my $json = $self->{json} ||= JSON::XS->new->utf8;
877
878 sub {
879 my $ref = $json->incr_parse ($self->{rbuf});
880
881 if ($ref) {
882 $self->{rbuf} = $json->incr_text;
883 $json->incr_text = "";
884 $cb->($self, $ref);
885
886 1
887 } else {
888 $self->{rbuf} = "";
889 ()
890 }
891 }
892};
893
732=back 894=back
733 895
734=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args) 896=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
735 897
736This function (not method) lets you add your own types to C<push_read>. 898This function (not method) lets you add your own types to C<push_read>.
737 899
738Whenever the given C<type> is used, C<push_read> will invoke the code 900Whenever the given C<type> is used, C<push_read> will invoke the code
739reference with the handle object, the callback and the remaining 901reference with the handle object, the callback and the remaining
… …
741 903
742The code reference is supposed to return a callback (usually a closure) 904The code reference is supposed to return a callback (usually a closure)
743that works as a plain read callback (see C<< ->push_read ($cb) >>). 905that works as a plain read callback (see C<< ->push_read ($cb) >>).
744 906
745It should invoke the passed callback when it is done reading (remember to 907It should invoke the passed callback when it is done reading (remember to
746pass C<$self> as first argument as all other callbacks do that). 908pass C<$handle> as first argument as all other callbacks do that).
747 909
748Note that this is a function, and all types registered this way will be 910Note that this is a function, and all types registered this way will be
749global, so try to use unique names. 911global, so try to use unique names.
750 912
751For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>, 913For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
… …
763=cut 925=cut
764 926
765sub stop_read { 927sub stop_read {
766 my ($self) = @_; 928 my ($self) = @_;
767 929
768 delete $self->{rw}; 930 delete $self->{_rw};
769} 931}
770 932
771sub start_read { 933sub start_read {
772 my ($self) = @_; 934 my ($self) = @_;
773 935
774 unless ($self->{rw} || $self->{eof}) { 936 unless ($self->{_rw} || $self->{_eof}) {
775 Scalar::Util::weaken $self; 937 Scalar::Util::weaken $self;
776 938
777 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 939 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
778 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 940 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
779 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 941 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
780 942
781 if ($len > 0) { 943 if ($len > 0) {
782 $self->{filter_r} 944 $self->{filter_r}
783 ? $self->{filter_r}->($self, $rbuf) 945 ? $self->{filter_r}->($self, $rbuf)
784 : $self->_drain_rbuf; 946 : $self->_drain_rbuf;
785 947
786 } elsif (defined $len) { 948 } elsif (defined $len) {
787 delete $self->{rw}; 949 delete $self->{_rw};
788 $self->{eof} = 1; 950 $self->{_eof} = 1;
789 $self->_drain_rbuf; 951 $self->_drain_rbuf;
790 952
791 } elsif ($! != EAGAIN && $! != EINTR) { 953 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {
792 return $self->error; 954 return $self->error;
793 } 955 }
794 }); 956 });
795 } 957 }
796} 958}
797 959
798sub _dotls { 960sub _dotls {
799 my ($self) = @_; 961 my ($self) = @_;
800 962
801 if (length $self->{tls_wbuf}) { 963 if (length $self->{_tls_wbuf}) {
802 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) { 964 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
803 substr $self->{tls_wbuf}, 0, $len, ""; 965 substr $self->{_tls_wbuf}, 0, $len, "";
804 } 966 }
805 } 967 }
806 968
807 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 969 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
808 $self->{wbuf} .= $buf; 970 $self->{wbuf} .= $buf;
809 $self->_drain_wbuf; 971 $self->_drain_wbuf;
810 } 972 }
811 973
812 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 974 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
… …
838C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1000C<"connect">, C<"accept"> or an existing Net::SSLeay object).
839 1001
840The second argument is the optional C<Net::SSLeay::CTX> object that is 1002The second argument is the optional C<Net::SSLeay::CTX> object that is
841used when AnyEvent::Handle has to create its own TLS connection object. 1003used when AnyEvent::Handle has to create its own TLS connection object.
842 1004
1005The TLS connection object will end up in C<< $handle->{tls} >> after this
1006call and can be used or changed to your liking. Note that the handshake
1007might have already started when this function returns.
1008
843=cut 1009=cut
844 1010
845# TODO: maybe document... 1011# TODO: maybe document...
846sub starttls { 1012sub starttls {
847 my ($self, $ssl, $ctx) = @_; 1013 my ($self, $ssl, $ctx) = @_;
… …
862 # but the openssl maintainers basically said: "trust us, it just works". 1028 # but the openssl maintainers basically said: "trust us, it just works".
863 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1029 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
864 # and mismaintained ssleay-module doesn't even offer them). 1030 # and mismaintained ssleay-module doesn't even offer them).
865 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1031 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
866 Net::SSLeay::CTX_set_mode ($self->{tls}, 1032 Net::SSLeay::CTX_set_mode ($self->{tls},
867 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1033 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
868 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1034 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
869 1035
870 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1036 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
871 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1037 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
872 1038
873 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 1039 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
874 1040
875 $self->{filter_w} = sub { 1041 $self->{filter_w} = sub {
876 $_[0]{tls_wbuf} .= ${$_[1]}; 1042 $_[0]{_tls_wbuf} .= ${$_[1]};
877 &_dotls; 1043 &_dotls;
878 }; 1044 };
879 $self->{filter_r} = sub { 1045 $self->{filter_r} = sub {
880 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 1046 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
881 &_dotls; 1047 &_dotls;
882 }; 1048 };
883} 1049}
884 1050
885=item $handle->stoptls 1051=item $handle->stoptls
… …
891 1057
892sub stoptls { 1058sub stoptls {
893 my ($self) = @_; 1059 my ($self) = @_;
894 1060
895 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1061 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
1062
896 delete $self->{tls_rbio}; 1063 delete $self->{_rbio};
897 delete $self->{tls_wbio}; 1064 delete $self->{_wbio};
898 delete $self->{tls_wbuf}; 1065 delete $self->{_tls_wbuf};
899 delete $self->{filter_r}; 1066 delete $self->{filter_r};
900 delete $self->{filter_w}; 1067 delete $self->{filter_w};
901} 1068}
902 1069
903sub DESTROY { 1070sub DESTROY {
… …
941 } 1108 }
942} 1109}
943 1110
944=back 1111=back
945 1112
1113=head1 SUBCLASSING AnyEvent::Handle
1114
1115In many cases, you might want to subclass AnyEvent::Handle.
1116
1117To make this easier, a given version of AnyEvent::Handle uses these
1118conventions:
1119
1120=over 4
1121
1122=item * all constructor arguments become object members.
1123
1124At least initially, when you pass a C<tls>-argument to the constructor it
1125will end up in C<< $handle->{tls} >>. Those members might be changes or
1126mutated later on (for example C<tls> will hold the TLS connection object).
1127
1128=item * other object member names are prefixed with an C<_>.
1129
1130All object members not explicitly documented (internal use) are prefixed
1131with an underscore character, so the remaining non-C<_>-namespace is free
1132for use for subclasses.
1133
1134=item * all members not documented here and not prefixed with an underscore
1135are free to use in subclasses.
1136
1137Of course, new versions of AnyEvent::Handle may introduce more "public"
1138member variables, but thats just life, at least it is documented.
1139
1140=back
1141
946=head1 AUTHOR 1142=head1 AUTHOR
947 1143
948Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 1144Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
949 1145
950=cut 1146=cut

Diff Legend

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