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.158 by root, Fri Jul 24 08:40:35 2009 UTC vs.
Revision 1.161 by root, Sat Jul 25 06:16:45 2009 UTC

44 $cv->recv; 44 $cv->recv;
45 45
46=head1 DESCRIPTION 46=head1 DESCRIPTION
47 47
48This module is a helper module to make it easier to do event-based I/O on 48This module is a helper module to make it easier to do event-based I/O on
49filehandles. For utility functions for doing non-blocking connects and accepts 49filehandles.
50on sockets see L<AnyEvent::Util>.
51 50
52The L<AnyEvent::Intro> tutorial contains some well-documented 51The L<AnyEvent::Intro> tutorial contains some well-documented
53AnyEvent::Handle examples. 52AnyEvent::Handle examples.
54 53
55In the following, when the documentation refers to of "bytes" then this 54In the following, when the documentation refers to of "bytes" then this
56means characters. As sysread and syswrite are used for all I/O, their 55means characters. As sysread and syswrite are used for all I/O, their
57treatment of characters applies to this module as well. 56treatment of characters applies to this module as well.
58 57
58At the very minimum, you should specify C<fh> or C<connect>, and the
59C<on_error> callback.
60
59All callbacks will be invoked with the handle object as their first 61All callbacks will be invoked with the handle object as their first
60argument. 62argument.
61 63
62=head1 METHODS 64=head1 METHODS
63 65
67 69
68The constructor supports these arguments (all as C<< key => value >> pairs). 70The constructor supports these arguments (all as C<< key => value >> pairs).
69 71
70=over 4 72=over 4
71 73
72=item fh => $filehandle [MANDATORY]
73
74#=item fh => $filehandle [C<fh> or C<connect> MANDATORY] 74=item fh => $filehandle [C<fh> or C<connect> MANDATORY]
75 75
76The filehandle this L<AnyEvent::Handle> object will operate on. 76The filehandle this L<AnyEvent::Handle> object will operate on.
77NOTE: The filehandle will be set to non-blocking mode (using 77NOTE: The filehandle will be set to non-blocking mode (using
78C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in 78C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
79that mode. 79that mode.
80 80
81#=item connect => [$host, $service] 81=item connect => [$host, $service] [C<fh> or C<connect> MANDATORY]
82# 82
83# You have to specify either this parameter, or C<connect>, below.
84#Try to connect to the specified host and service (port), using 83Try to connect to the specified host and service (port), using
85#C<AnyEvent::Socket::tcp_connect>. 84C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the
86# 85default C<peername>.
87#When this 86
87You have to specify either this parameter, or C<fh>, above.
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
92When this parameter is specified, then the C<on_prepare>,
93C<on_connect_error> and C<on_connect> callbacks will be called under the
94appropriate circumstances:
95
96=over 4
97
98=item on_prepare => $cb->($handle)
99
100This (rarely used) callback is called before a new connection is
101attempted, but after the file handle has been created. It could be used to
102prepare the file handle with parameters required for the actual connect
103(as opposed to settings that can be changed when the connection is already
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).
109
110=item on_connect => $cb->($handle, $host, $port, $retry->())
111
112This callback is called when a connection has been successfully established.
113
114The actual numeric host and port (the socket peername) are passed as
115parameters, together with a retry callback.
116
117When, for some reason, the handle is not acceptable, then calling
118C<$retry> will continue with the next conenction target (in case of
119multi-homed hosts or SRV records there can be multiple connection
120endpoints). When it is called then the read and write queues, eof status,
121tls status and similar properties of the handle are being reset.
122
123In most cases, ignoring the C<$retry> parameter is the way to go.
124
125=item on_connect_error => $cb->($handle, $message)
126
127This callback is called when the conenction could not be
128established. C<$!> will contain the relevant error code, and C<$message> a
129message describing it (usually the same as C<"$!">).
130
131If this callback isn't specified, then C<on_error> will be called with a
132fatal error instead.
133
134=back
135
136=item on_error => $cb->($handle, $fatal, $message)
137
138This is the error callback, which is called when, well, some error
139occured, such as not being able to resolve the hostname, failure to
140connect or a read error.
141
142Some errors are fatal (which is indicated by C<$fatal> being true). On
143fatal errors the handle object will be destroyed (by a call to C<< ->
144destroy >>) after invoking the error callback (which means you are free to
145examine the handle object). Examples of fatal errors are an EOF condition
146with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors. In
147cases where the other side can close the connection at their will it is
148often easiest to not report C<EPIPE> errors in this callback.
149
150AnyEvent::Handle tries to find an appropriate error code for you to check
151against, but in some cases (TLS errors), this does not work well. It is
152recommended to always output the C<$message> argument in human-readable
153error messages (it's usually the same as C<"$!">).
154
155Non-fatal errors can be retried by simply returning, but it is recommended
156to simply ignore this parameter and instead abondon the handle object
157when this callback is invoked. Examples of non-fatal errors are timeouts
158C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
159
160On callback entrance, the value of C<$!> contains the operating system
161error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
162C<EPROTO>).
163
164While not mandatory, it is I<highly> recommended to set this callback, as
165you will not be notified of errors otherwise. The default simply calls
166C<croak>.
167
168=item on_read => $cb->($handle)
169
170This sets the default read callback, which is called when data arrives
171and no read request is in the queue (unlike read queue callbacks, this
172callback will only be called when at least one octet of data is in the
173read buffer).
174
175To access (and remove data from) the read buffer, use the C<< ->rbuf >>
176method or access the C<< $handle->{rbuf} >> member directly. Note that you
177must not enlarge or modify the read buffer, you can only remove data at
178the beginning from it.
179
180When an EOF condition is detected then AnyEvent::Handle will first try to
181feed all the remaining data to the queued callbacks and C<on_read> before
182calling the C<on_eof> callback. If no progress can be made, then a fatal
183error will be raised (with C<$!> set to C<EPIPE>).
184
185Note that, unlike requests in the read queue, an C<on_read> callback
186doesn't mean you I<require> some data: if there is an EOF and there
187are outstanding read requests then an error will be flagged. With an
188C<on_read> callback, the C<on_eof> callback will be invoked.
88 189
89=item on_eof => $cb->($handle) 190=item on_eof => $cb->($handle)
90 191
91Set the callback to be called when an end-of-file condition is detected, 192Set the callback to be called when an end-of-file condition is detected,
92i.e. in the case of a socket, when the other side has closed the 193i.e. in the case of a socket, when the other side has closed the
99callback and continue writing data, as only the read part has been shut 200callback and continue writing data, as only the read part has been shut
100down. 201down.
101 202
102If an EOF condition has been detected but no C<on_eof> callback has been 203If an EOF condition has been detected but no C<on_eof> callback has been
103set, then a fatal error will be raised with C<$!> set to <0>. 204set, then a fatal error will be raised with C<$!> set to <0>.
104
105=item on_error => $cb->($handle, $fatal, $message)
106
107This is the error callback, which is called when, well, some error
108occured, such as not being able to resolve the hostname, failure to
109connect or a read error.
110
111Some errors are fatal (which is indicated by C<$fatal> being true). On
112fatal errors the handle object will be destroyed (by a call to C<< ->
113destroy >>) after invoking the error callback (which means you are free to
114examine the handle object). Examples of fatal errors are an EOF condition
115with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors.
116
117AnyEvent::Handle tries to find an appropriate error code for you to check
118against, but in some cases (TLS errors), this does not work well. It is
119recommended to always output the C<$message> argument in human-readable
120error messages (it's usually the same as C<"$!">).
121
122Non-fatal errors can be retried by simply returning, but it is recommended
123to simply ignore this parameter and instead abondon the handle object
124when this callback is invoked. Examples of non-fatal errors are timeouts
125C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
126
127On callback entrance, the value of C<$!> contains the operating system
128error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
129C<EPROTO>).
130
131While not mandatory, it is I<highly> recommended to set this callback, as
132you will not be notified of errors otherwise. The default simply calls
133C<croak>.
134
135=item on_read => $cb->($handle)
136
137This sets the default read callback, which is called when data arrives
138and no read request is in the queue (unlike read queue callbacks, this
139callback will only be called when at least one octet of data is in the
140read buffer).
141
142To access (and remove data from) the read buffer, use the C<< ->rbuf >>
143method or access the C<< $handle->{rbuf} >> member directly. Note that you
144must not enlarge or modify the read buffer, you can only remove data at
145the beginning from it.
146
147When an EOF condition is detected then AnyEvent::Handle will first try to
148feed all the remaining data to the queued callbacks and C<on_read> before
149calling the C<on_eof> callback. If no progress can be made, then a fatal
150error will be raised (with C<$!> set to C<EPIPE>).
151
152Note that, unlike requests in the read queue, an C<on_read> callback
153doesn't mean you I<require> some data: if there is an EOF and there
154are outstanding read requests then an error will be flagged. With an
155C<on_read> callback, the C<on_eof> callback will be invoked.
156 205
157=item on_drain => $cb->($handle) 206=item on_drain => $cb->($handle)
158 207
159This sets the callback that is called when the write buffer becomes empty 208This sets the callback that is called when the write buffer becomes empty
160(or when the callback is set and the buffer is empty already). 209(or when the callback is set and the buffer is empty already).
359 408
360sub new { 409sub new {
361 my $class = shift; 410 my $class = shift;
362 my $self = bless { @_ }, $class; 411 my $self = bless { @_ }, $class;
363 412
364 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 413 if ($self->{fh}) {
414 $self->_start;
415 return unless $self->{fh}; # could be gone by now
416
417 } elsif ($self->{connect}) {
418 require AnyEvent::Socket;
419
420 $self->{peername} = $self->{connect}[0]
421 unless exists $self->{peername};
422
423 $self->{_skip_drain_rbuf} = 1;
424
425 {
426 Scalar::Util::weaken (my $self = $self);
427
428 $self->{_connect} =
429 AnyEvent::Socket::tcp_connect (
430 $self->{connect}[0],
431 $self->{connect}[1],
432 sub {
433 my ($fh, $host, $port, $retry) = @_;
434
435 if ($fh) {
436 $self->{fh} = $fh;
437
438 delete $self->{_skip_drain_rbuf};
439 $self->_start;
440
441 $self->{on_connect}
442 and $self->{on_connect}($self, $host, $port, sub {
443 delete @$self{qw(fh _tw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)};
444 $self->{_skip_drain_rbuf} = 1;
445 &$retry;
446 });
447
448 } else {
449 if ($self->{on_connect_error}) {
450 $self->{on_connect_error}($self, "$!");
451 $self->destroy;
452 } else {
453 $self->_error ($!, 1);
454 }
455 }
456 },
457 sub {
458 local $self->{fh} = $_[0];
459
460 $self->{on_prepare}
461 ? $self->{on_prepare}->($self)
462 : ()
463 }
464 );
465 }
466
467 } else {
468 Carp::croak "AnyEvent::Handle: either an existing fh or the connect parameter must be specified";
469 }
470
471 $self
472}
473
474sub _start {
475 my ($self) = @_;
365 476
366 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 477 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
367 478
368 $self->{_activity} = AnyEvent->now; 479 $self->{_activity} = AnyEvent->now;
369 $self->_timeout; 480 $self->_timeout;
374 if $self->{tls}; 485 if $self->{tls};
375 486
376 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 487 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
377 488
378 $self->start_read 489 $self->start_read
379 if $self->{on_read}; 490 if $self->{on_read} || @{ $self->{_queue} };
380 491
381 $self->{fh} && $self 492 $self->_drain_wbuf;
382} 493}
383 494
384#sub _shutdown { 495#sub _shutdown {
385# my ($self) = @_; 496# my ($self) = @_;
386# 497#
466sub no_delay { 577sub no_delay {
467 $_[0]{no_delay} = $_[1]; 578 $_[0]{no_delay} = $_[1];
468 579
469 eval { 580 eval {
470 local $SIG{__DIE__}; 581 local $SIG{__DIE__};
471 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1]; 582 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1]
583 if $_[0]{fh};
472 }; 584 };
473} 585}
474 586
475=item $handle->on_starttls ($cb) 587=item $handle->on_starttls ($cb)
476 588
510# reset the timeout watcher, as neccessary 622# reset the timeout watcher, as neccessary
511# also check for time-outs 623# also check for time-outs
512sub _timeout { 624sub _timeout {
513 my ($self) = @_; 625 my ($self) = @_;
514 626
515 if ($self->{timeout}) { 627 if ($self->{timeout} && $self->{fh}) {
516 my $NOW = AnyEvent->now; 628 my $NOW = AnyEvent->now;
517 629
518 # when would the timeout trigger? 630 # when would the timeout trigger?
519 my $after = $self->{_activity} + $self->{timeout} - $NOW; 631 my $after = $self->{_activity} + $self->{timeout} - $NOW;
520 632
638 ->($self, @_); 750 ->($self, @_);
639 } 751 }
640 752
641 if ($self->{tls}) { 753 if ($self->{tls}) {
642 $self->{_tls_wbuf} .= $_[0]; 754 $self->{_tls_wbuf} .= $_[0];
643 755 &_dotls ($self) if $self->{fh};
644 &_dotls ($self);
645 } else { 756 } else {
646 $self->{wbuf} .= $_[0]; 757 $self->{wbuf} .= $_[0];
647 $self->_drain_wbuf; 758 $self->_drain_wbuf if $self->{fh};
648 } 759 }
649} 760}
650 761
651=item $handle->push_write (type => @args) 762=item $handle->push_write (type => @args)
652 763
869=cut 980=cut
870 981
871sub _drain_rbuf { 982sub _drain_rbuf {
872 my ($self) = @_; 983 my ($self) = @_;
873 984
985 # avoid recursion
986 return if exists $self->{_skip_drain_rbuf};
874 local $self->{_in_drain} = 1; 987 local $self->{_skip_drain_rbuf} = 1;
875 988
876 if ( 989 if (
877 defined $self->{rbuf_max} 990 defined $self->{rbuf_max}
878 && $self->{rbuf_max} < length $self->{rbuf} 991 && $self->{rbuf_max} < length $self->{rbuf}
879 ) { 992 ) {
946 1059
947sub on_read { 1060sub on_read {
948 my ($self, $cb) = @_; 1061 my ($self, $cb) = @_;
949 1062
950 $self->{on_read} = $cb; 1063 $self->{on_read} = $cb;
951 $self->_drain_rbuf if $cb && !$self->{_in_drain}; 1064 $self->_drain_rbuf if $cb;
952} 1065}
953 1066
954=item $handle->rbuf 1067=item $handle->rbuf
955 1068
956Returns the read buffer (as a modifiable lvalue). 1069Returns the read buffer (as a modifiable lvalue).
1008 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 1121 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
1009 ->($self, $cb, @_); 1122 ->($self, $cb, @_);
1010 } 1123 }
1011 1124
1012 push @{ $self->{_queue} }, $cb; 1125 push @{ $self->{_queue} }, $cb;
1013 $self->_drain_rbuf unless $self->{_in_drain}; 1126 $self->_drain_rbuf;
1014} 1127}
1015 1128
1016sub unshift_read { 1129sub unshift_read {
1017 my $self = shift; 1130 my $self = shift;
1018 my $cb = pop; 1131 my $cb = pop;
1024 ->($self, $cb, @_); 1137 ->($self, $cb, @_);
1025 } 1138 }
1026 1139
1027 1140
1028 unshift @{ $self->{_queue} }, $cb; 1141 unshift @{ $self->{_queue} }, $cb;
1029 $self->_drain_rbuf unless $self->{_in_drain}; 1142 $self->_drain_rbuf;
1030} 1143}
1031 1144
1032=item $handle->push_read (type => @args, $cb) 1145=item $handle->push_read (type => @args, $cb)
1033 1146
1034=item $handle->unshift_read (type => @args, $cb) 1147=item $handle->unshift_read (type => @args, $cb)
1427 if ($self->{tls}) { 1540 if ($self->{tls}) {
1428 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); 1541 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1429 1542
1430 &_dotls ($self); 1543 &_dotls ($self);
1431 } else { 1544 } else {
1432 $self->_drain_rbuf unless $self->{_in_drain}; 1545 $self->_drain_rbuf;
1433 } 1546 }
1434 1547
1435 } elsif (defined $len) { 1548 } elsif (defined $len) {
1436 delete $self->{_rw}; 1549 delete $self->{_rw};
1437 $self->{_eof} = 1; 1550 $self->{_eof} = 1;
1438 $self->_drain_rbuf unless $self->{_in_drain}; 1551 $self->_drain_rbuf;
1439 1552
1440 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1553 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1441 return $self->_error ($!, 1); 1554 return $self->_error ($!, 1);
1442 } 1555 }
1443 }); 1556 });
1503 $self->{_eof} = 1; 1616 $self->{_eof} = 1;
1504 } 1617 }
1505 } 1618 }
1506 1619
1507 $self->{_tls_rbuf} .= $tmp; 1620 $self->{_tls_rbuf} .= $tmp;
1508 $self->_drain_rbuf unless $self->{_in_drain}; 1621 $self->_drain_rbuf;
1509 $self->{tls} or return; # tls session might have gone away in callback 1622 $self->{tls} or return; # tls session might have gone away in callback
1510 } 1623 }
1511 1624
1512 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1625 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1513 return $self->_tls_error ($tmp) 1626 return $self->_tls_error ($tmp)
1545The TLS connection object will end up in C<< $handle->{tls} >>, the TLS 1658The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1546context in C<< $handle->{tls_ctx} >> after this call and can be used or 1659context in C<< $handle->{tls_ctx} >> after this call and can be used or
1547changed to your liking. Note that the handshake might have already started 1660changed to your liking. Note that the handshake might have already started
1548when this function returns. 1661when this function returns.
1549 1662
1550If it an error to start a TLS handshake more than once per 1663Due to bugs in OpenSSL, it might or might not be possible to do multiple
1551AnyEvent::Handle object (this is due to bugs in OpenSSL). 1664handshakes on the same stream. Best do not attempt to use the stream after
1665stopping TLS.
1552 1666
1553=cut 1667=cut
1554 1668
1555our %TLS_CACHE; #TODO not yet documented, should we? 1669our %TLS_CACHE; #TODO not yet documented, should we?
1556 1670
1557sub starttls { 1671sub starttls {
1558 my ($self, $ssl, $ctx) = @_; 1672 my ($self, $tls, $ctx) = @_;
1673
1674 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
1675 if $self->{tls};
1676
1677 $self->{tls} = $tls;
1678 $self->{tls_ctx} = $ctx if @_ > 2;
1679
1680 return unless $self->{fh};
1559 1681
1560 require Net::SSLeay; 1682 require Net::SSLeay;
1561
1562 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1563 if $self->{tls};
1564 1683
1565 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1684 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1566 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1685 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1567 1686
1687 $tls = $self->{tls};
1568 $ctx ||= $self->{tls_ctx}; 1688 $ctx = $self->{tls_ctx};
1569 1689
1570 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 1690 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1571 1691
1572 if ("HASH" eq ref $ctx) { 1692 if ("HASH" eq ref $ctx) {
1573 require AnyEvent::TLS; 1693 require AnyEvent::TLS;
1579 $ctx = new AnyEvent::TLS %$ctx; 1699 $ctx = new AnyEvent::TLS %$ctx;
1580 } 1700 }
1581 } 1701 }
1582 1702
1583 $self->{tls_ctx} = $ctx || TLS_CTX (); 1703 $self->{tls_ctx} = $ctx || TLS_CTX ();
1584 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername}); 1704 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
1585 1705
1586 # basically, this is deep magic (because SSL_read should have the same issues) 1706 # basically, this is deep magic (because SSL_read should have the same issues)
1587 # but the openssl maintainers basically said: "trust us, it just works". 1707 # but the openssl maintainers basically said: "trust us, it just works".
1588 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1708 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1589 # and mismaintained ssleay-module doesn't even offer them). 1709 # and mismaintained ssleay-module doesn't even offer them).
1596 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 1716 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1597 # have identity issues in that area. 1717 # have identity issues in that area.
1598# Net::SSLeay::CTX_set_mode ($ssl, 1718# Net::SSLeay::CTX_set_mode ($ssl,
1599# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1719# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1600# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1720# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1601 Net::SSLeay::CTX_set_mode ($ssl, 1|2); 1721 Net::SSLeay::CTX_set_mode ($tls, 1|2);
1602 1722
1603 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1723 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1604 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1724 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1605 1725
1606 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1726 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio});
1607 1727
1608 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 1728 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1609 if $self->{on_starttls}; 1729 if $self->{on_starttls};
1610 1730
1611 &_dotls; # need to trigger the initial handshake 1731 &_dotls; # need to trigger the initial handshake
1614 1734
1615=item $handle->stoptls 1735=item $handle->stoptls
1616 1736
1617Shuts down the SSL connection - this makes a proper EOF handshake by 1737Shuts down the SSL connection - this makes a proper EOF handshake by
1618sending a close notify to the other side, but since OpenSSL doesn't 1738sending a close notify to the other side, but since OpenSSL doesn't
1619support non-blocking shut downs, it is not possible to re-use the stream 1739support non-blocking shut downs, it is not guarenteed that you can re-use
1620afterwards. 1740the stream afterwards.
1621 1741
1622=cut 1742=cut
1623 1743
1624sub stoptls { 1744sub stoptls {
1625 my ($self) = @_; 1745 my ($self) = @_;
1638sub _freetls { 1758sub _freetls {
1639 my ($self) = @_; 1759 my ($self) = @_;
1640 1760
1641 return unless $self->{tls}; 1761 return unless $self->{tls};
1642 1762
1643 $self->{tls_ctx}->_put_session (delete $self->{tls}); 1763 $self->{tls_ctx}->_put_session (delete $self->{tls})
1764 if ref $self->{tls};
1644 1765
1645 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 1766 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1646} 1767}
1647 1768
1648sub DESTROY { 1769sub DESTROY {

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines