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.19 by root, Sat May 24 05:57:11 2008 UTC

… …
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};
… …
285 310
286sub push_write { 311sub push_write {
287 my $self = shift; 312 my $self = shift;
288 313
289 if ($self->{filter_w}) { 314 if ($self->{filter_w}) {
290 $self->{filter_w}->(\$_[0]); 315 $self->{filter_w}->($self, \$_[0]);
291 } else { 316 } else {
292 $self->{wbuf} .= $_[0]; 317 $self->{wbuf} .= $_[0];
293 $self->_drain_wbuf; 318 $self->_drain_wbuf;
294 } 319 }
295} 320}
… …
575 600
576=item $handle->stop_read 601=item $handle->stop_read
577 602
578=item $handle->start_read 603=item $handle->start_read
579 604
580In 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
581socket. 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
582any queued callbacks will be executed then. To start readign again, call 607any queued callbacks will be executed then. To start readign again, call
583C<start_read>. 608C<start_read>.
584 609
585=cut 610=cut
… …
600 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 625 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
601 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 626 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
602 627
603 if ($len > 0) { 628 if ($len > 0) {
604 $self->{filter_r} 629 $self->{filter_r}
605 ? $self->{filter_r}->($rbuf) 630 ? $self->{filter_r}->($self, $rbuf)
606 : $self->_drain_rbuf; 631 : $self->_drain_rbuf;
607 632
608 } elsif (defined $len) { 633 } elsif (defined $len) {
609 delete $self->{rw}; 634 delete $self->{rw};
610 $self->{eof} = 1; 635 $self->{eof} = 1;
… …
615 } 640 }
616 }); 641 });
617 } 642 }
618} 643}
619 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
620=back 746=back
621 747
622=head1 AUTHOR 748=head1 AUTHOR
623 749
624Robin 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