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.17 by root, Sat May 24 04:17:45 2008 UTC vs.
Revision 1.27 by root, Sat May 24 15:26:04 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
150TLS mode requires Net::SSLeay to be installed (it will be loaded
151automatically when you try to create a TLS handle).
152
153For the TLS server side, use C<accept>, and for the TLS client side of a
154connection, use C<connect> mode.
155
156You can also provide your own TLS connection object, but you have
157to make sure that you call either C<Net::SSLeay::set_connect_state>
158or C<Net::SSLeay::set_accept_state> on it before you pass it to
159AnyEvent::Handle.
160
161See the C<starttls> method if you need to start TLs negotiation later.
162
163=item tls_ctx => $ssl_ctx
164
165Use the given Net::SSLeay::CTX object to create the new TLS connection
166(unless a connection object was specified directly). If this parameter is
167missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
168
144=back 169=back
145 170
146=cut 171=cut
147 172
148sub new { 173sub new {
… …
151 my $self = bless { @_ }, $class; 176 my $self = bless { @_ }, $class;
152 177
153 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 178 $self->{fh} or Carp::croak "mandatory argument fh is missing";
154 179
155 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 180 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
181
182 if ($self->{tls}) {
183 require Net::SSLeay;
184 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
185 }
156 186
157 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 187 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
158 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 188 $self->on_error (delete $self->{on_error}) if $self->{on_error};
159 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 189 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
160 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 190 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
… …
187 } 217 }
188} 218}
189 219
190=item $fh = $handle->fh 220=item $fh = $handle->fh
191 221
192This method returns the filehandle of the L<AnyEvent::Handle> object. 222This method returns the file handle of the L<AnyEvent::Handle> object.
193 223
194=cut 224=cut
195 225
196sub fh { $_[0]->{fh} } 226sub fh { $_[0]->{fh} }
197 227
… …
225for reading. 255for reading.
226 256
227The write queue is very simple: you can add data to its end, and 257The 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. 258AnyEvent::Handle will automatically try to get rid of it for you.
229 259
230When data could be writtena nd the write buffer is shorter then the low 260When data could be written and the write buffer is shorter then the low
231water mark, the C<on_drain> callback will be invoked. 261water mark, the C<on_drain> callback will be invoked.
232 262
233=over 4 263=over 4
234 264
235=item $handle->on_drain ($cb) 265=item $handle->on_drain ($cb)
… …
285 315
286sub push_write { 316sub push_write {
287 my $self = shift; 317 my $self = shift;
288 318
289 if ($self->{filter_w}) { 319 if ($self->{filter_w}) {
290 $self->{filter_w}->(\$_[0]); 320 $self->{filter_w}->($self, \$_[0]);
291 } else { 321 } else {
292 $self->{wbuf} .= $_[0]; 322 $self->{wbuf} .= $_[0];
293 $self->_drain_wbuf; 323 $self->_drain_wbuf;
294 } 324 }
295} 325}
… …
463Append the given callback to the end of the queue (C<push_read>) or 493Append the given callback to the end of the queue (C<push_read>) or
464prepend it (C<unshift_read>). 494prepend it (C<unshift_read>).
465 495
466The callback is called each time some additional read data arrives. 496The callback is called each time some additional read data arrives.
467 497
468It must check wether enough data is in the read buffer already. 498It must check whether enough data is in the read buffer already.
469 499
470If not enough data is available, it must return the empty list or a false 500If not enough data is available, it must return the empty list or a false
471value, in which case it will be called repeatedly until enough data is 501value, in which case it will be called repeatedly until enough data is
472available (or an error condition is detected). 502available (or an error condition is detected).
473 503
… …
575 605
576=item $handle->stop_read 606=item $handle->stop_read
577 607
578=item $handle->start_read 608=item $handle->start_read
579 609
580In rare cases you actually do not want to read anything form the 610In rare cases you actually do not want to read anything from the
581socket. In this case you can call C<stop_read>. Neither C<on_read> no 611socket. In this case you can call C<stop_read>. Neither C<on_read> no
582any queued callbacks will be executed then. To start readign again, call 612any queued callbacks will be executed then. To start reading again, call
583C<start_read>. 613C<start_read>.
584 614
585=cut 615=cut
586 616
587sub stop_read { 617sub stop_read {
… …
600 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 630 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
601 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 631 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
602 632
603 if ($len > 0) { 633 if ($len > 0) {
604 $self->{filter_r} 634 $self->{filter_r}
605 ? $self->{filter_r}->($rbuf) 635 ? $self->{filter_r}->($self, $rbuf)
606 : $self->_drain_rbuf; 636 : $self->_drain_rbuf;
607 637
608 } elsif (defined $len) { 638 } elsif (defined $len) {
609 delete $self->{rw}; 639 delete $self->{rw};
610 $self->{eof} = 1; 640 $self->{eof} = 1;
… …
615 } 645 }
616 }); 646 });
617 } 647 }
618} 648}
619 649
650sub _dotls {
651 my ($self) = @_;
652
653 if (length $self->{tls_wbuf}) {
654 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {
655 substr $self->{tls_wbuf}, 0, $len, "";
656 }
657 }
658
659 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
660 $self->{wbuf} .= $buf;
661 $self->_drain_wbuf;
662 }
663
664 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
665 $self->{rbuf} .= $buf;
666 $self->_drain_rbuf;
667 }
668
669 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
670
671 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
672 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
673 $self->error;
674 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
675 $! = &Errno::EIO;
676 $self->error;
677 }
678
679 # all others are fine for our purposes
680 }
681}
682
683=item $handle->starttls ($tls[, $tls_ctx])
684
685Instead of starting TLS negotiation immediately when the AnyEvent::Handle
686object is created, you can also do that at a later time by calling
687C<starttls>.
688
689The first argument is the same as the C<tls> constructor argument (either
690C<"connect">, C<"accept"> or an existing Net::SSLeay object).
691
692The second argument is the optional C<Net::SSLeay::CTX> object that is
693used when AnyEvent::Handle has to create its own TLS connection object.
694
695=cut
696
697# TODO: maybe document...
698sub starttls {
699 my ($self, $ssl, $ctx) = @_;
700
701 $self->stoptls;
702
703 if ($ssl eq "accept") {
704 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
705 Net::SSLeay::set_accept_state ($ssl);
706 } elsif ($ssl eq "connect") {
707 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
708 Net::SSLeay::set_connect_state ($ssl);
709 }
710
711 $self->{tls} = $ssl;
712
713 # basically, this is deep magic (because SSL_read should have the same issues)
714 # but the openssl maintainers basically said: "trust us, it just works".
715 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
716 # and mismaintained ssleay-module doesn't even offer them).
717 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
718 Net::SSLeay::CTX_set_mode ($self->{tls},
719 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
720 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
721
722 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
723 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
724
725 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
726
727 $self->{filter_w} = sub {
728 $_[0]{tls_wbuf} .= ${$_[1]};
729 &_dotls;
730 };
731 $self->{filter_r} = sub {
732 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
733 &_dotls;
734 };
735}
736
737=item $handle->stoptls
738
739Destroys the SSL connection, if any. Partial read or write data will be
740lost.
741
742=cut
743
744sub stoptls {
745 my ($self) = @_;
746
747 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
748 delete $self->{tls_rbio};
749 delete $self->{tls_wbio};
750 delete $self->{tls_wbuf};
751 delete $self->{filter_r};
752 delete $self->{filter_w};
753}
754
755sub DESTROY {
756 my $self = shift;
757
758 $self->stoptls;
759}
760
761=item AnyEvent::Handle::TLS_CTX
762
763This function creates and returns the Net::SSLeay::CTX object used by
764default for TLS mode.
765
766The context is created like this:
767
768 Net::SSLeay::load_error_strings;
769 Net::SSLeay::SSLeay_add_ssl_algorithms;
770 Net::SSLeay::randomize;
771
772 my $CTX = Net::SSLeay::CTX_new;
773
774 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
775
776=cut
777
778our $TLS_CTX;
779
780sub TLS_CTX() {
781 $TLS_CTX || do {
782 require Net::SSLeay;
783
784 Net::SSLeay::load_error_strings ();
785 Net::SSLeay::SSLeay_add_ssl_algorithms ();
786 Net::SSLeay::randomize ();
787
788 $TLS_CTX = Net::SSLeay::CTX_new ();
789
790 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
791
792 $TLS_CTX
793 }
794}
795
620=back 796=back
621 797
622=head1 AUTHOR 798=head1 AUTHOR
623 799
624Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 800Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.

Diff Legend

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