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.11 by root, Sun May 11 17:54:13 2008 UTC vs.
Revision 1.19 by root, Sat May 24 05:57:11 2008 UTC

… …
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 filehandles via AnyEvent
16 16
17=cut 17This module is experimental.
18 18
19=cut
20
19our $VERSION = '0.02'; 21our $VERSION = '0.04';
20 22
21=head1 SYNOPSIS 23=head1 SYNOPSIS
22 24
23 use AnyEvent; 25 use AnyEvent;
24 use AnyEvent::Handle; 26 use AnyEvent::Handle;
… …
43 $cv->wait; 45 $cv->wait;
44 46
45=head1 DESCRIPTION 47=head1 DESCRIPTION
46 48
47This module is a helper module to make it easier to do event-based I/O on 49This module is a helper module to make it easier to do event-based I/O on
48filehandles (and sockets, see L<AnyEvent::Socket> for an easy way to make 50filehandles. For utility functions for doing non-blocking connects and accepts
49non-blocking resolves and connects). 51on sockets see L<AnyEvent::Util>.
50 52
51In the following, when the documentation refers to of "bytes" then this 53In the following, when the documentation refers to of "bytes" then this
52means characters. As sysread and syswrite are used for all I/O, their 54means characters. As sysread and syswrite are used for all I/O, their
53treatment of characters applies to this module as well. 55treatment of characters applies to this module as well.
54 56
… …
70The filehandle this L<AnyEvent::Handle> object will operate on. 72The filehandle this L<AnyEvent::Handle> object will operate on.
71 73
72NOTE: The filehandle will be set to non-blocking (using 74NOTE: The filehandle will be set to non-blocking (using
73AnyEvent::Util::fh_nonblocking). 75AnyEvent::Util::fh_nonblocking).
74 76
75=item on_eof => $cb->($self) [MANDATORY] 77=item on_eof => $cb->($self)
76 78
77Set the callback to be called on EOF. 79Set the callback to be called on EOF.
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.
78 84
79=item on_error => $cb->($self) 85=item on_error => $cb->($self)
80 86
81This 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
82ocurs, such as not being able to resolve the hostname, failure to connect 88ocurs, such as not being able to resolve the hostname, failure to connect
… …
133 139
134Sets 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
135buffer: 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
136considered empty. 142considered empty.
137 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
138=back 164=back
139 165
140=cut 166=cut
141 167
142sub new { 168sub new {
… …
146 172
147 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 173 $self->{fh} or Carp::croak "mandatory argument fh is missing";
148 174
149 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 175 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
150 176
151 $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 }
152 181
182 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
153 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 183 $self->on_error (delete $self->{on_error}) if $self->{on_error};
154 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 184 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
155 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 185 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
156 186
157 $self->start_read; 187 $self->start_read;
… …
249want (only limited by the available memory), as C<AnyEvent::Handle> 279want (only limited by the available memory), as C<AnyEvent::Handle>
250buffers it independently of the kernel. 280buffers it independently of the kernel.
251 281
252=cut 282=cut
253 283
254sub push_write { 284sub _drain_wbuf {
255 my ($self, $data) = @_; 285 my ($self) = @_;
256
257 $self->{wbuf} .= $data;
258 286
259 unless ($self->{ww}) { 287 unless ($self->{ww}) {
260 Scalar::Util::weaken $self; 288 Scalar::Util::weaken $self;
261 my $cb = sub { 289 my $cb = sub {
262 my $len = syswrite $self->{fh}, $self->{wbuf}; 290 my $len = syswrite $self->{fh}, $self->{wbuf};
263 291
264 if ($len > 0) { 292 if ($len > 0) {
265 substr $self->{wbuf}, 0, $len, ""; 293 substr $self->{wbuf}, 0, $len, "";
266
267 294
268 $self->{on_drain}($self) 295 $self->{on_drain}($self)
269 if $self->{low_water_mark} >= length $self->{wbuf} 296 if $self->{low_water_mark} >= length $self->{wbuf}
270 && $self->{on_drain}; 297 && $self->{on_drain};
271 298
… …
277 304
278 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 305 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
279 306
280 $cb->($self); 307 $cb->($self);
281 }; 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 }
282} 320}
283 321
284############################################################################# 322#############################################################################
285 323
286=back 324=back
… …
361 399
362=cut 400=cut
363 401
364sub _drain_rbuf { 402sub _drain_rbuf {
365 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 }
366 411
367 return if $self->{in_drain}; 412 return if $self->{in_drain};
368 local $self->{in_drain} = 1; 413 local $self->{in_drain} = 1;
369 414
370 while (my $len = length $self->{rbuf}) { 415 while (my $len = length $self->{rbuf}) {
… …
398 } 443 }
399 } 444 }
400 445
401 if ($self->{eof}) { 446 if ($self->{eof}) {
402 $self->_shutdown; 447 $self->_shutdown;
403 $self->{on_eof}($self); 448 $self->{on_eof}($self)
449 if $self->{on_eof};
404 } 450 }
405} 451}
406 452
407=item $handle->on_read ($cb) 453=item $handle->on_read ($cb)
408 454
… …
485sub _read_chunk($$) { 531sub _read_chunk($$) {
486 my ($self, $len, $cb) = @_; 532 my ($self, $len, $cb) = @_;
487 533
488 sub { 534 sub {
489 $len <= length $_[0]{rbuf} or return; 535 $len <= length $_[0]{rbuf} or return;
490 $cb->($self, $_[0], substr $_[0]{rbuf}, 0, $len, ""); 536 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
491 1 537 1
492 } 538 }
493} 539}
494 540
495sub push_read_chunk { 541sub push_read_chunk {
… …
531 my $self = shift; 577 my $self = shift;
532 my $cb = pop; 578 my $cb = pop;
533 my $eol = @_ ? shift : qr|(\015?\012)|; 579 my $eol = @_ ? shift : qr|(\015?\012)|;
534 my $pos; 580 my $pos;
535 581
536 $eol = qr|(\Q$eol\E)| unless ref $eol; 582 $eol = quotemeta $eol unless ref $eol;
537 $eol = qr|^(.*?)($eol)|; 583 $eol = qr|^(.*?)($eol)|s;
538 584
539 sub { 585 sub {
540 $_[0]{rbuf} =~ s/$eol// or return; 586 $_[0]{rbuf} =~ s/$eol// or return;
541 587
542 $cb->($self, $1, $2); 588 $cb->($_[0], $1, $2);
543 1 589 1
544 } 590 }
545} 591}
546 592
547sub push_read_line { 593sub push_read_line {
… …
554 600
555=item $handle->stop_read 601=item $handle->stop_read
556 602
557=item $handle->start_read 603=item $handle->start_read
558 604
559In 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
560socket. 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
561any queued callbacks will be executed then. To start readign again, call 607any queued callbacks will be executed then. To start readign again, call
562C<start_read>. 608C<start_read>.
563 609
564=cut 610=cut
… …
574 620
575 unless ($self->{rw} || $self->{eof}) { 621 unless ($self->{rw} || $self->{eof}) {
576 Scalar::Util::weaken $self; 622 Scalar::Util::weaken $self;
577 623
578 $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};
579 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;
580 627
581 if ($len > 0) { 628 if ($len > 0) {
582 if (defined $self->{rbuf_max}) { 629 $self->{filter_r}
583 if ($self->{rbuf_max} < length $self->{rbuf}) { 630 ? $self->{filter_r}->($self, $rbuf)
584 $! = &Errno::ENOSPC; return $self->error; 631 : $self->_drain_rbuf;
585 }
586 }
587 632
588 } elsif (defined $len) { 633 } elsif (defined $len) {
634 delete $self->{rw};
589 $self->{eof} = 1; 635 $self->{eof} = 1;
590 delete $self->{rw}; 636 $self->_drain_rbuf;
591 637
592 } elsif ($! != EAGAIN && $! != EINTR) { 638 } elsif ($! != EAGAIN && $! != EINTR) {
593 return $self->error; 639 return $self->error;
594 } 640 }
595
596 $self->_drain_rbuf;
597 }); 641 });
598 } 642 }
599} 643}
600 644
645sub _dotls {
646 my ($self) = @_;
647
648 if (length $self->{tls_wbuf}) {
649 my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf});
650 substr $self->{tls_wbuf}, 0, $len, "" if $len > 0;
651 }
652
653 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
654 $self->{wbuf} .= $buf;
655 $self->_drain_wbuf;
656 }
657
658 if (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
659 $self->{rbuf} .= $buf;
660 $self->_drain_rbuf;
661 } elsif (
662 (my $err = Net::SSLeay::get_error ($self->{tls}, -1))
663 != Net::SSLeay::ERROR_WANT_READ ()
664 ) {
665 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
666 $self->error;
667 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
668 $! = &Errno::EIO;
669 $self->error;
670 }
671
672 # all others are fine for our purposes
673 }
674}
675
676# TODO: maybe document...
677sub starttls {
678 my ($self, $ssl, $ctx) = @_;
679
680 if ($ssl eq "accept") {
681 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
682 Net::SSLeay::set_accept_state ($ssl);
683 } elsif ($ssl eq "connect") {
684 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
685 Net::SSLeay::set_connect_state ($ssl);
686 }
687
688 $self->{tls} = $ssl;
689
690 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
691 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
692
693 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
694
695 $self->{filter_w} = sub {
696 $_[0]{tls_wbuf} .= ${$_[1]};
697 &_dotls;
698 };
699 $self->{filter_r} = sub {
700 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
701 &_dotls;
702 };
703}
704
705sub DESTROY {
706 my $self = shift;
707
708 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
709}
710
711=item AnyEvent::Handle::TLS_CTX
712
713This function creates and returns the Net::SSLeay::CTX object used by
714default for TLS mode.
715
716The context is created like this:
717
718 Net::SSLeay::load_error_strings;
719 Net::SSLeay::SSLeay_add_ssl_algorithms;
720 Net::SSLeay::randomize;
721
722 my $CTX = Net::SSLeay::CTX_new;
723
724 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
725
726=cut
727
728our $TLS_CTX;
729
730sub TLS_CTX() {
731 $TLS_CTX || do {
732 require Net::SSLeay;
733
734 Net::SSLeay::load_error_strings ();
735 Net::SSLeay::SSLeay_add_ssl_algorithms ();
736 Net::SSLeay::randomize ();
737
738 $TLS_CTX = Net::SSLeay::CTX_new ();
739
740 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
741
742 $TLS_CTX
743 }
744}
745
601=back 746=back
602 747
603=head1 AUTHOR 748=head1 AUTHOR
604 749
605Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 750Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.

Diff Legend

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