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.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 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->($self)
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 filter_r => $cb
174
175=item filter_w => $cb
176
177These exist, but are undocumented at this time.
178
170=back 179=back
171 180
172=cut 181=cut
173 182
174sub new { 183sub new {
196} 205}
197 206
198sub _shutdown { 207sub _shutdown {
199 my ($self) = @_; 208 my ($self) = @_;
200 209
201 delete $self->{rw}; 210 delete $self->{_rw};
202 delete $self->{ww}; 211 delete $self->{_ww};
203 delete $self->{fh}; 212 delete $self->{fh};
204} 213}
205 214
206sub error { 215sub error {
207 my ($self) = @_; 216 my ($self) = @_;
209 { 218 {
210 local $!; 219 local $!;
211 $self->_shutdown; 220 $self->_shutdown;
212 } 221 }
213 222
214 if ($self->{on_error}) {
215 $self->{on_error}($self); 223 $self->{on_error}($self)
216 } else { 224 if $self->{on_error};
225
217 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 226 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
218 }
219} 227}
220 228
221=item $fh = $handle->fh 229=item $fh = $handle->fh
222 230
223This method returns the file handle of the L<AnyEvent::Handle> object. 231This method returns the file handle of the L<AnyEvent::Handle> object.
224 232
225=cut 233=cut
226 234
227sub fh { $_[0]->{fh} } 235sub fh { $_[0]{fh} }
228 236
229=item $handle->on_error ($cb) 237=item $handle->on_error ($cb)
230 238
231Replace 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).
232 240
288=cut 296=cut
289 297
290sub _drain_wbuf { 298sub _drain_wbuf {
291 my ($self) = @_; 299 my ($self) = @_;
292 300
293 if (!$self->{ww} && length $self->{wbuf}) { 301 if (!$self->{_ww} && length $self->{wbuf}) {
294 302
295 Scalar::Util::weaken $self; 303 Scalar::Util::weaken $self;
296 304
297 my $cb = sub { 305 my $cb = sub {
298 my $len = syswrite $self->{fh}, $self->{wbuf}; 306 my $len = syswrite $self->{fh}, $self->{wbuf};
302 310
303 $self->{on_drain}($self) 311 $self->{on_drain}($self)
304 if $self->{low_water_mark} >= length $self->{wbuf} 312 if $self->{low_water_mark} >= length $self->{wbuf}
305 && $self->{on_drain}; 313 && $self->{on_drain};
306 314
307 delete $self->{ww} unless length $self->{wbuf}; 315 delete $self->{_ww} unless length $self->{wbuf};
308 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) { 316 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {
309 $self->error; 317 $self->error;
310 } 318 }
311 }; 319 };
312 320
313 # try to write data immediately 321 # try to write data immediately
314 $cb->(); 322 $cb->();
315 323
316 # if still data left in wbuf, we need to poll 324 # if still data left in wbuf, we need to poll
317 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 325 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
318 if length $self->{wbuf}; 326 if length $self->{wbuf};
319 }; 327 };
320} 328}
321 329
322our %WH; 330our %WH;
469 477
470 if ( 478 if (
471 defined $self->{rbuf_max} 479 defined $self->{rbuf_max}
472 && $self->{rbuf_max} < length $self->{rbuf} 480 && $self->{rbuf_max} < length $self->{rbuf}
473 ) { 481 ) {
474 $! = &Errno::ENOSPC; return $self->error; 482 $! = &Errno::ENOSPC;
483 $self->error;
475 } 484 }
476 485
477 return if $self->{in_drain}; 486 return if $self->{in_drain};
478 local $self->{in_drain} = 1; 487 local $self->{in_drain} = 1;
479 488
480 while (my $len = length $self->{rbuf}) { 489 while (my $len = length $self->{rbuf}) {
481 no strict 'refs'; 490 no strict 'refs';
482 if (my $cb = shift @{ $self->{queue} }) { 491 if (my $cb = shift @{ $self->{_queue} }) {
483 unless ($cb->($self)) { 492 unless ($cb->($self)) {
484 if ($self->{eof}) { 493 if ($self->{_eof}) {
485 # 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)
486 $! = &Errno::EPIPE; return $self->error; 495 $! = &Errno::EPIPE;
496 $self->error;
487 } 497 }
488 498
489 unshift @{ $self->{queue} }, $cb; 499 unshift @{ $self->{_queue} }, $cb;
490 return; 500 return;
491 } 501 }
492 } elsif ($self->{on_read}) { 502 } elsif ($self->{on_read}) {
493 $self->{on_read}($self); 503 $self->{on_read}($self);
494 504
495 if ( 505 if (
496 $self->{eof} # if no further data will arrive 506 $self->{_eof} # if no further data will arrive
497 && $len == length $self->{rbuf} # and no data has been consumed 507 && $len == length $self->{rbuf} # and no data has been consumed
498 && !@{ $self->{queue} } # and the queue is still empty 508 && !@{ $self->{_queue} } # and the queue is still empty
499 && $self->{on_read} # and we still want to read data 509 && $self->{on_read} # and we still want to read data
500 ) { 510 ) {
501 # then no progress can be made 511 # then no progress can be made
502 $! = &Errno::EPIPE; return $self->error; 512 $! = &Errno::EPIPE;
513 $self->error;
503 } 514 }
504 } else { 515 } else {
505 # read side becomes idle 516 # read side becomes idle
506 delete $self->{rw}; 517 delete $self->{_rw};
507 return; 518 return;
508 } 519 }
509 } 520 }
510 521
511 if ($self->{eof}) { 522 if ($self->{_eof}) {
512 $self->_shutdown; 523 $self->_shutdown;
513 $self->{on_eof}($self) 524 $self->{on_eof}($self)
514 if $self->{on_eof}; 525 if $self->{on_eof};
515 } 526 }
516} 527}
582 593
583 $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")
584 ->($self, $cb, @_); 595 ->($self, $cb, @_);
585 } 596 }
586 597
587 push @{ $self->{queue} }, $cb; 598 push @{ $self->{_queue} }, $cb;
588 $self->_drain_rbuf; 599 $self->_drain_rbuf;
589} 600}
590 601
591sub unshift_read { 602sub unshift_read {
592 my $self = shift; 603 my $self = shift;
598 $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")
599 ->($self, $cb, @_); 610 ->($self, $cb, @_);
600 } 611 }
601 612
602 613
603 unshift @{ $self->{queue} }, $cb; 614 unshift @{ $self->{_queue} }, $cb;
604 $self->_drain_rbuf; 615 $self->_drain_rbuf;
605} 616}
606 617
607=item $handle->push_read (type => @args, $cb) 618=item $handle->push_read (type => @args, $cb)
608 619
840=cut 851=cut
841 852
842sub stop_read { 853sub stop_read {
843 my ($self) = @_; 854 my ($self) = @_;
844 855
845 delete $self->{rw}; 856 delete $self->{_rw};
846} 857}
847 858
848sub start_read { 859sub start_read {
849 my ($self) = @_; 860 my ($self) = @_;
850 861
851 unless ($self->{rw} || $self->{eof}) { 862 unless ($self->{_rw} || $self->{_eof}) {
852 Scalar::Util::weaken $self; 863 Scalar::Util::weaken $self;
853 864
854 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 865 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
855 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 866 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
856 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;
857 868
858 if ($len > 0) { 869 if ($len > 0) {
859 $self->{filter_r} 870 $self->{filter_r}
860 ? $self->{filter_r}->($self, $rbuf) 871 ? $self->{filter_r}->($self, $rbuf)
861 : $self->_drain_rbuf; 872 : $self->_drain_rbuf;
862 873
863 } elsif (defined $len) { 874 } elsif (defined $len) {
864 delete $self->{rw}; 875 delete $self->{_rw};
865 $self->{eof} = 1; 876 $self->{_eof} = 1;
866 $self->_drain_rbuf; 877 $self->_drain_rbuf;
867 878
868 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) { 879 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {
869 return $self->error; 880 return $self->error;
870 } 881 }
873} 884}
874 885
875sub _dotls { 886sub _dotls {
876 my ($self) = @_; 887 my ($self) = @_;
877 888
878 if (length $self->{tls_wbuf}) { 889 if (length $self->{_tls_wbuf}) {
879 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) {
880 substr $self->{tls_wbuf}, 0, $len, ""; 891 substr $self->{_tls_wbuf}, 0, $len, "";
881 } 892 }
882 } 893 }
883 894
884 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) { 895 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
885 $self->{wbuf} .= $buf; 896 $self->{wbuf} .= $buf;
886 $self->_drain_wbuf; 897 $self->_drain_wbuf;
887 } 898 }
888 899
889 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 900 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
914The 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
915C<"connect">, C<"accept"> or an existing Net::SSLeay object). 926C<"connect">, C<"accept"> or an existing Net::SSLeay object).
916 927
917The 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
918used 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.
919 934
920=cut 935=cut
921 936
922# TODO: maybe document... 937# TODO: maybe document...
923sub starttls { 938sub starttls {
942 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 957 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
943 Net::SSLeay::CTX_set_mode ($self->{tls}, 958 Net::SSLeay::CTX_set_mode ($self->{tls},
944 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 959 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
945 | (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));
946 961
947 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 962 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
948 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 963 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
949 964
950 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio}); 965 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
951 966
952 $self->{filter_w} = sub { 967 $self->{filter_w} = sub {
953 $_[0]{tls_wbuf} .= ${$_[1]}; 968 $_[0]{_tls_wbuf} .= ${$_[1]};
954 &_dotls; 969 &_dotls;
955 }; 970 };
956 $self->{filter_r} = sub { 971 $self->{filter_r} = sub {
957 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]}); 972 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
958 &_dotls; 973 &_dotls;
959 }; 974 };
960} 975}
961 976
962=item $handle->stoptls 977=item $handle->stoptls
968 983
969sub stoptls { 984sub stoptls {
970 my ($self) = @_; 985 my ($self) = @_;
971 986
972 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 987 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
988
973 delete $self->{tls_rbio}; 989 delete $self->{_rbio};
974 delete $self->{tls_wbio}; 990 delete $self->{_wbio};
975 delete $self->{tls_wbuf}; 991 delete $self->{_tls_wbuf};
976 delete $self->{filter_r}; 992 delete $self->{filter_r};
977 delete $self->{filter_w}; 993 delete $self->{filter_w};
978} 994}
979 995
980sub DESTROY { 996sub DESTROY {
1018 } 1034 }
1019} 1035}
1020 1036
1021=back 1037=back
1022 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
1023=head1 AUTHOR 1068=head1 AUTHOR
1024 1069
1025Robin 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>.
1026 1071
1027=cut 1072=cut

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines