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.41 by root, Tue May 27 05:47:36 2008 UTC vs.
Revision 1.56 by root, Wed Jun 4 09:55:16 2008 UTC

… …
2 2
3no warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
10use Fcntl (); 10use Fcntl ();
11use Errno qw/EAGAIN EINTR/; 11use Errno qw(EAGAIN EINTR);
12 12
13=head1 NAME 13=head1 NAME
14 14
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17=cut
18 18
19our $VERSION = '0.04'; 19our $VERSION = 4.12;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
… …
75NOTE: The filehandle will be set to non-blocking (using 75NOTE: The filehandle will be set to non-blocking (using
76AnyEvent::Util::fh_nonblocking). 76AnyEvent::Util::fh_nonblocking).
77 77
78=item on_eof => $cb->($handle) 78=item on_eof => $cb->($handle)
79 79
80Set the callback to be called on EOF. 80Set the callback to be called when an end-of-file condition is detcted,
81i.e. in the case of a socket, when the other side has closed the
82connection cleanly.
81 83
82While not mandatory, it is highly recommended to set an eof callback, 84While not mandatory, it is highly recommended to set an eof callback,
83otherwise you might end up with a closed socket while you are still 85otherwise you might end up with a closed socket while you are still
84waiting for data. 86waiting for data.
85 87
86=item on_error => $cb->($handle) 88=item on_error => $cb->($handle, $fatal)
87 89
88This is the fatal error callback, that is called when, well, a fatal error 90This is the error callback, which is called when, well, some error
89occurs, such as not being able to resolve the hostname, failure to connect 91occured, such as not being able to resolve the hostname, failure to
90or a read error. 92connect or a read error.
91 93
92The object will not be in a usable state when this callback has been 94Some errors are fatal (which is indicated by C<$fatal> being true). On
93called. 95fatal errors the handle object will be shut down and will not be
96usable. Non-fatal errors can be retried by simply returning, but it is
97recommended to simply ignore this parameter and instead abondon the handle
98object when this callback is invoked.
94 99
95On callback entrance, the value of C<$!> contains the operating system 100On callback entrance, the value of C<$!> contains the operating system
96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>). 101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
100 102
101While not mandatory, it is I<highly> recommended to set this callback, as 103While not mandatory, it is I<highly> recommended to set this callback, as
102you will not be notified of errors otherwise. The default simply calls 104you will not be notified of errors otherwise. The default simply calls
103die. 105C<croak>.
104 106
105=item on_read => $cb->($handle) 107=item on_read => $cb->($handle)
106 108
107This sets the default read callback, which is called when data arrives 109This sets the default read callback, which is called when data arrives
108and no read request is in the queue. 110and no read request is in the queue.
… …
119 121
120This sets the callback that is called when the write buffer becomes empty 122This sets the callback that is called when the write buffer becomes empty
121(or when the callback is set and the buffer is empty already). 123(or when the callback is set and the buffer is empty already).
122 124
123To append to the write buffer, use the C<< ->push_write >> method. 125To append to the write buffer, use the C<< ->push_write >> method.
126
127=item timeout => $fractional_seconds
128
129If non-zero, then this enables an "inactivity" timeout: whenever this many
130seconds pass without a successful read or write on the underlying file
131handle, the C<on_timeout> callback will be invoked (and if that one is
132missing, an C<ETIMEDOUT> error will be raised).
133
134Note that timeout processing is also active when you currently do not have
135any outstanding read or write requests: If you plan to keep the connection
136idle then you should disable the timout temporarily or ignore the timeout
137in the C<on_timeout> callback.
138
139Zero (the default) disables this timeout.
140
141=item on_timeout => $cb->($handle)
142
143Called whenever the inactivity timeout passes. If you return from this
144callback, then the timeout will be reset as if some activity had happened,
145so this condition is not fatal in any way.
124 146
125=item rbuf_max => <bytes> 147=item rbuf_max => <bytes>
126 148
127If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 149If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
128when the read buffer ever (strictly) exceeds this size. This is useful to 150when the read buffer ever (strictly) exceeds this size. This is useful to
… …
135isn't finished). 157isn't finished).
136 158
137=item read_size => <bytes> 159=item read_size => <bytes>
138 160
139The default read block size (the amount of bytes this module will try to read 161The default read block size (the amount of bytes this module will try to read
140on each [loop iteration). Default: C<4096>. 162during each (loop iteration). Default: C<8192>.
141 163
142=item low_water_mark => <bytes> 164=item low_water_mark => <bytes>
143 165
144Sets the amount of bytes (default: C<0>) that make up an "empty" write 166Sets the amount of bytes (default: C<0>) that make up an "empty" write
145buffer: If the write reaches this size or gets even samller it is 167buffer: If the write reaches this size or gets even samller it is
… …
202 if ($self->{tls}) { 224 if ($self->{tls}) {
203 require Net::SSLeay; 225 require Net::SSLeay;
204 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 226 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
205 } 227 }
206 228
207 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 229# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
208 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 230# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
231# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
209 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
210 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 233
234 $self->{_activity} = AnyEvent->now;
235 $self->_timeout;
211 236
212 $self->start_read; 237 $self->start_read;
213 238
214 $self 239 $self
215} 240}
216 241
217sub _shutdown { 242sub _shutdown {
218 my ($self) = @_; 243 my ($self) = @_;
219 244
245 delete $self->{_tw};
220 delete $self->{_rw}; 246 delete $self->{_rw};
221 delete $self->{_ww}; 247 delete $self->{_ww};
222 delete $self->{fh}; 248 delete $self->{fh};
223}
224 249
250 $self->stoptls;
251}
252
225sub error { 253sub _error {
226 my ($self) = @_; 254 my ($self, $errno, $fatal) = @_;
227 255
228 {
229 local $!;
230 $self->_shutdown; 256 $self->_shutdown
231 } 257 if $fatal;
232 258
233 $self->{on_error}($self) 259 $! = $errno;
260
234 if $self->{on_error}; 261 if ($self->{on_error}) {
235 262 $self->{on_error}($self, $fatal);
263 } else {
236 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 264 Carp::croak "AnyEvent::Handle uncaught error: $!";
265 }
237} 266}
238 267
239=item $fh = $handle->fh 268=item $fh = $handle->fh
240 269
241This method returns the file handle of the L<AnyEvent::Handle> object. 270This method returns the file handle of the L<AnyEvent::Handle> object.
… …
260 289
261=cut 290=cut
262 291
263sub on_eof { 292sub on_eof {
264 $_[0]{on_eof} = $_[1]; 293 $_[0]{on_eof} = $_[1];
294}
295
296=item $handle->on_timeout ($cb)
297
298Replace the current C<on_timeout> callback, or disables the callback
299(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
300argument.
301
302=cut
303
304sub on_timeout {
305 $_[0]{on_timeout} = $_[1];
306}
307
308#############################################################################
309
310=item $handle->timeout ($seconds)
311
312Configures (or disables) the inactivity timeout.
313
314=cut
315
316sub timeout {
317 my ($self, $timeout) = @_;
318
319 $self->{timeout} = $timeout;
320 $self->_timeout;
321}
322
323# reset the timeout watcher, as neccessary
324# also check for time-outs
325sub _timeout {
326 my ($self) = @_;
327
328 if ($self->{timeout}) {
329 my $NOW = AnyEvent->now;
330
331 # when would the timeout trigger?
332 my $after = $self->{_activity} + $self->{timeout} - $NOW;
333
334 # now or in the past already?
335 if ($after <= 0) {
336 $self->{_activity} = $NOW;
337
338 if ($self->{on_timeout}) {
339 $self->{on_timeout}($self);
340 } else {
341 $self->_error (&Errno::ETIMEDOUT);
342 }
343
344 # callback could have changed timeout value, optimise
345 return unless $self->{timeout};
346
347 # calculate new after
348 $after = $self->{timeout};
349 }
350
351 Scalar::Util::weaken $self;
352 return unless $self; # ->error could have destroyed $self
353
354 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
355 delete $self->{_tw};
356 $self->_timeout;
357 });
358 } else {
359 delete $self->{_tw};
360 }
265} 361}
266 362
267############################################################################# 363#############################################################################
268 364
269=back 365=back
… …
316 my $len = syswrite $self->{fh}, $self->{wbuf}; 412 my $len = syswrite $self->{fh}, $self->{wbuf};
317 413
318 if ($len >= 0) { 414 if ($len >= 0) {
319 substr $self->{wbuf}, 0, $len, ""; 415 substr $self->{wbuf}, 0, $len, "";
320 416
417 $self->{_activity} = AnyEvent->now;
418
321 $self->{on_drain}($self) 419 $self->{on_drain}($self)
322 if $self->{low_water_mark} >= length $self->{wbuf} 420 if $self->{low_water_mark} >= length $self->{wbuf}
323 && $self->{on_drain}; 421 && $self->{on_drain};
324 422
325 delete $self->{_ww} unless length $self->{wbuf}; 423 delete $self->{_ww} unless length $self->{wbuf};
326 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) { 424 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
327 $self->error; 425 $self->_error ($!, 1);
328 } 426 }
329 }; 427 };
330 428
331 # try to write data immediately 429 # try to write data immediately
332 $cb->(); 430 $cb->();
… …
352 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 450 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
353 ->($self, @_); 451 ->($self, @_);
354 } 452 }
355 453
356 if ($self->{filter_w}) { 454 if ($self->{filter_w}) {
357 $self->{filter_w}->($self, \$_[0]); 455 $self->{filter_w}($self, \$_[0]);
358 } else { 456 } else {
359 $self->{wbuf} .= $_[0]; 457 $self->{wbuf} .= $_[0];
360 $self->_drain_wbuf; 458 $self->_drain_wbuf;
361 } 459 }
362} 460}
363 461
364=item $handle->push_write (type => @args) 462=item $handle->push_write (type => @args)
365 463
366=item $handle->unshift_write (type => @args)
367
368Instead of formatting your data yourself, you can also let this module do 464Instead of formatting your data yourself, you can also let this module do
369the job by specifying a type and type-specific arguments. 465the job by specifying a type and type-specific arguments.
370 466
371Predefined types are (if you have ideas for additional types, feel free to 467Predefined types are (if you have ideas for additional types, feel free to
372drop by and tell us): 468drop by and tell us):
… …
375 471
376=item netstring => $string 472=item netstring => $string
377 473
378Formats the given value as netstring 474Formats the given value as netstring
379(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 475(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
380
381=back
382 476
383=cut 477=cut
384 478
385register_write_type netstring => sub { 479register_write_type netstring => sub {
386 my ($self, $string) = @_; 480 my ($self, $string) = @_;
… …
427 521
428 $self->{json} ? $self->{json}->encode ($ref) 522 $self->{json} ? $self->{json}->encode ($ref)
429 : JSON::encode_json ($ref) 523 : JSON::encode_json ($ref)
430}; 524};
431 525
526=back
527
432=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 528=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
433 529
434This function (not method) lets you add your own types to C<push_write>. 530This function (not method) lets you add your own types to C<push_write>.
435Whenever the given C<type> is used, C<push_write> will invoke the code 531Whenever the given C<type> is used, C<push_write> will invoke the code
436reference with the handle object and the remaining arguments. 532reference with the handle object and the remaining arguments.
… …
473the specified number of bytes which give an XML datagram. 569the specified number of bytes which give an XML datagram.
474 570
475 # in the default state, expect some header bytes 571 # in the default state, expect some header bytes
476 $handle->on_read (sub { 572 $handle->on_read (sub {
477 # some data is here, now queue the length-header-read (4 octets) 573 # some data is here, now queue the length-header-read (4 octets)
478 shift->unshift_read_chunk (4, sub { 574 shift->unshift_read (chunk => 4, sub {
479 # header arrived, decode 575 # header arrived, decode
480 my $len = unpack "N", $_[1]; 576 my $len = unpack "N", $_[1];
481 577
482 # now read the payload 578 # now read the payload
483 shift->unshift_read_chunk ($len, sub { 579 shift->unshift_read (chunk => $len, sub {
484 my $xml = $_[1]; 580 my $xml = $_[1];
485 # handle xml 581 # handle xml
486 }); 582 });
487 }); 583 });
488 }); 584 });
… …
495 591
496 # request one 592 # request one
497 $handle->push_write ("request 1\015\012"); 593 $handle->push_write ("request 1\015\012");
498 594
499 # we expect "ERROR" or "OK" as response, so push a line read 595 # we expect "ERROR" or "OK" as response, so push a line read
500 $handle->push_read_line (sub { 596 $handle->push_read (line => sub {
501 # if we got an "OK", we have to _prepend_ another line, 597 # if we got an "OK", we have to _prepend_ another line,
502 # so it will be read before the second request reads its 64 bytes 598 # so it will be read before the second request reads its 64 bytes
503 # which are already in the queue when this callback is called 599 # which are already in the queue when this callback is called
504 # we don't do this in case we got an error 600 # we don't do this in case we got an error
505 if ($_[1] eq "OK") { 601 if ($_[1] eq "OK") {
506 $_[0]->unshift_read_line (sub { 602 $_[0]->unshift_read (line => sub {
507 my $response = $_[1]; 603 my $response = $_[1];
508 ... 604 ...
509 }); 605 });
510 } 606 }
511 }); 607 });
512 608
513 # request two 609 # request two
514 $handle->push_write ("request 2\015\012"); 610 $handle->push_write ("request 2\015\012");
515 611
516 # simply read 64 bytes, always 612 # simply read 64 bytes, always
517 $handle->push_read_chunk (64, sub { 613 $handle->push_read (chunk => 64, sub {
518 my $response = $_[1]; 614 my $response = $_[1];
519 ... 615 ...
520 }); 616 });
521 617
522=over 4 618=over 4
… …
528 624
529 if ( 625 if (
530 defined $self->{rbuf_max} 626 defined $self->{rbuf_max}
531 && $self->{rbuf_max} < length $self->{rbuf} 627 && $self->{rbuf_max} < length $self->{rbuf}
532 ) { 628 ) {
533 $! = &Errno::ENOSPC; 629 return $self->_error (&Errno::ENOSPC, 1);
534 $self->error;
535 } 630 }
536 631
537 return if $self->{in_drain}; 632 return if $self->{in_drain};
538 local $self->{in_drain} = 1; 633 local $self->{in_drain} = 1;
539 634
… …
541 no strict 'refs'; 636 no strict 'refs';
542 if (my $cb = shift @{ $self->{_queue} }) { 637 if (my $cb = shift @{ $self->{_queue} }) {
543 unless ($cb->($self)) { 638 unless ($cb->($self)) {
544 if ($self->{_eof}) { 639 if ($self->{_eof}) {
545 # no progress can be made (not enough data and no data forthcoming) 640 # no progress can be made (not enough data and no data forthcoming)
546 $! = &Errno::EPIPE; 641 return $self->_error (&Errno::EPIPE, 1);
547 $self->error;
548 } 642 }
549 643
550 unshift @{ $self->{_queue} }, $cb; 644 unshift @{ $self->{_queue} }, $cb;
551 return; 645 last;
552 } 646 }
553 } elsif ($self->{on_read}) { 647 } elsif ($self->{on_read}) {
554 $self->{on_read}($self); 648 $self->{on_read}($self);
555 649
556 if ( 650 if (
557 $self->{_eof} # if no further data will arrive
558 && $len == length $self->{rbuf} # and no data has been consumed 651 $len == length $self->{rbuf} # if no data has been consumed
559 && !@{ $self->{_queue} } # and the queue is still empty 652 && !@{ $self->{_queue} } # and the queue is still empty
560 && $self->{on_read} # and we still want to read data 653 && $self->{on_read} # but we still have on_read
561 ) { 654 ) {
655 # no further data will arrive
562 # then no progress can be made 656 # so no progress can be made
563 $! = &Errno::EPIPE; 657 return $self->_error (&Errno::EPIPE, 1)
564 $self->error; 658 if $self->{_eof};
659
660 last; # more data might arrive
565 } 661 }
566 } else { 662 } else {
567 # read side becomes idle 663 # read side becomes idle
568 delete $self->{_rw}; 664 delete $self->{_rw};
569 return; 665 last;
570 } 666 }
571 } 667 }
572 668
573 if ($self->{_eof}) {
574 $self->_shutdown;
575 $self->{on_eof}($self) 669 $self->{on_eof}($self)
576 if $self->{on_eof}; 670 if $self->{_eof} && $self->{on_eof};
671
672 # may need to restart read watcher
673 unless ($self->{_rw}) {
674 $self->start_read
675 if $self->{on_read} || @{ $self->{_queue} };
577 } 676 }
578} 677}
579 678
580=item $handle->on_read ($cb) 679=item $handle->on_read ($cb)
581 680
… …
771 my ($self, $cb) = @_; 870 my ($self, $cb) = @_;
772 871
773 sub { 872 sub {
774 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 873 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
775 if ($_[0]{rbuf} =~ /[^0-9]/) { 874 if ($_[0]{rbuf} =~ /[^0-9]/) {
776 $! = &Errno::EBADMSG; 875 $self->_error (&Errno::EBADMSG);
777 $self->error;
778 } 876 }
779 return; 877 return;
780 } 878 }
781 879
782 my $len = $1; 880 my $len = $1;
… …
785 my $string = $_[1]; 883 my $string = $_[1];
786 $_[0]->unshift_read (chunk => 1, sub { 884 $_[0]->unshift_read (chunk => 1, sub {
787 if ($_[1] eq ",") { 885 if ($_[1] eq ",") {
788 $cb->($_[0], $string); 886 $cb->($_[0], $string);
789 } else { 887 } else {
790 $! = &Errno::EBADMSG; 888 $self->_error (&Errno::EBADMSG);
791 $self->error;
792 } 889 }
793 }); 890 });
794 }); 891 });
795 892
796 1 893 1
… …
853 return 1; 950 return 1;
854 } 951 }
855 952
856 # reject 953 # reject
857 if ($reject && $$rbuf =~ $reject) { 954 if ($reject && $$rbuf =~ $reject) {
858 $! = &Errno::EBADMSG; 955 $self->_error (&Errno::EBADMSG);
859 $self->error;
860 } 956 }
861 957
862 # skip 958 # skip
863 if ($skip && $$rbuf =~ $skip) { 959 if ($skip && $$rbuf =~ $skip) {
864 $data .= substr $$rbuf, 0, $+[0], ""; 960 $data .= substr $$rbuf, 0, $+[0], "";
… …
941In rare cases you actually do not want to read anything from the 1037In rare cases you actually do not want to read anything from the
942socket. In this case you can call C<stop_read>. Neither C<on_read> no 1038socket. In this case you can call C<stop_read>. Neither C<on_read> no
943any queued callbacks will be executed then. To start reading again, call 1039any queued callbacks will be executed then. To start reading again, call
944C<start_read>. 1040C<start_read>.
945 1041
1042Note that AnyEvent::Handle will automatically C<start_read> for you when
1043you change the C<on_read> callback or push/unshift a read callback, and it
1044will automatically C<stop_read> for you when neither C<on_read> is set nor
1045there are any read requests in the queue.
1046
946=cut 1047=cut
947 1048
948sub stop_read { 1049sub stop_read {
949 my ($self) = @_; 1050 my ($self) = @_;
950 1051
… …
960 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1061 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
961 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1062 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
962 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1063 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
963 1064
964 if ($len > 0) { 1065 if ($len > 0) {
1066 $self->{_activity} = AnyEvent->now;
1067
965 $self->{filter_r} 1068 $self->{filter_r}
966 ? $self->{filter_r}->($self, $rbuf) 1069 ? $self->{filter_r}($self, $rbuf)
967 : $self->_drain_rbuf; 1070 : $self->_drain_rbuf;
968 1071
969 } elsif (defined $len) { 1072 } elsif (defined $len) {
970 delete $self->{_rw}; 1073 delete $self->{_rw};
971 $self->{_eof} = 1; 1074 $self->{_eof} = 1;
972 $self->_drain_rbuf; 1075 $self->_drain_rbuf;
973 1076
974 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) { 1077 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
975 return $self->error; 1078 return $self->_error ($!, 1);
976 } 1079 }
977 }); 1080 });
978 } 1081 }
979} 1082}
980 1083
981sub _dotls { 1084sub _dotls {
982 my ($self) = @_; 1085 my ($self) = @_;
1086
1087 my $buf;
983 1088
984 if (length $self->{_tls_wbuf}) { 1089 if (length $self->{_tls_wbuf}) {
985 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1090 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
986 substr $self->{_tls_wbuf}, 0, $len, ""; 1091 substr $self->{_tls_wbuf}, 0, $len, "";
987 } 1092 }
988 } 1093 }
989 1094
990 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1095 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
991 $self->{wbuf} .= $buf; 1096 $self->{wbuf} .= $buf;
992 $self->_drain_wbuf; 1097 $self->_drain_wbuf;
993 } 1098 }
994 1099
995 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1100 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1101 if (length $buf) {
996 $self->{rbuf} .= $buf; 1102 $self->{rbuf} .= $buf;
997 $self->_drain_rbuf; 1103 $self->_drain_rbuf;
1104 } else {
1105 # let's treat SSL-eof as we treat normal EOF
1106 $self->{_eof} = 1;
1107 $self->_shutdown;
1108 return;
1109 }
998 } 1110 }
999 1111
1000 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1112 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1001 1113
1002 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1114 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1003 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1115 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1004 $self->error; 1116 return $self->_error ($!, 1);
1005 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1117 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1006 $! = &Errno::EIO; 1118 return $self->_error (&Errno::EIO, 1);
1007 $self->error;
1008 } 1119 }
1009 1120
1010 # all others are fine for our purposes 1121 # all others are fine for our purposes
1011 } 1122 }
1012} 1123}
… …
1027call and can be used or changed to your liking. Note that the handshake 1138call and can be used or changed to your liking. Note that the handshake
1028might have already started when this function returns. 1139might have already started when this function returns.
1029 1140
1030=cut 1141=cut
1031 1142
1032# TODO: maybe document...
1033sub starttls { 1143sub starttls {
1034 my ($self, $ssl, $ctx) = @_; 1144 my ($self, $ssl, $ctx) = @_;
1035 1145
1036 $self->stoptls; 1146 $self->stoptls;
1037 1147

Diff Legend

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