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.18 by root, Sat May 24 05:01:16 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};
… …
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