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.159 by root, Fri Jul 24 12:35:58 2009 UTC vs.
Revision 1.169 by root, Fri Jul 31 07:57:43 2009 UTC

… …
11 11
12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
13 13
14=cut 14=cut
15 15
16our $VERSION = 4.86; 16our $VERSION = 4.881;
17 17
18=head1 SYNOPSIS 18=head1 SYNOPSIS
19 19
20 use AnyEvent; 20 use AnyEvent;
21 use AnyEvent::Handle; 21 use AnyEvent::Handle;
… …
84C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the 84C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the
85default C<peername>. 85default C<peername>.
86 86
87You have to specify either this parameter, or C<fh>, above. 87You have to specify either this parameter, or C<fh>, above.
88 88
89It is possible to push requests on the read and write queues, and modify
90properties of the stream, even while AnyEvent::Handle is connecting.
91
89When this parameter is specified, then the C<on_prepare>, 92When this parameter is specified, then the C<on_prepare>,
90C<on_connect_error> and C<on_connect> callbacks will be called under the 93C<on_connect_error> and C<on_connect> callbacks will be called under the
91appropriate circumstances: 94appropriate circumstances:
92 95
93=over 4 96=over 4
… …
97This (rarely used) callback is called before a new connection is 100This (rarely used) callback is called before a new connection is
98attempted, but after the file handle has been created. It could be used to 101attempted, but after the file handle has been created. It could be used to
99prepare the file handle with parameters required for the actual connect 102prepare the file handle with parameters required for the actual connect
100(as opposed to settings that can be changed when the connection is already 103(as opposed to settings that can be changed when the connection is already
101established). 104established).
105
106The return value of this callback should be the connect timeout value in
107seconds (or C<0>, or C<undef>, or the empty list, to indicate the default
108timeout is to be used).
102 109
103=item on_connect => $cb->($handle, $host, $port, $retry->()) 110=item on_connect => $cb->($handle, $host, $port, $retry->())
104 111
105This callback is called when a connection has been successfully established. 112This callback is called when a connection has been successfully established.
106 113
… …
441 } else { 448 } else {
442 if ($self->{on_connect_error}) { 449 if ($self->{on_connect_error}) {
443 $self->{on_connect_error}($self, "$!"); 450 $self->{on_connect_error}($self, "$!");
444 $self->destroy; 451 $self->destroy;
445 } else { 452 } else {
446 $self->fatal ($!, 1); 453 $self->_error ($!, 1);
447 } 454 }
448 } 455 }
449 }, 456 },
450 sub { 457 sub {
451 local $self->{fh} = $_[0]; 458 local $self->{fh} = $_[0];
452 459
460 $self->{on_prepare}
453 $self->{on_prepare}->($self) 461 ? $self->{on_prepare}->($self)
454 if $self->{on_prepare}; 462 : ()
455 } 463 }
456 ); 464 );
457 } 465 }
458 466
459 } else { 467 } else {
… …
478 486
479 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 487 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
480 488
481 $self->start_read 489 $self->start_read
482 if $self->{on_read} || @{ $self->{_queue} }; 490 if $self->{on_read} || @{ $self->{_queue} };
491
492 $self->_drain_wbuf;
483} 493}
484 494
485#sub _shutdown { 495#sub _shutdown {
486# my ($self) = @_; 496# my ($self) = @_;
487# 497#
… …
592 602
593sub on_starttls { 603sub on_starttls {
594 $_[0]{on_stoptls} = $_[1]; 604 $_[0]{on_stoptls} = $_[1];
595} 605}
596 606
607=item $handle->rbuf_max ($max_octets)
608
609Configures the C<rbuf_max> setting (C<undef> disables it).
610
611=cut
612
613sub rbuf_max {
614 $_[0]{rbuf_max} = $_[1];
615}
616
597############################################################################# 617#############################################################################
598 618
599=item $handle->timeout ($seconds) 619=item $handle->timeout ($seconds)
600 620
601Configures (or disables) the inactivity timeout. 621Configures (or disables) the inactivity timeout.
… …
740 ->($self, @_); 760 ->($self, @_);
741 } 761 }
742 762
743 if ($self->{tls}) { 763 if ($self->{tls}) {
744 $self->{_tls_wbuf} .= $_[0]; 764 $self->{_tls_wbuf} .= $_[0];
745 765 &_dotls ($self) if $self->{fh};
746 &_dotls ($self);
747 } else { 766 } else {
748 $self->{wbuf} .= $_[0]; 767 $self->{wbuf} .= $_[0];
749 $self->_drain_wbuf if $self->{fh}; 768 $self->_drain_wbuf if $self->{fh};
750 } 769 }
751} 770}
752 771
753=item $handle->push_write (type => @args) 772=item $handle->push_write (type => @args)
… …
972 991
973sub _drain_rbuf { 992sub _drain_rbuf {
974 my ($self) = @_; 993 my ($self) = @_;
975 994
976 # avoid recursion 995 # avoid recursion
977 return if exists $self->{_skip_drain_rbuf}; 996 return if $self->{_skip_drain_rbuf};
978 local $self->{_skip_drain_rbuf} = 1; 997 local $self->{_skip_drain_rbuf} = 1;
979
980 if (
981 defined $self->{rbuf_max}
982 && $self->{rbuf_max} < length $self->{rbuf}
983 ) {
984 $self->_error (Errno::ENOSPC, 1), return;
985 }
986 998
987 while () { 999 while () {
988 # we need to use a separate tls read buffer, as we must not receive data while 1000 # we need to use a separate tls read buffer, as we must not receive data while
989 # we are draining the buffer, and this can only happen with TLS. 1001 # we are draining the buffer, and this can only happen with TLS.
990 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf}; 1002 $self->{rbuf} .= delete $self->{_tls_rbuf}
1003 if exists $self->{_tls_rbuf};
991 1004
992 my $len = length $self->{rbuf}; 1005 my $len = length $self->{rbuf};
993 1006
994 if (my $cb = shift @{ $self->{_queue} }) { 1007 if (my $cb = shift @{ $self->{_queue} }) {
995 unless ($cb->($self)) { 1008 unless ($cb->($self)) {
996 if ($self->{_eof}) { 1009 # no progress can be made
997 # no progress can be made (not enough data and no data forthcoming) 1010 # (not enough data and no data forthcoming)
998 $self->_error (Errno::EPIPE, 1), return; 1011 $self->_error (Errno::EPIPE, 1), return
999 } 1012 if $self->{_eof};
1000 1013
1001 unshift @{ $self->{_queue} }, $cb; 1014 unshift @{ $self->{_queue} }, $cb;
1002 last; 1015 last;
1003 } 1016 }
1004 } elsif ($self->{on_read}) { 1017 } elsif ($self->{on_read}) {
… …
1024 last; 1037 last;
1025 } 1038 }
1026 } 1039 }
1027 1040
1028 if ($self->{_eof}) { 1041 if ($self->{_eof}) {
1029 if ($self->{on_eof}) { 1042 $self->{on_eof}
1030 $self->{on_eof}($self) 1043 ? $self->{on_eof}($self)
1031 } else {
1032 $self->_error (0, 1, "Unexpected end-of-file"); 1044 : $self->_error (0, 1, "Unexpected end-of-file");
1033 } 1045
1046 return;
1047 }
1048
1049 if (
1050 defined $self->{rbuf_max}
1051 && $self->{rbuf_max} < length $self->{rbuf}
1052 ) {
1053 $self->_error (Errno::ENOSPC, 1), return;
1034 } 1054 }
1035 1055
1036 # may need to restart read watcher 1056 # may need to restart read watcher
1037 unless ($self->{_rw}) { 1057 unless ($self->{_rw}) {
1038 $self->start_read 1058 $self->start_read
… …
1649The TLS connection object will end up in C<< $handle->{tls} >>, the TLS 1669The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1650context in C<< $handle->{tls_ctx} >> after this call and can be used or 1670context in C<< $handle->{tls_ctx} >> after this call and can be used or
1651changed to your liking. Note that the handshake might have already started 1671changed to your liking. Note that the handshake might have already started
1652when this function returns. 1672when this function returns.
1653 1673
1654If it an error to start a TLS handshake more than once per 1674Due to bugs in OpenSSL, it might or might not be possible to do multiple
1655AnyEvent::Handle object (this is due to bugs in OpenSSL). 1675handshakes on the same stream. Best do not attempt to use the stream after
1676stopping TLS.
1656 1677
1657=cut 1678=cut
1658 1679
1659our %TLS_CACHE; #TODO not yet documented, should we? 1680our %TLS_CACHE; #TODO not yet documented, should we?
1660 1681
1661sub starttls { 1682sub starttls {
1662 my ($self, $ssl, $ctx) = @_; 1683 my ($self, $tls, $ctx) = @_;
1684
1685 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
1686 if $self->{tls};
1687
1688 $self->{tls} = $tls;
1689 $self->{tls_ctx} = $ctx if @_ > 2;
1690
1691 return unless $self->{fh};
1663 1692
1664 require Net::SSLeay; 1693 require Net::SSLeay;
1665
1666 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1667 if $self->{tls};
1668 1694
1669 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1695 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1670 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1696 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1671 1697
1698 $tls = $self->{tls};
1672 $ctx ||= $self->{tls_ctx}; 1699 $ctx = $self->{tls_ctx};
1673 1700
1674 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 1701 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1675 1702
1676 if ("HASH" eq ref $ctx) { 1703 if ("HASH" eq ref $ctx) {
1677 require AnyEvent::TLS; 1704 require AnyEvent::TLS;
… …
1683 $ctx = new AnyEvent::TLS %$ctx; 1710 $ctx = new AnyEvent::TLS %$ctx;
1684 } 1711 }
1685 } 1712 }
1686 1713
1687 $self->{tls_ctx} = $ctx || TLS_CTX (); 1714 $self->{tls_ctx} = $ctx || TLS_CTX ();
1688 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername}); 1715 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
1689 1716
1690 # basically, this is deep magic (because SSL_read should have the same issues) 1717 # basically, this is deep magic (because SSL_read should have the same issues)
1691 # but the openssl maintainers basically said: "trust us, it just works". 1718 # but the openssl maintainers basically said: "trust us, it just works".
1692 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1719 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1693 # and mismaintained ssleay-module doesn't even offer them). 1720 # and mismaintained ssleay-module doesn't even offer them).
… …
1700 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 1727 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1701 # have identity issues in that area. 1728 # have identity issues in that area.
1702# Net::SSLeay::CTX_set_mode ($ssl, 1729# Net::SSLeay::CTX_set_mode ($ssl,
1703# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1730# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1704# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1731# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1705 Net::SSLeay::CTX_set_mode ($ssl, 1|2); 1732 Net::SSLeay::CTX_set_mode ($tls, 1|2);
1706 1733
1707 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1734 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1708 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1735 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1709 1736
1710 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1737 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio});
1711 1738
1712 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 1739 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1713 if $self->{on_starttls}; 1740 if $self->{on_starttls};
1714 1741
1715 &_dotls; # need to trigger the initial handshake 1742 &_dotls; # need to trigger the initial handshake
… …
1718 1745
1719=item $handle->stoptls 1746=item $handle->stoptls
1720 1747
1721Shuts down the SSL connection - this makes a proper EOF handshake by 1748Shuts down the SSL connection - this makes a proper EOF handshake by
1722sending a close notify to the other side, but since OpenSSL doesn't 1749sending a close notify to the other side, but since OpenSSL doesn't
1723support non-blocking shut downs, it is not possible to re-use the stream 1750support non-blocking shut downs, it is not guarenteed that you can re-use
1724afterwards. 1751the stream afterwards.
1725 1752
1726=cut 1753=cut
1727 1754
1728sub stoptls { 1755sub stoptls {
1729 my ($self) = @_; 1756 my ($self) = @_;
… …
1742sub _freetls { 1769sub _freetls {
1743 my ($self) = @_; 1770 my ($self) = @_;
1744 1771
1745 return unless $self->{tls}; 1772 return unless $self->{tls};
1746 1773
1747 $self->{tls_ctx}->_put_session (delete $self->{tls}); 1774 $self->{tls_ctx}->_put_session (delete $self->{tls})
1775 if ref $self->{tls};
1748 1776
1749 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 1777 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1750} 1778}
1751 1779
1752sub DESTROY { 1780sub DESTROY {
… …
1779 1807
1780=item $handle->destroy 1808=item $handle->destroy
1781 1809
1782Shuts down the handle object as much as possible - this call ensures that 1810Shuts down the handle object as much as possible - this call ensures that
1783no further callbacks will be invoked and as many resources as possible 1811no further callbacks will be invoked and as many resources as possible
1784will be freed. You must not call any methods on the object afterwards. 1812will be freed. Any method you will call on the handle object after
1813destroying it in this way will be silently ignored (and it will return the
1814empty list).
1785 1815
1786Normally, you can just "forget" any references to an AnyEvent::Handle 1816Normally, you can just "forget" any references to an AnyEvent::Handle
1787object and it will simply shut down. This works in fatal error and EOF 1817object and it will simply shut down. This works in fatal error and EOF
1788callbacks, as well as code outside. It does I<NOT> work in a read or write 1818callbacks, as well as code outside. It does I<NOT> work in a read or write
1789callback, so when you want to destroy the AnyEvent::Handle object from 1819callback, so when you want to destroy the AnyEvent::Handle object from
… …
1803sub destroy { 1833sub destroy {
1804 my ($self) = @_; 1834 my ($self) = @_;
1805 1835
1806 $self->DESTROY; 1836 $self->DESTROY;
1807 %$self = (); 1837 %$self = ();
1838 bless $self, "AnyEvent::Handle::destroyed";
1839}
1840
1841sub AnyEvent::Handle::destroyed::AUTOLOAD {
1842 #nop
1808} 1843}
1809 1844
1810=item AnyEvent::Handle::TLS_CTX 1845=item AnyEvent::Handle::TLS_CTX
1811 1846
1812This function creates and returns the AnyEvent::TLS object used by default 1847This function creates and returns the AnyEvent::TLS object used by default

Diff Legend

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