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.15 by root, Sat May 17 21:34:15 2008 UTC vs.
Revision 1.23 by root, Sat May 24 15:11:22 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
… …
72The filehandle this L<AnyEvent::Handle> object will operate on. 72The filehandle this L<AnyEvent::Handle> object will operate on.
73 73
74NOTE: The filehandle will be set to non-blocking (using 74NOTE: The filehandle will be set to non-blocking (using
75AnyEvent::Util::fh_nonblocking). 75AnyEvent::Util::fh_nonblocking).
76 76
77=item on_eof => $cb->($self) [MANDATORY] 77=item on_eof => $cb->($self)
78 78
79Set the callback to be called on EOF. 79Set the callback to be called on EOF.
80 80
81While not mandatory, it is highly recommended to set an eof callback,
82otherwise you might end up with a closed socket while you are still
83waiting for data.
84
81=item on_error => $cb->($self) 85=item on_error => $cb->($self)
82 86
83This 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
84ocurs, 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
85or a read error. 89or a read error.
86 90
87The 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
88called. 92called.
89 93
… …
98 102
99This sets the default read callback, which is called when data arrives 103This sets the default read callback, which is called when data arrives
100and no read request is in the queue. 104and no read request is in the queue.
101 105
102To 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 >>
103method or acces sthe C<$self->{rbuf}> member directly. 107method or access the C<$self->{rbuf}> member directly.
104 108
105When 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
106feed 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
107calling 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
108error will be raised (with C<$!> set to C<EPIPE>). 112error will be raised (with C<$!> set to C<EPIPE>).
… …
135 139
136Sets 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
137buffer: 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
138considered empty. 142considered empty.
139 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
140=back 164=back
141 165
142=cut 166=cut
143 167
144sub new { 168sub new {
… …
148 172
149 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 173 $self->{fh} or Carp::croak "mandatory argument fh is missing";
150 174
151 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 175 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
152 176
153 $self->on_eof ((delete $self->{on_eof} ) or Carp::croak "mandatory argument on_eof is missing"); 177 if ($self->{tls}) {
178 require Net::SSLeay;
179 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
180 }
154 181
182 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
155 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 183 $self->on_error (delete $self->{on_error}) if $self->{on_error};
156 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 184 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
157 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 185 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
158 186
159 $self->start_read; 187 $self->start_read;
… …
184 } 212 }
185} 213}
186 214
187=item $fh = $handle->fh 215=item $fh = $handle->fh
188 216
189This method returns the filehandle of the L<AnyEvent::Handle> object. 217This method returns the file handle of the L<AnyEvent::Handle> object.
190 218
191=cut 219=cut
192 220
193sub fh { $_[0]->{fh} } 221sub fh { $_[0]->{fh} }
194 222
… …
222for reading. 250for reading.
223 251
224The 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
225AnyEvent::Handle will automatically try to get rid of it for you. 253AnyEvent::Handle will automatically try to get rid of it for you.
226 254
227When 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
228water mark, the C<on_drain> callback will be invoked. 256water mark, the C<on_drain> callback will be invoked.
229 257
230=over 4 258=over 4
231 259
232=item $handle->on_drain ($cb) 260=item $handle->on_drain ($cb)
… …
251want (only limited by the available memory), as C<AnyEvent::Handle> 279want (only limited by the available memory), as C<AnyEvent::Handle>
252buffers it independently of the kernel. 280buffers it independently of the kernel.
253 281
254=cut 282=cut
255 283
256sub push_write { 284sub _drain_wbuf {
257 my ($self, $data) = @_; 285 my ($self) = @_;
258
259 $self->{wbuf} .= $data;
260 286
261 unless ($self->{ww}) { 287 unless ($self->{ww}) {
262 Scalar::Util::weaken $self; 288 Scalar::Util::weaken $self;
263 my $cb = sub { 289 my $cb = sub {
264 my $len = syswrite $self->{fh}, $self->{wbuf}; 290 my $len = syswrite $self->{fh}, $self->{wbuf};
265 291
266 if ($len > 0) { 292 if ($len > 0) {
267 substr $self->{wbuf}, 0, $len, ""; 293 substr $self->{wbuf}, 0, $len, "";
268
269 294
270 $self->{on_drain}($self) 295 $self->{on_drain}($self)
271 if $self->{low_water_mark} >= length $self->{wbuf} 296 if $self->{low_water_mark} >= length $self->{wbuf}
272 && $self->{on_drain}; 297 && $self->{on_drain};
273 298
… …
279 304
280 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 305 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
281 306
282 $cb->($self); 307 $cb->($self);
283 }; 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 }
284} 320}
285 321
286############################################################################# 322#############################################################################
287 323
288=back 324=back
… …
363 399
364=cut 400=cut
365 401
366sub _drain_rbuf { 402sub _drain_rbuf {
367 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 }
368 411
369 return if $self->{in_drain}; 412 return if $self->{in_drain};
370 local $self->{in_drain} = 1; 413 local $self->{in_drain} = 1;
371 414
372 while (my $len = length $self->{rbuf}) { 415 while (my $len = length $self->{rbuf}) {
… …
400 } 443 }
401 } 444 }
402 445
403 if ($self->{eof}) { 446 if ($self->{eof}) {
404 $self->_shutdown; 447 $self->_shutdown;
405 $self->{on_eof}($self); 448 $self->{on_eof}($self)
449 if $self->{on_eof};
406 } 450 }
407} 451}
408 452
409=item $handle->on_read ($cb) 453=item $handle->on_read ($cb)
410 454
… …
444Append 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
445prepend it (C<unshift_read>). 489prepend it (C<unshift_read>).
446 490
447The callback is called each time some additional read data arrives. 491The callback is called each time some additional read data arrives.
448 492
449It must check wether enough data is in the read buffer already. 493It must check whether enough data is in the read buffer already.
450 494
451If 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
452value, 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
453available (or an error condition is detected). 497available (or an error condition is detected).
454 498
… …
556 600
557=item $handle->stop_read 601=item $handle->stop_read
558 602
559=item $handle->start_read 603=item $handle->start_read
560 604
561In 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
562socket. 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
563any queued callbacks will be executed then. To start readign again, call 607any queued callbacks will be executed then. To start reading again, call
564C<start_read>. 608C<start_read>.
565 609
566=cut 610=cut
567 611
568sub stop_read { 612sub stop_read {
… …
576 620
577 unless ($self->{rw} || $self->{eof}) { 621 unless ($self->{rw} || $self->{eof}) {
578 Scalar::Util::weaken $self; 622 Scalar::Util::weaken $self;
579 623
580 $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};
581 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;
582 627
583 if ($len > 0) { 628 if ($len > 0) {
584 if (defined $self->{rbuf_max}) { 629 $self->{filter_r}
585 if ($self->{rbuf_max} < length $self->{rbuf}) { 630 ? $self->{filter_r}->($self, $rbuf)
586 $! = &Errno::ENOSPC; return $self->error; 631 : $self->_drain_rbuf;
587 }
588 }
589 632
590 } elsif (defined $len) { 633 } elsif (defined $len) {
634 delete $self->{rw};
591 $self->{eof} = 1; 635 $self->{eof} = 1;
592 delete $self->{rw}; 636 $self->_drain_rbuf;
593 637
594 } elsif ($! != EAGAIN && $! != EINTR) { 638 } elsif ($! != EAGAIN && $! != EINTR) {
595 return $self->error; 639 return $self->error;
596 } 640 }
597
598 $self->_drain_rbuf;
599 }); 641 });
600 } 642 }
601} 643}
602 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 if (
665 (my $err = Net::SSLeay::get_error ($self->{tls}, -1))
666 != Net::SSLeay::ERROR_WANT_READ ()
667 ) {
668 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
669 $self->error;
670 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
671 $! = &Errno::EIO;
672 $self->error;
673 }
674
675 # all others are fine for our purposes
676 }
677}
678
679# TODO: maybe document...
680sub starttls {
681 my ($self, $ssl, $ctx) = @_;
682
683 if ($ssl eq "accept") {
684 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
685 Net::SSLeay::set_accept_state ($ssl);
686 } elsif ($ssl eq "connect") {
687 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
688 Net::SSLeay::set_connect_state ($ssl);
689 }
690
691 $self->{tls} = $ssl;
692
693 # basically, this is deep magic (because SSL_read should have the same issues)
694 # but the openssl maintainers basically said: "trust us, it just works".
695 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
696 # and mismaintained ssleay-module doesn't even offer them).
697 Net::SSLeay::CTX_set_mode ($self->{tls},
698 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
699 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
700
701 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
702 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
703
704 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
705
706 $self->{filter_w} = sub {
707 $_[0]{tls_wbuf} .= ${$_[1]};
708 &_dotls;
709 };
710 $self->{filter_r} = sub {
711 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
712 &_dotls;
713 };
714}
715
716sub DESTROY {
717 my $self = shift;
718
719 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
720}
721
722=item AnyEvent::Handle::TLS_CTX
723
724This function creates and returns the Net::SSLeay::CTX object used by
725default for TLS mode.
726
727The context is created like this:
728
729 Net::SSLeay::load_error_strings;
730 Net::SSLeay::SSLeay_add_ssl_algorithms;
731 Net::SSLeay::randomize;
732
733 my $CTX = Net::SSLeay::CTX_new;
734
735 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
736
737=cut
738
739our $TLS_CTX;
740
741sub TLS_CTX() {
742 $TLS_CTX || do {
743 require Net::SSLeay;
744
745 Net::SSLeay::load_error_strings ();
746 Net::SSLeay::SSLeay_add_ssl_algorithms ();
747 Net::SSLeay::randomize ();
748
749 $TLS_CTX = Net::SSLeay::CTX_new ();
750
751 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
752
753 $TLS_CTX
754 }
755}
756
603=back 757=back
604 758
605=head1 AUTHOR 759=head1 AUTHOR
606 760
607Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 761Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.

Diff Legend

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