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.43 by root, Wed May 28 23:57:38 2008 UTC vs.
Revision 1.58 by root, Wed Jun 4 22:51:15 2008 UTC

… …
7use AnyEvent::Util qw(WSAEWOULDBLOCK); 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);
12use Time::HiRes qw(time);
13 12
14=head1 NAME 13=head1 NAME
15 14
16AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
17 16
18=cut 17=cut
19 18
20our $VERSION = '0.04'; 19our $VERSION = 4.13;
21 20
22=head1 SYNOPSIS 21=head1 SYNOPSIS
23 22
24 use AnyEvent; 23 use AnyEvent;
25 use AnyEvent::Handle; 24 use AnyEvent::Handle;
… …
76NOTE: The filehandle will be set to non-blocking (using 75NOTE: The filehandle will be set to non-blocking (using
77AnyEvent::Util::fh_nonblocking). 76AnyEvent::Util::fh_nonblocking).
78 77
79=item on_eof => $cb->($handle) 78=item on_eof => $cb->($handle)
80 79
81Set 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.
82 83
83While not mandatory, it is highly recommended to set an eof callback, 84While not mandatory, it is highly recommended to set an eof callback,
84otherwise 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
85waiting for data. 86waiting for data.
86 87
87=item on_error => $cb->($handle) 88=item on_error => $cb->($handle, $fatal)
88 89
89This 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
90occurs, such as not being able to resolve the hostname, failure to connect 91occured, such as not being able to resolve the hostname, failure to
91or a read error. 92connect or a read error.
92 93
93The 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
94called. 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.
95 99
96On callback entrance, the value of C<$!> contains the operating system 100On callback entrance, the value of C<$!> contains the operating system
97error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>). 101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
98 102
99The callback should throw an exception. If it returns, then
100AnyEvent::Handle will C<croak> for you.
101
102While 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
103you will not be notified of errors otherwise. The default simply calls 104you will not be notified of errors otherwise. The default simply calls
104die. 105C<croak>.
105 106
106=item on_read => $cb->($handle) 107=item on_read => $cb->($handle)
107 108
108This sets the default read callback, which is called when data arrives 109This sets the default read callback, which is called when data arrives
109and no read request is in the queue. 110and no read request is in the queue.
… …
126=item timeout => $fractional_seconds 127=item timeout => $fractional_seconds
127 128
128If non-zero, then this enables an "inactivity" timeout: whenever this many 129If non-zero, then this enables an "inactivity" timeout: whenever this many
129seconds pass without a successful read or write on the underlying file 130seconds pass without a successful read or write on the underlying file
130handle, the C<on_timeout> callback will be invoked (and if that one is 131handle, the C<on_timeout> callback will be invoked (and if that one is
131missing, an C<ETIMEDOUT> errror will be raised). 132missing, an C<ETIMEDOUT> error will be raised).
132 133
133Note that timeout processing is also active when you currently do not have 134Note that timeout processing is also active when you currently do not have
134any outstanding read or write requests: If you plan to keep the connection 135any outstanding read or write requests: If you plan to keep the connection
135idle then you should disable the timout temporarily or ignore the timeout 136idle then you should disable the timout temporarily or ignore the timeout
136in the C<on_timeout> callback. 137in the C<on_timeout> callback.
… …
156isn't finished). 157isn't finished).
157 158
158=item read_size => <bytes> 159=item read_size => <bytes>
159 160
160The 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
161on each [loop iteration). Default: C<4096>. 162during each (loop iteration). Default: C<8192>.
162 163
163=item low_water_mark => <bytes> 164=item low_water_mark => <bytes>
164 165
165Sets 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
166buffer: 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
… …
223 if ($self->{tls}) { 224 if ($self->{tls}) {
224 require Net::SSLeay; 225 require Net::SSLeay;
225 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 226 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
226 } 227 }
227 228
228# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop 229 $self->{_activity} = AnyEvent->now;
229# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop 230 $self->_timeout;
230# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop 231
231 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
232 233 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
233 $self->{_activity} = time;
234 $self->_timeout;
235
236 $self->start_read;
237 234
238 $self 235 $self
239} 236}
240 237
241sub _shutdown { 238sub _shutdown {
242 my ($self) = @_; 239 my ($self) = @_;
243 240
241 delete $self->{_tw};
244 delete $self->{_rw}; 242 delete $self->{_rw};
245 delete $self->{_ww}; 243 delete $self->{_ww};
246 delete $self->{fh}; 244 delete $self->{fh};
247}
248 245
246 $self->stoptls;
247}
248
249sub error { 249sub _error {
250 my ($self) = @_; 250 my ($self, $errno, $fatal) = @_;
251 251
252 {
253 local $!;
254 $self->_shutdown; 252 $self->_shutdown
255 } 253 if $fatal;
256 254
257 $self->{on_error}($self) 255 $! = $errno;
256
258 if $self->{on_error}; 257 if ($self->{on_error}) {
259 258 $self->{on_error}($self, $fatal);
259 } else {
260 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 260 Carp::croak "AnyEvent::Handle uncaught error: $!";
261 }
261} 262}
262 263
263=item $fh = $handle->fh 264=item $fh = $handle->fh
264 265
265This method returns the file handle of the L<AnyEvent::Handle> object. 266This method returns the file handle of the L<AnyEvent::Handle> object.
… …
319# also check for time-outs 320# also check for time-outs
320sub _timeout { 321sub _timeout {
321 my ($self) = @_; 322 my ($self) = @_;
322 323
323 if ($self->{timeout}) { 324 if ($self->{timeout}) {
324 my $NOW = time; 325 my $NOW = AnyEvent->now;
325 326
326 # when would the timeout trigger? 327 # when would the timeout trigger?
327 my $after = $self->{_activity} + $self->{timeout} - $NOW; 328 my $after = $self->{_activity} + $self->{timeout} - $NOW;
328
329 warn "next to in $after\n";#d#
330 329
331 # now or in the past already? 330 # now or in the past already?
332 if ($after <= 0) { 331 if ($after <= 0) {
333 $self->{_activity} = $NOW; 332 $self->{_activity} = $NOW;
334 333
335 if ($self->{on_timeout}) { 334 if ($self->{on_timeout}) {
336 $self->{on_timeout}->($self); 335 $self->{on_timeout}($self);
337 } else { 336 } else {
338 $! = Errno::ETIMEDOUT; 337 $self->_error (&Errno::ETIMEDOUT);
339 $self->error;
340 } 338 }
341 339
342 # callbakx could have changed timeout value, optimise 340 # callback could have changed timeout value, optimise
343 return unless $self->{timeout}; 341 return unless $self->{timeout};
344 342
345 # calculate new after 343 # calculate new after
346 $after = $self->{timeout}; 344 $after = $self->{timeout};
347 } 345 }
348 346
349 Scalar::Util::weaken $self; 347 Scalar::Util::weaken $self;
348 return unless $self; # ->error could have destroyed $self
350 349
351 warn "after $after\n";#d#
352 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub { 350 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
353 delete $self->{_tw}; 351 delete $self->{_tw};
354 $self->_timeout; 352 $self->_timeout;
355 }); 353 });
356 } else { 354 } else {
… …
410 my $len = syswrite $self->{fh}, $self->{wbuf}; 408 my $len = syswrite $self->{fh}, $self->{wbuf};
411 409
412 if ($len >= 0) { 410 if ($len >= 0) {
413 substr $self->{wbuf}, 0, $len, ""; 411 substr $self->{wbuf}, 0, $len, "";
414 412
415 $self->{_activity} = time; 413 $self->{_activity} = AnyEvent->now;
416 414
417 $self->{on_drain}($self) 415 $self->{on_drain}($self)
418 if $self->{low_water_mark} >= length $self->{wbuf} 416 if $self->{low_water_mark} >= length $self->{wbuf}
419 && $self->{on_drain}; 417 && $self->{on_drain};
420 418
421 delete $self->{_ww} unless length $self->{wbuf}; 419 delete $self->{_ww} unless length $self->{wbuf};
422 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 420 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
423 $self->error; 421 $self->_error ($!, 1);
424 } 422 }
425 }; 423 };
426 424
427 # try to write data immediately 425 # try to write data immediately
428 $cb->(); 426 $cb->();
… …
448 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 446 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
449 ->($self, @_); 447 ->($self, @_);
450 } 448 }
451 449
452 if ($self->{filter_w}) { 450 if ($self->{filter_w}) {
453 $self->{filter_w}->($self, \$_[0]); 451 $self->{filter_w}($self, \$_[0]);
454 } else { 452 } else {
455 $self->{wbuf} .= $_[0]; 453 $self->{wbuf} .= $_[0];
456 $self->_drain_wbuf; 454 $self->_drain_wbuf;
457 } 455 }
458} 456}
459 457
460=item $handle->push_write (type => @args) 458=item $handle->push_write (type => @args)
461 459
462=item $handle->unshift_write (type => @args)
463
464Instead of formatting your data yourself, you can also let this module do 460Instead of formatting your data yourself, you can also let this module do
465the job by specifying a type and type-specific arguments. 461the job by specifying a type and type-specific arguments.
466 462
467Predefined types are (if you have ideas for additional types, feel free to 463Predefined types are (if you have ideas for additional types, feel free to
468drop by and tell us): 464drop by and tell us):
… …
471 467
472=item netstring => $string 468=item netstring => $string
473 469
474Formats the given value as netstring 470Formats the given value as netstring
475(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 471(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
476
477=back
478 472
479=cut 473=cut
480 474
481register_write_type netstring => sub { 475register_write_type netstring => sub {
482 my ($self, $string) = @_; 476 my ($self, $string) = @_;
… …
523 517
524 $self->{json} ? $self->{json}->encode ($ref) 518 $self->{json} ? $self->{json}->encode ($ref)
525 : JSON::encode_json ($ref) 519 : JSON::encode_json ($ref)
526}; 520};
527 521
522=back
523
528=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 524=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
529 525
530This function (not method) lets you add your own types to C<push_write>. 526This function (not method) lets you add your own types to C<push_write>.
531Whenever the given C<type> is used, C<push_write> will invoke the code 527Whenever the given C<type> is used, C<push_write> will invoke the code
532reference with the handle object and the remaining arguments. 528reference with the handle object and the remaining arguments.
… …
569the specified number of bytes which give an XML datagram. 565the specified number of bytes which give an XML datagram.
570 566
571 # in the default state, expect some header bytes 567 # in the default state, expect some header bytes
572 $handle->on_read (sub { 568 $handle->on_read (sub {
573 # some data is here, now queue the length-header-read (4 octets) 569 # some data is here, now queue the length-header-read (4 octets)
574 shift->unshift_read_chunk (4, sub { 570 shift->unshift_read (chunk => 4, sub {
575 # header arrived, decode 571 # header arrived, decode
576 my $len = unpack "N", $_[1]; 572 my $len = unpack "N", $_[1];
577 573
578 # now read the payload 574 # now read the payload
579 shift->unshift_read_chunk ($len, sub { 575 shift->unshift_read (chunk => $len, sub {
580 my $xml = $_[1]; 576 my $xml = $_[1];
581 # handle xml 577 # handle xml
582 }); 578 });
583 }); 579 });
584 }); 580 });
… …
591 587
592 # request one 588 # request one
593 $handle->push_write ("request 1\015\012"); 589 $handle->push_write ("request 1\015\012");
594 590
595 # we expect "ERROR" or "OK" as response, so push a line read 591 # we expect "ERROR" or "OK" as response, so push a line read
596 $handle->push_read_line (sub { 592 $handle->push_read (line => sub {
597 # if we got an "OK", we have to _prepend_ another line, 593 # if we got an "OK", we have to _prepend_ another line,
598 # so it will be read before the second request reads its 64 bytes 594 # so it will be read before the second request reads its 64 bytes
599 # which are already in the queue when this callback is called 595 # which are already in the queue when this callback is called
600 # we don't do this in case we got an error 596 # we don't do this in case we got an error
601 if ($_[1] eq "OK") { 597 if ($_[1] eq "OK") {
602 $_[0]->unshift_read_line (sub { 598 $_[0]->unshift_read (line => sub {
603 my $response = $_[1]; 599 my $response = $_[1];
604 ... 600 ...
605 }); 601 });
606 } 602 }
607 }); 603 });
608 604
609 # request two 605 # request two
610 $handle->push_write ("request 2\015\012"); 606 $handle->push_write ("request 2\015\012");
611 607
612 # simply read 64 bytes, always 608 # simply read 64 bytes, always
613 $handle->push_read_chunk (64, sub { 609 $handle->push_read (chunk => 64, sub {
614 my $response = $_[1]; 610 my $response = $_[1];
615 ... 611 ...
616 }); 612 });
617 613
618=over 4 614=over 4
… …
624 620
625 if ( 621 if (
626 defined $self->{rbuf_max} 622 defined $self->{rbuf_max}
627 && $self->{rbuf_max} < length $self->{rbuf} 623 && $self->{rbuf_max} < length $self->{rbuf}
628 ) { 624 ) {
629 $! = &Errno::ENOSPC; 625 return $self->_error (&Errno::ENOSPC, 1);
630 $self->error;
631 } 626 }
632 627
633 return if $self->{in_drain}; 628 return if $self->{in_drain};
634 local $self->{in_drain} = 1; 629 local $self->{in_drain} = 1;
635 630
… …
637 no strict 'refs'; 632 no strict 'refs';
638 if (my $cb = shift @{ $self->{_queue} }) { 633 if (my $cb = shift @{ $self->{_queue} }) {
639 unless ($cb->($self)) { 634 unless ($cb->($self)) {
640 if ($self->{_eof}) { 635 if ($self->{_eof}) {
641 # no progress can be made (not enough data and no data forthcoming) 636 # no progress can be made (not enough data and no data forthcoming)
642 $! = &Errno::EPIPE; 637 return $self->_error (&Errno::EPIPE, 1);
643 $self->error;
644 } 638 }
645 639
646 unshift @{ $self->{_queue} }, $cb; 640 unshift @{ $self->{_queue} }, $cb;
647 return; 641 last;
648 } 642 }
649 } elsif ($self->{on_read}) { 643 } elsif ($self->{on_read}) {
650 $self->{on_read}($self); 644 $self->{on_read}($self);
651 645
652 if ( 646 if (
653 $self->{_eof} # if no further data will arrive
654 && $len == length $self->{rbuf} # and no data has been consumed 647 $len == length $self->{rbuf} # if no data has been consumed
655 && !@{ $self->{_queue} } # and the queue is still empty 648 && !@{ $self->{_queue} } # and the queue is still empty
656 && $self->{on_read} # and we still want to read data 649 && $self->{on_read} # but we still have on_read
657 ) { 650 ) {
651 # no further data will arrive
658 # then no progress can be made 652 # so no progress can be made
659 $! = &Errno::EPIPE; 653 return $self->_error (&Errno::EPIPE, 1)
660 $self->error; 654 if $self->{_eof};
655
656 last; # more data might arrive
661 } 657 }
662 } else { 658 } else {
663 # read side becomes idle 659 # read side becomes idle
664 delete $self->{_rw}; 660 delete $self->{_rw};
665 return; 661 last;
666 } 662 }
667 } 663 }
668 664
669 if ($self->{_eof}) {
670 $self->_shutdown;
671 $self->{on_eof}($self) 665 $self->{on_eof}($self)
672 if $self->{on_eof}; 666 if $self->{_eof} && $self->{on_eof};
667
668 # may need to restart read watcher
669 unless ($self->{_rw}) {
670 $self->start_read
671 if $self->{on_read} || @{ $self->{_queue} };
673 } 672 }
674} 673}
675 674
676=item $handle->on_read ($cb) 675=item $handle->on_read ($cb)
677 676
… …
683 682
684sub on_read { 683sub on_read {
685 my ($self, $cb) = @_; 684 my ($self, $cb) = @_;
686 685
687 $self->{on_read} = $cb; 686 $self->{on_read} = $cb;
687 $self->_drain_rbuf if $cb;
688} 688}
689 689
690=item $handle->rbuf 690=item $handle->rbuf
691 691
692Returns the read buffer (as a modifiable lvalue). 692Returns the read buffer (as a modifiable lvalue).
… …
867 my ($self, $cb) = @_; 867 my ($self, $cb) = @_;
868 868
869 sub { 869 sub {
870 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 870 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
871 if ($_[0]{rbuf} =~ /[^0-9]/) { 871 if ($_[0]{rbuf} =~ /[^0-9]/) {
872 $! = &Errno::EBADMSG; 872 $self->_error (&Errno::EBADMSG);
873 $self->error;
874 } 873 }
875 return; 874 return;
876 } 875 }
877 876
878 my $len = $1; 877 my $len = $1;
… …
881 my $string = $_[1]; 880 my $string = $_[1];
882 $_[0]->unshift_read (chunk => 1, sub { 881 $_[0]->unshift_read (chunk => 1, sub {
883 if ($_[1] eq ",") { 882 if ($_[1] eq ",") {
884 $cb->($_[0], $string); 883 $cb->($_[0], $string);
885 } else { 884 } else {
886 $! = &Errno::EBADMSG; 885 $self->_error (&Errno::EBADMSG);
887 $self->error;
888 } 886 }
889 }); 887 });
890 }); 888 });
891 889
892 1 890 1
… …
949 return 1; 947 return 1;
950 } 948 }
951 949
952 # reject 950 # reject
953 if ($reject && $$rbuf =~ $reject) { 951 if ($reject && $$rbuf =~ $reject) {
954 $! = &Errno::EBADMSG; 952 $self->_error (&Errno::EBADMSG);
955 $self->error;
956 } 953 }
957 954
958 # skip 955 # skip
959 if ($skip && $$rbuf =~ $skip) { 956 if ($skip && $$rbuf =~ $skip) {
960 $data .= substr $$rbuf, 0, $+[0], ""; 957 $data .= substr $$rbuf, 0, $+[0], "";
… …
1033=item $handle->stop_read 1030=item $handle->stop_read
1034 1031
1035=item $handle->start_read 1032=item $handle->start_read
1036 1033
1037In rare cases you actually do not want to read anything from the 1034In rare cases you actually do not want to read anything from the
1038socket. In this case you can call C<stop_read>. Neither C<on_read> no 1035socket. In this case you can call C<stop_read>. Neither C<on_read> nor
1039any queued callbacks will be executed then. To start reading again, call 1036any queued callbacks will be executed then. To start reading again, call
1040C<start_read>. 1037C<start_read>.
1038
1039Note that AnyEvent::Handle will automatically C<start_read> for you when
1040you change the C<on_read> callback or push/unshift a read callback, and it
1041will automatically C<stop_read> for you when neither C<on_read> is set nor
1042there are any read requests in the queue.
1041 1043
1042=cut 1044=cut
1043 1045
1044sub stop_read { 1046sub stop_read {
1045 my ($self) = @_; 1047 my ($self) = @_;
… …
1056 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1058 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
1057 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1059 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
1058 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1060 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
1059 1061
1060 if ($len > 0) { 1062 if ($len > 0) {
1061 $self->{_activity} = time; 1063 $self->{_activity} = AnyEvent->now;
1062 1064
1063 $self->{filter_r} 1065 $self->{filter_r}
1064 ? $self->{filter_r}->($self, $rbuf) 1066 ? $self->{filter_r}($self, $rbuf)
1065 : $self->_drain_rbuf; 1067 : $self->_drain_rbuf;
1066 1068
1067 } elsif (defined $len) { 1069 } elsif (defined $len) {
1068 delete $self->{_rw}; 1070 delete $self->{_rw};
1069 delete $self->{_ww};
1070 delete $self->{_tw};
1071 $self->{_eof} = 1; 1071 $self->{_eof} = 1;
1072 $self->_drain_rbuf; 1072 $self->_drain_rbuf;
1073 1073
1074 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1074 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1075 return $self->error; 1075 return $self->_error ($!, 1);
1076 } 1076 }
1077 }); 1077 });
1078 } 1078 }
1079} 1079}
1080 1080
1081sub _dotls { 1081sub _dotls {
1082 my ($self) = @_; 1082 my ($self) = @_;
1083
1084 my $buf;
1083 1085
1084 if (length $self->{_tls_wbuf}) { 1086 if (length $self->{_tls_wbuf}) {
1085 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1087 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
1086 substr $self->{_tls_wbuf}, 0, $len, ""; 1088 substr $self->{_tls_wbuf}, 0, $len, "";
1087 } 1089 }
1088 } 1090 }
1089 1091
1090 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1092 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1091 $self->{wbuf} .= $buf; 1093 $self->{wbuf} .= $buf;
1092 $self->_drain_wbuf; 1094 $self->_drain_wbuf;
1093 } 1095 }
1094 1096
1095 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1097 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1098 if (length $buf) {
1096 $self->{rbuf} .= $buf; 1099 $self->{rbuf} .= $buf;
1097 $self->_drain_rbuf; 1100 $self->_drain_rbuf;
1101 } else {
1102 # let's treat SSL-eof as we treat normal EOF
1103 $self->{_eof} = 1;
1104 $self->_shutdown;
1105 return;
1106 }
1098 } 1107 }
1099 1108
1100 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1109 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1101 1110
1102 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1111 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1103 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1112 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1104 $self->error; 1113 return $self->_error ($!, 1);
1105 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1114 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1106 $! = &Errno::EIO; 1115 return $self->_error (&Errno::EIO, 1);
1107 $self->error;
1108 } 1116 }
1109 1117
1110 # all others are fine for our purposes 1118 # all others are fine for our purposes
1111 } 1119 }
1112} 1120}
… …
1127call and can be used or changed to your liking. Note that the handshake 1135call and can be used or changed to your liking. Note that the handshake
1128might have already started when this function returns. 1136might have already started when this function returns.
1129 1137
1130=cut 1138=cut
1131 1139
1132# TODO: maybe document...
1133sub starttls { 1140sub starttls {
1134 my ($self, $ssl, $ctx) = @_; 1141 my ($self, $ssl, $ctx) = @_;
1135 1142
1136 $self->stoptls; 1143 $self->stoptls;
1137 1144

Diff Legend

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