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.176 by root, Sun Aug 9 00:20:35 2009 UTC

1package AnyEvent::Handle;
2
3use Scalar::Util ();
4use Carp ();
5use Errno qw(EAGAIN EINTR);
6
7use AnyEvent (); BEGIN { AnyEvent::common_sense }
8use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
10=head1 NAME 1=head1 NAME
11 2
12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 3AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
13 4
14=cut 5=cut
15 6
16our $VERSION = 4.86; 7our $VERSION = 4.92;
17 8
18=head1 SYNOPSIS 9=head1 SYNOPSIS
19 10
20 use AnyEvent; 11 use AnyEvent;
21 use AnyEvent::Handle; 12 use AnyEvent::Handle;
… …
59C<on_error> callback. 50C<on_error> callback.
60 51
61All callbacks will be invoked with the handle object as their first 52All callbacks will be invoked with the handle object as their first
62argument. 53argument.
63 54
55=cut
56
57package AnyEvent::Handle;
58
59use Scalar::Util ();
60use List::Util ();
61use Carp ();
62use Errno qw(EAGAIN EINTR);
63
64use AnyEvent (); BEGIN { AnyEvent::common_sense }
65use AnyEvent::Util qw(WSAEWOULDBLOCK);
66
64=head1 METHODS 67=head1 METHODS
65 68
66=over 4 69=over 4
67 70
68=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value... 71=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
… …
83Try to connect to the specified host and service (port), using 86Try to connect to the specified host and service (port), using
84C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the 87C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the
85default C<peername>. 88default C<peername>.
86 89
87You have to specify either this parameter, or C<fh>, above. 90You have to specify either this parameter, or C<fh>, above.
91
92It is possible to push requests on the read and write queues, and modify
93properties of the stream, even while AnyEvent::Handle is connecting.
88 94
89When this parameter is specified, then the C<on_prepare>, 95When this parameter is specified, then the C<on_prepare>,
90C<on_connect_error> and C<on_connect> callbacks will be called under the 96C<on_connect_error> and C<on_connect> callbacks will be called under the
91appropriate circumstances: 97appropriate circumstances:
92 98
… …
97This (rarely used) callback is called before a new connection is 103This (rarely used) callback is called before a new connection is
98attempted, but after the file handle has been created. It could be used to 104attempted, but after the file handle has been created. It could be used to
99prepare the file handle with parameters required for the actual connect 105prepare the file handle with parameters required for the actual connect
100(as opposed to settings that can be changed when the connection is already 106(as opposed to settings that can be changed when the connection is already
101established). 107established).
108
109The return value of this callback should be the connect timeout value in
110seconds (or C<0>, or C<undef>, or the empty list, to indicate the default
111timeout is to be used).
102 112
103=item on_connect => $cb->($handle, $host, $port, $retry->()) 113=item on_connect => $cb->($handle, $host, $port, $retry->())
104 114
105This callback is called when a connection has been successfully established. 115This callback is called when a connection has been successfully established.
106 116
… …
209memory and push it into the queue, but instead only read more data from 219memory and push it into the queue, but instead only read more data from
210the file when the write queue becomes empty. 220the file when the write queue becomes empty.
211 221
212=item timeout => $fractional_seconds 222=item timeout => $fractional_seconds
213 223
224=item rtimeout => $fractional_seconds
225
226=item wtimeout => $fractional_seconds
227
214If non-zero, then this enables an "inactivity" timeout: whenever this many 228If non-zero, then these enables an "inactivity" timeout: whenever this
215seconds pass without a successful read or write on the underlying file 229many seconds pass without a successful read or write on the underlying
216handle, the C<on_timeout> callback will be invoked (and if that one is 230file handle (or a call to C<timeout_reset>), the C<on_timeout> callback
217missing, a non-fatal C<ETIMEDOUT> error will be raised). 231will be invoked (and if that one is missing, a non-fatal C<ETIMEDOUT>
232error will be raised).
233
234There are three variants of the timeouts that work fully independent
235of each other, for both read and write, just read, and just write:
236C<timeout>, C<rtimeout> and C<wtimeout>, with corresponding callbacks
237C<on_timeout>, C<on_rtimeout> and C<on_wtimeout>, and reset functions
238C<timeout_reset>, C<rtimeout_reset>, and C<wtimeout_reset>.
218 239
219Note that timeout processing is also active when you currently do not have 240Note that timeout processing is also active when you currently do not have
220any outstanding read or write requests: If you plan to keep the connection 241any outstanding read or write requests: If you plan to keep the connection
221idle then you should disable the timout temporarily or ignore the timeout 242idle then you should disable the timout temporarily or ignore the timeout
222in the C<on_timeout> callback, in which case AnyEvent::Handle will simply 243in the C<on_timeout> callback, in which case AnyEvent::Handle will simply
… …
441 } else { 462 } else {
442 if ($self->{on_connect_error}) { 463 if ($self->{on_connect_error}) {
443 $self->{on_connect_error}($self, "$!"); 464 $self->{on_connect_error}($self, "$!");
444 $self->destroy; 465 $self->destroy;
445 } else { 466 } else {
446 $self->fatal ($!, 1); 467 $self->_error ($!, 1);
447 } 468 }
448 } 469 }
449 }, 470 },
450 sub { 471 sub {
451 local $self->{fh} = $_[0]; 472 local $self->{fh} = $_[0];
452 473
474 $self->{on_prepare}
453 $self->{on_prepare}->($self) 475 ? $self->{on_prepare}->($self)
454 if $self->{on_prepare}; 476 : ()
455 } 477 }
456 ); 478 );
457 } 479 }
458 480
459 } else { 481 } else {
… …
466sub _start { 488sub _start {
467 my ($self) = @_; 489 my ($self) = @_;
468 490
469 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 491 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
470 492
493 $self->{_activity} =
494 $self->{_ractivity} =
471 $self->{_activity} = AnyEvent->now; 495 $self->{_wactivity} = AE::now;
472 $self->_timeout; 496
497 $self->timeout (delete $self->{timeout} ) if $self->{timeout};
498 $self->rtimeout (delete $self->{rtimeout}) if $self->{rtimeout};
499 $self->wtimeout (delete $self->{wtimeout}) if $self->{wtimeout};
473 500
474 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay}; 501 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
475 502
476 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 503 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
477 if $self->{tls}; 504 if $self->{tls};
478 505
479 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 506 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
480 507
481 $self->start_read 508 $self->start_read
482 if $self->{on_read} || @{ $self->{_queue} }; 509 if $self->{on_read} || @{ $self->{_queue} };
510
511 $self->_drain_wbuf;
483} 512}
484 513
485#sub _shutdown { 514#sub _shutdown {
486# my ($self) = @_; 515# my ($self) = @_;
487# 516#
… …
534 $_[0]{on_eof} = $_[1]; 563 $_[0]{on_eof} = $_[1];
535} 564}
536 565
537=item $handle->on_timeout ($cb) 566=item $handle->on_timeout ($cb)
538 567
539Replace the current C<on_timeout> callback, or disables the callback (but 568=item $handle->on_rtimeout ($cb)
540not the timeout) if C<$cb> = C<undef>. See the C<timeout> constructor
541argument and method.
542 569
543=cut 570=item $handle->on_wtimeout ($cb)
544 571
545sub on_timeout { 572Replace the current C<on_timeout>, C<on_rtimeout> or C<on_wtimeout>
546 $_[0]{on_timeout} = $_[1]; 573callback, or disables the callback (but not the timeout) if C<$cb> =
547} 574C<undef>. See the C<timeout> constructor argument and method.
575
576=cut
577
578# see below
548 579
549=item $handle->autocork ($boolean) 580=item $handle->autocork ($boolean)
550 581
551Enables or disables the current autocork behaviour (see C<autocork> 582Enables or disables the current autocork behaviour (see C<autocork>
552constructor argument). Changes will only take effect on the next write. 583constructor argument). Changes will only take effect on the next write.
… …
592 623
593sub on_starttls { 624sub on_starttls {
594 $_[0]{on_stoptls} = $_[1]; 625 $_[0]{on_stoptls} = $_[1];
595} 626}
596 627
628=item $handle->rbuf_max ($max_octets)
629
630Configures the C<rbuf_max> setting (C<undef> disables it).
631
632=cut
633
634sub rbuf_max {
635 $_[0]{rbuf_max} = $_[1];
636}
637
597############################################################################# 638#############################################################################
598 639
599=item $handle->timeout ($seconds) 640=item $handle->timeout ($seconds)
600 641
642=item $handle->rtimeout ($seconds)
643
644=item $handle->wtimeout ($seconds)
645
601Configures (or disables) the inactivity timeout. 646Configures (or disables) the inactivity timeout.
602 647
603=cut 648=item $handle->timeout_reset
604 649
605sub timeout { 650=item $handle->rtimeout_reset
651
652=item $handle->wtimeout_reset
653
654Reset the activity timeout, as if data was received or sent.
655
656These methods are cheap to call.
657
658=cut
659
660for my $dir ("", "r", "w") {
661 my $timeout = "${dir}timeout";
662 my $tw = "_${dir}tw";
663 my $on_timeout = "on_${dir}timeout";
664 my $activity = "_${dir}activity";
665 my $cb;
666
667 *$on_timeout = sub {
668 $_[0]{$on_timeout} = $_[1];
669 };
670
671 *$timeout = sub {
606 my ($self, $timeout) = @_; 672 my ($self, $new_value) = @_;
607 673
608 $self->{timeout} = $timeout; 674 $self->{$timeout} = $new_value;
609 $self->_timeout; 675 delete $self->{$tw}; &$cb;
610} 676 };
611 677
678 *{"${dir}timeout_reset"} = sub {
679 $_[0]{$activity} = AE::now;
680 };
681
682 # main workhorse:
612# reset the timeout watcher, as neccessary 683 # reset the timeout watcher, as neccessary
613# also check for time-outs 684 # also check for time-outs
614sub _timeout { 685 $cb = sub {
615 my ($self) = @_; 686 my ($self) = @_;
616 687
617 if ($self->{timeout} && $self->{fh}) { 688 if ($self->{$timeout} && $self->{fh}) {
618 my $NOW = AnyEvent->now; 689 my $NOW = AE::now;
619 690
620 # when would the timeout trigger? 691 # when would the timeout trigger?
621 my $after = $self->{_activity} + $self->{timeout} - $NOW; 692 my $after = $self->{$activity} + $self->{$timeout} - $NOW;
622 693
623 # now or in the past already? 694 # now or in the past already?
624 if ($after <= 0) { 695 if ($after <= 0) {
625 $self->{_activity} = $NOW; 696 $self->{$activity} = $NOW;
626 697
627 if ($self->{on_timeout}) { 698 if ($self->{$on_timeout}) {
628 $self->{on_timeout}($self); 699 $self->{$on_timeout}($self);
629 } else { 700 } else {
630 $self->_error (Errno::ETIMEDOUT); 701 $self->_error (Errno::ETIMEDOUT);
702 }
703
704 # callback could have changed timeout value, optimise
705 return unless $self->{$timeout};
706
707 # calculate new after
708 $after = $self->{$timeout};
631 } 709 }
632 710
633 # callback could have changed timeout value, optimise 711 Scalar::Util::weaken $self;
634 return unless $self->{timeout}; 712 return unless $self; # ->error could have destroyed $self
635 713
636 # calculate new after 714 $self->{$tw} ||= AE::timer $after, 0, sub {
637 $after = $self->{timeout}; 715 delete $self->{$tw};
716 $cb->($self);
717 };
718 } else {
719 delete $self->{$tw};
638 } 720 }
639
640 Scalar::Util::weaken $self;
641 return unless $self; # ->error could have destroyed $self
642
643 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
644 delete $self->{_tw};
645 $self->_timeout;
646 });
647 } else {
648 delete $self->{_tw};
649 } 721 }
650} 722}
651 723
652############################################################################# 724#############################################################################
653 725
… …
701 my $len = syswrite $self->{fh}, $self->{wbuf}; 773 my $len = syswrite $self->{fh}, $self->{wbuf};
702 774
703 if (defined $len) { 775 if (defined $len) {
704 substr $self->{wbuf}, 0, $len, ""; 776 substr $self->{wbuf}, 0, $len, "";
705 777
706 $self->{_activity} = AnyEvent->now; 778 $self->{_activity} = $self->{_wactivity} = AE::now;
707 779
708 $self->{on_drain}($self) 780 $self->{on_drain}($self)
709 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}) 781 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})
710 && $self->{on_drain}; 782 && $self->{on_drain};
711 783
… …
717 789
718 # try to write data immediately 790 # try to write data immediately
719 $cb->() unless $self->{autocork}; 791 $cb->() unless $self->{autocork};
720 792
721 # if still data left in wbuf, we need to poll 793 # if still data left in wbuf, we need to poll
722 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 794 $self->{_ww} = AE::io $self->{fh}, 1, $cb
723 if length $self->{wbuf}; 795 if length $self->{wbuf};
724 }; 796 };
725} 797}
726 798
727our %WH; 799our %WH;
… …
740 ->($self, @_); 812 ->($self, @_);
741 } 813 }
742 814
743 if ($self->{tls}) { 815 if ($self->{tls}) {
744 $self->{_tls_wbuf} .= $_[0]; 816 $self->{_tls_wbuf} .= $_[0];
745 817 &_dotls ($self) if $self->{fh};
746 &_dotls ($self);
747 } else { 818 } else {
748 $self->{wbuf} .= $_[0]; 819 $self->{wbuf} .= $_[0];
749 $self->_drain_wbuf if $self->{fh}; 820 $self->_drain_wbuf if $self->{fh};
750 } 821 }
751} 822}
752 823
753=item $handle->push_write (type => @args) 824=item $handle->push_write (type => @args)
… …
972 1043
973sub _drain_rbuf { 1044sub _drain_rbuf {
974 my ($self) = @_; 1045 my ($self) = @_;
975 1046
976 # avoid recursion 1047 # avoid recursion
977 return if exists $self->{_skip_drain_rbuf}; 1048 return if $self->{_skip_drain_rbuf};
978 local $self->{_skip_drain_rbuf} = 1; 1049 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 1050
987 while () { 1051 while () {
988 # we need to use a separate tls read buffer, as we must not receive data while 1052 # 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. 1053 # we are draining the buffer, and this can only happen with TLS.
990 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf}; 1054 $self->{rbuf} .= delete $self->{_tls_rbuf}
1055 if exists $self->{_tls_rbuf};
991 1056
992 my $len = length $self->{rbuf}; 1057 my $len = length $self->{rbuf};
993 1058
994 if (my $cb = shift @{ $self->{_queue} }) { 1059 if (my $cb = shift @{ $self->{_queue} }) {
995 unless ($cb->($self)) { 1060 unless ($cb->($self)) {
996 if ($self->{_eof}) { 1061 # no progress can be made
997 # no progress can be made (not enough data and no data forthcoming) 1062 # (not enough data and no data forthcoming)
998 $self->_error (Errno::EPIPE, 1), return; 1063 $self->_error (Errno::EPIPE, 1), return
999 } 1064 if $self->{_eof};
1000 1065
1001 unshift @{ $self->{_queue} }, $cb; 1066 unshift @{ $self->{_queue} }, $cb;
1002 last; 1067 last;
1003 } 1068 }
1004 } elsif ($self->{on_read}) { 1069 } elsif ($self->{on_read}) {
… …
1024 last; 1089 last;
1025 } 1090 }
1026 } 1091 }
1027 1092
1028 if ($self->{_eof}) { 1093 if ($self->{_eof}) {
1029 if ($self->{on_eof}) { 1094 $self->{on_eof}
1030 $self->{on_eof}($self) 1095 ? $self->{on_eof}($self)
1031 } else {
1032 $self->_error (0, 1, "Unexpected end-of-file"); 1096 : $self->_error (0, 1, "Unexpected end-of-file");
1033 } 1097
1098 return;
1099 }
1100
1101 if (
1102 defined $self->{rbuf_max}
1103 && $self->{rbuf_max} < length $self->{rbuf}
1104 ) {
1105 $self->_error (Errno::ENOSPC, 1), return;
1034 } 1106 }
1035 1107
1036 # may need to restart read watcher 1108 # may need to restart read watcher
1037 unless ($self->{_rw}) { 1109 unless ($self->{_rw}) {
1038 $self->start_read 1110 $self->start_read
… …
1519 my ($self) = @_; 1591 my ($self) = @_;
1520 1592
1521 unless ($self->{_rw} || $self->{_eof}) { 1593 unless ($self->{_rw} || $self->{_eof}) {
1522 Scalar::Util::weaken $self; 1594 Scalar::Util::weaken $self;
1523 1595
1524 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1596 $self->{_rw} = AE::io $self->{fh}, 0, sub {
1525 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf}); 1597 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});
1526 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1598 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
1527 1599
1528 if ($len > 0) { 1600 if ($len > 0) {
1529 $self->{_activity} = AnyEvent->now; 1601 $self->{_activity} = $self->{_ractivity} = AE::now;
1530 1602
1531 if ($self->{tls}) { 1603 if ($self->{tls}) {
1532 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); 1604 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1533 1605
1534 &_dotls ($self); 1606 &_dotls ($self);
… …
1542 $self->_drain_rbuf; 1614 $self->_drain_rbuf;
1543 1615
1544 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1616 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1545 return $self->_error ($!, 1); 1617 return $self->_error ($!, 1);
1546 } 1618 }
1547 }); 1619 };
1548 } 1620 }
1549} 1621}
1550 1622
1551our $ERROR_SYSCALL; 1623our $ERROR_SYSCALL;
1552our $ERROR_WANT_READ; 1624our $ERROR_WANT_READ;
… …
1649The TLS connection object will end up in C<< $handle->{tls} >>, the TLS 1721The 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 1722context 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 1723changed to your liking. Note that the handshake might have already started
1652when this function returns. 1724when this function returns.
1653 1725
1654If it an error to start a TLS handshake more than once per 1726Due to bugs in OpenSSL, it might or might not be possible to do multiple
1655AnyEvent::Handle object (this is due to bugs in OpenSSL). 1727handshakes on the same stream. Best do not attempt to use the stream after
1728stopping TLS.
1656 1729
1657=cut 1730=cut
1658 1731
1659our %TLS_CACHE; #TODO not yet documented, should we? 1732our %TLS_CACHE; #TODO not yet documented, should we?
1660 1733
1661sub starttls { 1734sub starttls {
1662 my ($self, $ssl, $ctx) = @_; 1735 my ($self, $tls, $ctx) = @_;
1736
1737 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
1738 if $self->{tls};
1739
1740 $self->{tls} = $tls;
1741 $self->{tls_ctx} = $ctx if @_ > 2;
1742
1743 return unless $self->{fh};
1663 1744
1664 require Net::SSLeay; 1745 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 1746
1669 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1747 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1670 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1748 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1671 1749
1750 $tls = $self->{tls};
1672 $ctx ||= $self->{tls_ctx}; 1751 $ctx = $self->{tls_ctx};
1673 1752
1674 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 1753 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1675 1754
1676 if ("HASH" eq ref $ctx) { 1755 if ("HASH" eq ref $ctx) {
1677 require AnyEvent::TLS; 1756 require AnyEvent::TLS;
… …
1683 $ctx = new AnyEvent::TLS %$ctx; 1762 $ctx = new AnyEvent::TLS %$ctx;
1684 } 1763 }
1685 } 1764 }
1686 1765
1687 $self->{tls_ctx} = $ctx || TLS_CTX (); 1766 $self->{tls_ctx} = $ctx || TLS_CTX ();
1688 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername}); 1767 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
1689 1768
1690 # basically, this is deep magic (because SSL_read should have the same issues) 1769 # 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". 1770 # but the openssl maintainers basically said: "trust us, it just works".
1692 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1771 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1693 # and mismaintained ssleay-module doesn't even offer them). 1772 # 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 1779 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1701 # have identity issues in that area. 1780 # have identity issues in that area.
1702# Net::SSLeay::CTX_set_mode ($ssl, 1781# Net::SSLeay::CTX_set_mode ($ssl,
1703# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1782# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1704# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1783# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1705 Net::SSLeay::CTX_set_mode ($ssl, 1|2); 1784 Net::SSLeay::CTX_set_mode ($tls, 1|2);
1706 1785
1707 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1786 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1708 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1787 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1709 1788
1789 Net::SSLeay::BIO_write ($self->{_rbio}, delete $self->{rbuf});
1790
1710 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1791 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio});
1711 1792
1712 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 1793 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1713 if $self->{on_starttls}; 1794 if $self->{on_starttls};
1714 1795
1715 &_dotls; # need to trigger the initial handshake 1796 &_dotls; # need to trigger the initial handshake
… …
1718 1799
1719=item $handle->stoptls 1800=item $handle->stoptls
1720 1801
1721Shuts down the SSL connection - this makes a proper EOF handshake by 1802Shuts down the SSL connection - this makes a proper EOF handshake by
1722sending a close notify to the other side, but since OpenSSL doesn't 1803sending 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 1804support non-blocking shut downs, it is not guarenteed that you can re-use
1724afterwards. 1805the stream afterwards.
1725 1806
1726=cut 1807=cut
1727 1808
1728sub stoptls { 1809sub stoptls {
1729 my ($self) = @_; 1810 my ($self) = @_;
… …
1742sub _freetls { 1823sub _freetls {
1743 my ($self) = @_; 1824 my ($self) = @_;
1744 1825
1745 return unless $self->{tls}; 1826 return unless $self->{tls};
1746 1827
1747 $self->{tls_ctx}->_put_session (delete $self->{tls}); 1828 $self->{tls_ctx}->_put_session (delete $self->{tls})
1829 if $self->{tls} > 0;
1748 1830
1749 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 1831 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1750} 1832}
1751 1833
1752sub DESTROY { 1834sub DESTROY {
… …
1760 my $fh = delete $self->{fh}; 1842 my $fh = delete $self->{fh};
1761 my $wbuf = delete $self->{wbuf}; 1843 my $wbuf = delete $self->{wbuf};
1762 1844
1763 my @linger; 1845 my @linger;
1764 1846
1765 push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub { 1847 push @linger, AE::io $fh, 1, sub {
1766 my $len = syswrite $fh, $wbuf, length $wbuf; 1848 my $len = syswrite $fh, $wbuf, length $wbuf;
1767 1849
1768 if ($len > 0) { 1850 if ($len > 0) {
1769 substr $wbuf, 0, $len, ""; 1851 substr $wbuf, 0, $len, "";
1770 } else { 1852 } else {
1771 @linger = (); # end 1853 @linger = (); # end
1772 } 1854 }
1773 }); 1855 };
1774 push @linger, AnyEvent->timer (after => $linger, cb => sub { 1856 push @linger, AE::timer $linger, 0, sub {
1775 @linger = (); 1857 @linger = ();
1776 }); 1858 };
1777 } 1859 }
1778} 1860}
1779 1861
1780=item $handle->destroy 1862=item $handle->destroy
1781 1863
1782Shuts down the handle object as much as possible - this call ensures that 1864Shuts down the handle object as much as possible - this call ensures that
1783no further callbacks will be invoked and as many resources as possible 1865no further callbacks will be invoked and as many resources as possible
1784will be freed. You must not call any methods on the object afterwards. 1866will be freed. Any method you will call on the handle object after
1867destroying it in this way will be silently ignored (and it will return the
1868empty list).
1785 1869
1786Normally, you can just "forget" any references to an AnyEvent::Handle 1870Normally, you can just "forget" any references to an AnyEvent::Handle
1787object and it will simply shut down. This works in fatal error and EOF 1871object 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 1872callbacks, 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 1873callback, so when you want to destroy the AnyEvent::Handle object from
… …
1803sub destroy { 1887sub destroy {
1804 my ($self) = @_; 1888 my ($self) = @_;
1805 1889
1806 $self->DESTROY; 1890 $self->DESTROY;
1807 %$self = (); 1891 %$self = ();
1892 bless $self, "AnyEvent::Handle::destroyed";
1893}
1894
1895sub AnyEvent::Handle::destroyed::AUTOLOAD {
1896 #nop
1808} 1897}
1809 1898
1810=item AnyEvent::Handle::TLS_CTX 1899=item AnyEvent::Handle::TLS_CTX
1811 1900
1812This function creates and returns the AnyEvent::TLS object used by default 1901This function creates and returns the AnyEvent::TLS object used by default

Diff Legend

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