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.38 by root, Mon May 26 21:28:33 2008 UTC

… …
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 callbakc should throw an exception. If it returns, then 98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you. 99AnyEvent::Handle will C<croak> for you.
100 100
101While 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
102you will not be notified of errors otherwise. The default simply calls 102you will not be notified of errors otherwise. The default simply calls
103die. 103die.
… …
168 168
169Use 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
170(unless a connection object was specified directly). If this parameter is 170(unless a connection object was specified directly). If this parameter is
171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
172 172
173=item filter_r => $cb
174
175=item filter_w => $cb
176
177These exist, but are undocumented at this time.
178
173=back 179=back
174 180
175=cut 181=cut
176 182
177sub new { 183sub new {
… …
199} 205}
200 206
201sub _shutdown { 207sub _shutdown {
202 my ($self) = @_; 208 my ($self) = @_;
203 209
204 delete $self->{rw}; 210 delete $self->{_rw};
205 delete $self->{ww}; 211 delete $self->{_ww};
206 delete $self->{fh}; 212 delete $self->{fh};
207} 213}
208 214
209sub error { 215sub error {
210 my ($self) = @_; 216 my ($self) = @_;
… …
224 230
225This method returns the file handle of the L<AnyEvent::Handle> object. 231This method returns the file handle of the L<AnyEvent::Handle> object.
226 232
227=cut 233=cut
228 234
229sub fh { $_[0]->{fh} } 235sub fh { $_[0]{fh} }
230 236
231=item $handle->on_error ($cb) 237=item $handle->on_error ($cb)
232 238
233Replace the current C<on_error> callback (see the C<on_error> constructor argument). 239Replace the current C<on_error> callback (see the C<on_error> constructor argument).
234 240
… …
290=cut 296=cut
291 297
292sub _drain_wbuf { 298sub _drain_wbuf {
293 my ($self) = @_; 299 my ($self) = @_;
294 300
295 if (!$self->{ww} && length $self->{wbuf}) { 301 if (!$self->{_ww} && length $self->{wbuf}) {
296 302
297 Scalar::Util::weaken $self; 303 Scalar::Util::weaken $self;
298 304
299 my $cb = sub { 305 my $cb = sub {
300 my $len = syswrite $self->{fh}, $self->{wbuf}; 306 my $len = syswrite $self->{fh}, $self->{wbuf};
… …
304 310
305 $self->{on_drain}($self) 311 $self->{on_drain}($self)
306 if $self->{low_water_mark} >= length $self->{wbuf} 312 if $self->{low_water_mark} >= length $self->{wbuf}
307 && $self->{on_drain}; 313 && $self->{on_drain};
308 314
309 delete $self->{ww} unless length $self->{wbuf}; 315 delete $self->{_ww} unless length $self->{wbuf};
310 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) { 316 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {
311 $self->error; 317 $self->error;
312 } 318 }
313 }; 319 };
314 320
315 # try to write data immediately 321 # try to write data immediately
316 $cb->(); 322 $cb->();
317 323
318 # if still data left in wbuf, we need to poll 324 # if still data left in wbuf, we need to poll
319 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 325 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
320 if length $self->{wbuf}; 326 if length $self->{wbuf};
321 }; 327 };
322} 328}
323 329
324our %WH; 330our %WH;
… …
480 return if $self->{in_drain}; 486 return if $self->{in_drain};
481 local $self->{in_drain} = 1; 487 local $self->{in_drain} = 1;
482 488
483 while (my $len = length $self->{rbuf}) { 489 while (my $len = length $self->{rbuf}) {
484 no strict 'refs'; 490 no strict 'refs';
485 if (my $cb = shift @{ $self->{queue} }) { 491 if (my $cb = shift @{ $self->{_queue} }) {
486 unless ($cb->($self)) { 492 unless ($cb->($self)) {
487 if ($self->{eof}) { 493 if ($self->{_eof}) {
488 # no progress can be made (not enough data and no data forthcoming) 494 # no progress can be made (not enough data and no data forthcoming)
489 $! = &Errno::EPIPE; 495 $! = &Errno::EPIPE;
490 $self->error; 496 $self->error;
491 } 497 }
492 498
493 unshift @{ $self->{queue} }, $cb; 499 unshift @{ $self->{_queue} }, $cb;
494 return; 500 return;
495 } 501 }
496 } elsif ($self->{on_read}) { 502 } elsif ($self->{on_read}) {
497 $self->{on_read}($self); 503 $self->{on_read}($self);
498 504
499 if ( 505 if (
500 $self->{eof} # if no further data will arrive 506 $self->{_eof} # if no further data will arrive
501 && $len == length $self->{rbuf} # and no data has been consumed 507 && $len == length $self->{rbuf} # and no data has been consumed
502 && !@{ $self->{queue} } # and the queue is still empty 508 && !@{ $self->{_queue} } # and the queue is still empty
503 && $self->{on_read} # and we still want to read data 509 && $self->{on_read} # and we still want to read data
504 ) { 510 ) {
505 # then no progress can be made 511 # then no progress can be made
506 $! = &Errno::EPIPE; 512 $! = &Errno::EPIPE;
507 $self->error; 513 $self->error;
508 } 514 }
509 } else { 515 } else {
510 # read side becomes idle 516 # read side becomes idle
511 delete $self->{rw}; 517 delete $self->{_rw};
512 return; 518 return;
513 } 519 }
514 } 520 }
515 521
516 if ($self->{eof}) { 522 if ($self->{_eof}) {
517 $self->_shutdown; 523 $self->_shutdown;
518 $self->{on_eof}($self) 524 $self->{on_eof}($self)
519 if $self->{on_eof}; 525 if $self->{on_eof};
520 } 526 }
521} 527}
… …
587 593
588 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 594 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
589 ->($self, $cb, @_); 595 ->($self, $cb, @_);
590 } 596 }
591 597
592 push @{ $self->{queue} }, $cb; 598 push @{ $self->{_queue} }, $cb;
593 $self->_drain_rbuf; 599 $self->_drain_rbuf;
594} 600}
595 601
596sub unshift_read { 602sub unshift_read {
597 my $self = shift; 603 my $self = shift;
… …
603 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 609 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
604 ->($self, $cb, @_); 610 ->($self, $cb, @_);
605 } 611 }
606 612
607 613
608 unshift @{ $self->{queue} }, $cb; 614 unshift @{ $self->{_queue} }, $cb;
609 $self->_drain_rbuf; 615 $self->_drain_rbuf;
610} 616}
611 617
612=item $handle->push_read (type => @args, $cb) 618=item $handle->push_read (type => @args, $cb)
613 619
… …
845=cut 851=cut
846 852
847sub stop_read { 853sub stop_read {
848 my ($self) = @_; 854 my ($self) = @_;
849 855
850 delete $self->{rw}; 856 delete $self->{_rw};
851} 857}
852 858
853sub start_read { 859sub start_read {
854 my ($self) = @_; 860 my ($self) = @_;
855 861
856 unless ($self->{rw} || $self->{eof}) { 862 unless ($self->{_rw} || $self->{_eof}) {
857 Scalar::Util::weaken $self; 863 Scalar::Util::weaken $self;
858 864
859 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 865 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
860 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 866 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
861 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 867 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
862 868
863 if ($len > 0) { 869 if ($len > 0) {
864 $self->{filter_r} 870 $self->{filter_r}
865 ? $self->{filter_r}->($self, $rbuf) 871 ? $self->{filter_r}->($self, $rbuf)
866 : $self->_drain_rbuf; 872 : $self->_drain_rbuf;
867 873
868 } elsif (defined $len) { 874 } elsif (defined $len) {
869 delete $self->{rw}; 875 delete $self->{_rw};
870 $self->{eof} = 1; 876 $self->{_eof} = 1;
871 $self->_drain_rbuf; 877 $self->_drain_rbuf;
872 878
873 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) { 879 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {
874 return $self->error; 880 return $self->error;
875 } 881 }
… …
878} 884}
879 885
880sub _dotls { 886sub _dotls {
881 my ($self) = @_; 887 my ($self) = @_;
882 888
883 if (length $self->{tls_wbuf}) { 889 if (length $self->{_tls_wbuf}) {
884 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) { 890 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
885 substr $self->{tls_wbuf}, 0, $len, ""; 891 substr $self->{_tls_wbuf}, 0, $len, "";
886 } 892 }
887 } 893 }
888 894
889 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 895 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
890 $self->{wbuf} .= $buf; 896 $self->{wbuf} .= $buf;
891 $self->_drain_wbuf; 897 $self->_drain_wbuf;
892 } 898 }
893 899
894 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 900 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
… …
919The first argument is the same as the C<tls> constructor argument (either 925The first argument is the same as the C<tls> constructor argument (either
920C<"connect">, C<"accept"> or an existing Net::SSLeay object). 926C<"connect">, C<"accept"> or an existing Net::SSLeay object).
921 927
922The second argument is the optional C<Net::SSLeay::CTX> object that is 928The second argument is the optional C<Net::SSLeay::CTX> object that is
923used when AnyEvent::Handle has to create its own TLS connection object. 929used when AnyEvent::Handle has to create its own TLS connection object.
930
931The TLS connection object will end up in C<< $handle->{tls} >> after this
932call and can be used or changed to your liking. Note that the handshake
933might have already started when this function returns.
924 934
925=cut 935=cut
926 936
927# TODO: maybe document... 937# TODO: maybe document...
928sub starttls { 938sub starttls {
… …
947 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 957 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
948 Net::SSLeay::CTX_set_mode ($self->{tls}, 958 Net::SSLeay::CTX_set_mode ($self->{tls},
949 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 959 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
950 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 960 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
951 961
952 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 962 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
953 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 963 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
954 964
955 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 965 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
956 966
957 $self->{filter_w} = sub { 967 $self->{filter_w} = sub {
958 $_[0]{tls_wbuf} .= ${$_[1]}; 968 $_[0]{_tls_wbuf} .= ${$_[1]};
959 &_dotls; 969 &_dotls;
960 }; 970 };
961 $self->{filter_r} = sub { 971 $self->{filter_r} = sub {
962 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 972 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
963 &_dotls; 973 &_dotls;
964 }; 974 };
965} 975}
966 976
967=item $handle->stoptls 977=item $handle->stoptls
… …
973 983
974sub stoptls { 984sub stoptls {
975 my ($self) = @_; 985 my ($self) = @_;
976 986
977 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 987 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
988
978 delete $self->{tls_rbio}; 989 delete $self->{_rbio};
979 delete $self->{tls_wbio}; 990 delete $self->{_wbio};
980 delete $self->{tls_wbuf}; 991 delete $self->{_tls_wbuf};
981 delete $self->{filter_r}; 992 delete $self->{filter_r};
982 delete $self->{filter_w}; 993 delete $self->{filter_w};
983} 994}
984 995
985sub DESTROY { 996sub DESTROY {
… …
1023 } 1034 }
1024} 1035}
1025 1036
1026=back 1037=back
1027 1038
1039=head1 SUBCLASSING AnyEvent::Handle
1040
1041In many cases, you might want to subclass AnyEvent::Handle.
1042
1043To make this easier, a given version of AnyEvent::Handle uses these
1044conventions:
1045
1046=over 4
1047
1048=item * all constructor arguments become object members.
1049
1050At least initially, when you pass a C<tls>-argument to the constructor it
1051will end up in C<< $handle->{tls} >>. Those members might be changes or
1052mutated later on (for example C<tls> will hold the TLS connection object).
1053
1054=item * other object member names are prefixed with an C<_>.
1055
1056All object members not explicitly documented (internal use) are prefixed
1057with an underscore character, so the remaining non-C<_>-namespace is free
1058for use for subclasses.
1059
1060=item * all members not documented here and not prefixed with an underscore
1061are free to use in subclasses.
1062
1063Of course, new versions of AnyEvent::Handle may introduce more "public"
1064member variables, but thats just life, at least it is documented.
1065
1066=back
1067
1028=head1 AUTHOR 1068=head1 AUTHOR
1029 1069
1030Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 1070Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.
1031 1071
1032=cut 1072=cut

Diff Legend

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