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.16 by root, Fri May 23 05:16:57 2008 UTC vs.
Revision 1.25 by root, Sat May 24 15:19:43 2008 UTC

… …
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 filehandles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17This module is experimental. 17This module is experimental.
18 18
19=cut 19=cut
20 20
… …
83waiting for data. 83waiting for data.
84 84
85=item on_error => $cb->($self) 85=item on_error => $cb->($self)
86 86
87This is the fatal error callback, that is called when, well, a fatal error 87This is the fatal error callback, that is called when, well, a fatal error
88ocurs, such as not being able to resolve the hostname, failure to connect 88occurs, such as not being able to resolve the hostname, failure to connect
89or a read error. 89or a read error.
90 90
91The object will not be in a usable state when this callback has been 91The object will not be in a usable state when this callback has been
92called. 92called.
93 93
… …
102 102
103This sets the default read callback, which is called when data arrives 103This sets the default read callback, which is called when data arrives
104and no read request is in the queue. 104and no read request is in the queue.
105 105
106To access (and remove data from) the read buffer, use the C<< ->rbuf >> 106To access (and remove data from) the read buffer, use the C<< ->rbuf >>
107method or acces sthe C<$self->{rbuf}> member directly. 107method or access the C<$self->{rbuf}> member directly.
108 108
109When an EOF condition is detected then AnyEvent::Handle will first try to 109When 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 110feed 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 111calling the C<on_eof> callback. If no progress can be made, then a fatal
112error will be raised (with C<$!> set to C<EPIPE>). 112error will be raised (with C<$!> set to C<EPIPE>).
… …
139 139
140Sets the amount of bytes (default: C<0>) that make up an "empty" write 140Sets the amount of bytes (default: C<0>) that make up an "empty" write
141buffer: If the write reaches this size or gets even samller it is 141buffer: If the write reaches this size or gets even samller it is
142considered empty. 142considered empty.
143 143
144=item tls => "accept" | "connect" | Net::SSLeay::SSL object
145
146When this parameter is given, it enables TLS (SSL) mode, that means it
147will start making tls handshake and will transparently encrypt/decrypt
148data.
149
150For the TLS server side, use C<accept>, and for the TLS client side of a
151connection, use C<connect> mode.
152
153You can also provide your own TLS connection object, but you have
154to make sure that you call either C<Net::SSLeay::set_connect_state>
155or C<Net::SSLeay::set_accept_state> on it before you pass it to
156AnyEvent::Handle.
157
158=item tls_ctx => $ssl_ctx
159
160Use the given Net::SSLeay::CTX object to create the new TLS connection
161(unless a connection object was specified directly). If this parameter is
162missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
163
144=back 164=back
145 165
146=cut 166=cut
147 167
148sub new { 168sub new {
… …
151 my $self = bless { @_ }, $class; 171 my $self = bless { @_ }, $class;
152 172
153 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 173 $self->{fh} or Carp::croak "mandatory argument fh is missing";
154 174
155 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 175 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
176
177 if ($self->{tls}) {
178 require Net::SSLeay;
179 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
180 }
156 181
157 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 182 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
158 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 183 $self->on_error (delete $self->{on_error}) if $self->{on_error};
159 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 184 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
160 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 185 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
… …
187 } 212 }
188} 213}
189 214
190=item $fh = $handle->fh 215=item $fh = $handle->fh
191 216
192This method returns the filehandle of the L<AnyEvent::Handle> object. 217This method returns the file handle of the L<AnyEvent::Handle> object.
193 218
194=cut 219=cut
195 220
196sub fh { $_[0]->{fh} } 221sub fh { $_[0]->{fh} }
197 222
… …
225for reading. 250for reading.
226 251
227The write queue is very simple: you can add data to its end, and 252The write queue is very simple: you can add data to its end, and
228AnyEvent::Handle will automatically try to get rid of it for you. 253AnyEvent::Handle will automatically try to get rid of it for you.
229 254
230When data could be writtena nd the write buffer is shorter then the low 255When data could be written and the write buffer is shorter then the low
231water mark, the C<on_drain> callback will be invoked. 256water mark, the C<on_drain> callback will be invoked.
232 257
233=over 4 258=over 4
234 259
235=item $handle->on_drain ($cb) 260=item $handle->on_drain ($cb)
… …
254want (only limited by the available memory), as C<AnyEvent::Handle> 279want (only limited by the available memory), as C<AnyEvent::Handle>
255buffers it independently of the kernel. 280buffers it independently of the kernel.
256 281
257=cut 282=cut
258 283
259sub push_write { 284sub _drain_wbuf {
260 my ($self, $data) = @_; 285 my ($self) = @_;
261
262 $self->{wbuf} .= $data;
263 286
264 unless ($self->{ww}) { 287 unless ($self->{ww}) {
265 Scalar::Util::weaken $self; 288 Scalar::Util::weaken $self;
266 my $cb = sub { 289 my $cb = sub {
267 my $len = syswrite $self->{fh}, $self->{wbuf}; 290 my $len = syswrite $self->{fh}, $self->{wbuf};
268 291
269 if ($len > 0) { 292 if ($len > 0) {
270 substr $self->{wbuf}, 0, $len, ""; 293 substr $self->{wbuf}, 0, $len, "";
271
272 294
273 $self->{on_drain}($self) 295 $self->{on_drain}($self)
274 if $self->{low_water_mark} >= length $self->{wbuf} 296 if $self->{low_water_mark} >= length $self->{wbuf}
275 && $self->{on_drain}; 297 && $self->{on_drain};
276 298
… …
282 304
283 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 305 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
284 306
285 $cb->($self); 307 $cb->($self);
286 }; 308 };
309}
310
311sub push_write {
312 my $self = shift;
313
314 if ($self->{filter_w}) {
315 $self->{filter_w}->($self, \$_[0]);
316 } else {
317 $self->{wbuf} .= $_[0];
318 $self->_drain_wbuf;
319 }
287} 320}
288 321
289############################################################################# 322#############################################################################
290 323
291=back 324=back
… …
366 399
367=cut 400=cut
368 401
369sub _drain_rbuf { 402sub _drain_rbuf {
370 my ($self) = @_; 403 my ($self) = @_;
404
405 if (
406 defined $self->{rbuf_max}
407 && $self->{rbuf_max} < length $self->{rbuf}
408 ) {
409 $! = &Errno::ENOSPC; return $self->error;
410 }
371 411
372 return if $self->{in_drain}; 412 return if $self->{in_drain};
373 local $self->{in_drain} = 1; 413 local $self->{in_drain} = 1;
374 414
375 while (my $len = length $self->{rbuf}) { 415 while (my $len = length $self->{rbuf}) {
… …
448Append the given callback to the end of the queue (C<push_read>) or 488Append the given callback to the end of the queue (C<push_read>) or
449prepend it (C<unshift_read>). 489prepend it (C<unshift_read>).
450 490
451The callback is called each time some additional read data arrives. 491The callback is called each time some additional read data arrives.
452 492
453It must check wether enough data is in the read buffer already. 493It must check whether enough data is in the read buffer already.
454 494
455If not enough data is available, it must return the empty list or a false 495If not enough data is available, it must return the empty list or a false
456value, in which case it will be called repeatedly until enough data is 496value, in which case it will be called repeatedly until enough data is
457available (or an error condition is detected). 497available (or an error condition is detected).
458 498
… …
560 600
561=item $handle->stop_read 601=item $handle->stop_read
562 602
563=item $handle->start_read 603=item $handle->start_read
564 604
565In rare cases you actually do not want to read anything form the 605In rare cases you actually do not want to read anything from the
566socket. In this case you can call C<stop_read>. Neither C<on_read> no 606socket. In this case you can call C<stop_read>. Neither C<on_read> no
567any queued callbacks will be executed then. To start readign again, call 607any queued callbacks will be executed then. To start reading again, call
568C<start_read>. 608C<start_read>.
569 609
570=cut 610=cut
571 611
572sub stop_read { 612sub stop_read {
… …
580 620
581 unless ($self->{rw} || $self->{eof}) { 621 unless ($self->{rw} || $self->{eof}) {
582 Scalar::Util::weaken $self; 622 Scalar::Util::weaken $self;
583 623
584 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 624 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
625 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
585 my $len = sysread $self->{fh}, $self->{rbuf}, $self->{read_size} || 8192, length $self->{rbuf}; 626 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
586 627
587 if ($len > 0) { 628 if ($len > 0) {
588 if (defined $self->{rbuf_max}) { 629 $self->{filter_r}
589 if ($self->{rbuf_max} < length $self->{rbuf}) { 630 ? $self->{filter_r}->($self, $rbuf)
590 $! = &Errno::ENOSPC; return $self->error; 631 : $self->_drain_rbuf;
591 }
592 }
593 632
594 } elsif (defined $len) { 633 } elsif (defined $len) {
634 delete $self->{rw};
595 $self->{eof} = 1; 635 $self->{eof} = 1;
596 delete $self->{rw}; 636 $self->_drain_rbuf;
597 637
598 } elsif ($! != EAGAIN && $! != EINTR) { 638 } elsif ($! != EAGAIN && $! != EINTR) {
599 return $self->error; 639 return $self->error;
600 } 640 }
601
602 $self->_drain_rbuf;
603 }); 641 });
604 } 642 }
605} 643}
606 644
645sub _dotls {
646 my ($self) = @_;
647
648 if (length $self->{tls_wbuf}) {
649 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {
650 substr $self->{tls_wbuf}, 0, $len, "";
651 }
652 }
653
654 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
655 $self->{wbuf} .= $buf;
656 $self->_drain_wbuf;
657 }
658
659 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
660 $self->{rbuf} .= $buf;
661 $self->_drain_rbuf;
662 }
663
664 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
665
666 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
667 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
668 $self->error;
669 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
670 $! = &Errno::EIO;
671 $self->error;
672 }
673
674 # all others are fine for our purposes
675 }
676}
677
678=item $handle->starttls ($tls[, $tls_ctx])
679
680Instead of starting TLS negotiation immediately when the AnyEvent::Handle
681object is created, you can also do that at a later time by calling
682C<starttls>.
683
684The first argument is the same as the C<tls> constructor argument (either
685C<"connect">, C<"accept"> or an existing Net::SSLeay object).
686
687The second argument is the optional C<Net::SSLeay::CTX> object that is
688used when AnyEvent::Handle has to create its own TLS connection object.
689
690=cut
691
692# TODO: maybe document...
693sub starttls {
694 my ($self, $ssl, $ctx) = @_;
695
696 $self->stoptls;
697
698 if ($ssl eq "accept") {
699 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
700 Net::SSLeay::set_accept_state ($ssl);
701 } elsif ($ssl eq "connect") {
702 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
703 Net::SSLeay::set_connect_state ($ssl);
704 }
705
706 $self->{tls} = $ssl;
707
708 # basically, this is deep magic (because SSL_read should have the same issues)
709 # but the openssl maintainers basically said: "trust us, it just works".
710 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
711 # and mismaintained ssleay-module doesn't even offer them).
712 Net::SSLeay::CTX_set_mode ($self->{tls},
713 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
714 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
715
716 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
717 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
718
719 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
720
721 $self->{filter_w} = sub {
722 $_[0]{tls_wbuf} .= ${$_[1]};
723 &_dotls;
724 };
725 $self->{filter_r} = sub {
726 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
727 &_dotls;
728 };
729}
730
731=item $handle->stoptls
732
733Destroys the SSL connection, if any. Partial read or write data will be
734lost.
735
736=cut
737
738sub stoptls {
739 my ($self) = @_;
740
741 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
742 delete $self->{tls_rbio};
743 delete $self->{tls_wbio};
744 delete $self->{tls_wbuf};
745 delete $self->{filter_r};
746 delete $self->{filter_w};
747}
748
749sub DESTROY {
750 my $self = shift;
751
752 $self->stoptls;
753}
754
755=item AnyEvent::Handle::TLS_CTX
756
757This function creates and returns the Net::SSLeay::CTX object used by
758default for TLS mode.
759
760The context is created like this:
761
762 Net::SSLeay::load_error_strings;
763 Net::SSLeay::SSLeay_add_ssl_algorithms;
764 Net::SSLeay::randomize;
765
766 my $CTX = Net::SSLeay::CTX_new;
767
768 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
769
770=cut
771
772our $TLS_CTX;
773
774sub TLS_CTX() {
775 $TLS_CTX || do {
776 require Net::SSLeay;
777
778 Net::SSLeay::load_error_strings ();
779 Net::SSLeay::SSLeay_add_ssl_algorithms ();
780 Net::SSLeay::randomize ();
781
782 $TLS_CTX = Net::SSLeay::CTX_new ();
783
784 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
785
786 $TLS_CTX
787 }
788}
789
607=back 790=back
608 791
609=head1 AUTHOR 792=head1 AUTHOR
610 793
611Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 794Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.

Diff Legend

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