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.44 by root, Thu May 29 00:00:07 2008 UTC vs.
Revision 1.59 by root, Thu Jun 5 16:53:11 2008 UTC

… …
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.13;
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>, C<ETIMEDOUT> or C<EBADMSG>). 101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97 102
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
100
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.
… …
125=item timeout => $fractional_seconds 127=item timeout => $fractional_seconds
126 128
127If non-zero, then this enables an "inactivity" timeout: whenever this many 129If non-zero, then this enables an "inactivity" timeout: whenever this many
128seconds pass without a successful read or write on the underlying file 130seconds pass without a successful read or write on the underlying file
129handle, 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
130missing, an C<ETIMEDOUT> errror will be raised). 132missing, an C<ETIMEDOUT> error will be raised).
131 133
132Note 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
133any 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
134idle then you should disable the timout temporarily or ignore the timeout 136idle then you should disable the timout temporarily or ignore the timeout
135in the C<on_timeout> callback. 137in the C<on_timeout> callback.
… …
155isn't finished). 157isn't finished).
156 158
157=item read_size => <bytes> 159=item read_size => <bytes>
158 160
159The 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
160on each [loop iteration). Default: C<4096>. 162during each (loop iteration). Default: C<8192>.
161 163
162=item low_water_mark => <bytes> 164=item low_water_mark => <bytes>
163 165
164Sets 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
165buffer: 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
… …
222 if ($self->{tls}) { 224 if ($self->{tls}) {
223 require Net::SSLeay; 225 require Net::SSLeay;
224 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 226 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
225 } 227 }
226 228
227# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
228# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
229# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
230 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
231
232 $self->{_activity} = AnyEvent->now; 229 $self->{_activity} = AnyEvent->now;
233 $self->_timeout; 230 $self->_timeout;
234 231
235 $self->start_read; 232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
233 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
236 234
237 $self 235 $self
238} 236}
239 237
240sub _shutdown { 238sub _shutdown {
241 my ($self) = @_; 239 my ($self) = @_;
242 240
241 delete $self->{_tw};
243 delete $self->{_rw}; 242 delete $self->{_rw};
244 delete $self->{_ww}; 243 delete $self->{_ww};
245 delete $self->{fh}; 244 delete $self->{fh};
246}
247 245
246 $self->stoptls;
247}
248
248sub error { 249sub _error {
249 my ($self) = @_; 250 my ($self, $errno, $fatal) = @_;
250 251
251 {
252 local $!;
253 $self->_shutdown; 252 $self->_shutdown
254 } 253 if $fatal;
255 254
256 $self->{on_error}($self) 255 $! = $errno;
256
257 if $self->{on_error}; 257 if ($self->{on_error}) {
258 258 $self->{on_error}($self, $fatal);
259 } else {
259 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 260 Carp::croak "AnyEvent::Handle uncaught error: $!";
261 }
260} 262}
261 263
262=item $fh = $handle->fh 264=item $fh = $handle->fh
263 265
264This method returns the file handle of the L<AnyEvent::Handle> object. 266This method returns the file handle of the L<AnyEvent::Handle> object.
… …
328 # now or in the past already? 330 # now or in the past already?
329 if ($after <= 0) { 331 if ($after <= 0) {
330 $self->{_activity} = $NOW; 332 $self->{_activity} = $NOW;
331 333
332 if ($self->{on_timeout}) { 334 if ($self->{on_timeout}) {
333 $self->{on_timeout}->($self); 335 $self->{on_timeout}($self);
334 } else { 336 } else {
335 $! = Errno::ETIMEDOUT; 337 $self->_error (&Errno::ETIMEDOUT);
336 $self->error;
337 } 338 }
338 339
339 # callbakx could have changed timeout value, optimise 340 # callback could have changed timeout value, optimise
340 return unless $self->{timeout}; 341 return unless $self->{timeout};
341 342
342 # calculate new after 343 # calculate new after
343 $after = $self->{timeout}; 344 $after = $self->{timeout};
344 } 345 }
345 346
346 Scalar::Util::weaken $self; 347 Scalar::Util::weaken $self;
348 return unless $self; # ->error could have destroyed $self
347 349
348 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub { 350 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
349 delete $self->{_tw}; 351 delete $self->{_tw};
350 $self->_timeout; 352 $self->_timeout;
351 }); 353 });
… …
414 if $self->{low_water_mark} >= length $self->{wbuf} 416 if $self->{low_water_mark} >= length $self->{wbuf}
415 && $self->{on_drain}; 417 && $self->{on_drain};
416 418
417 delete $self->{_ww} unless length $self->{wbuf}; 419 delete $self->{_ww} unless length $self->{wbuf};
418 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 420 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
419 $self->error; 421 $self->_error ($!, 1);
420 } 422 }
421 }; 423 };
422 424
423 # try to write data immediately 425 # try to write data immediately
424 $cb->(); 426 $cb->();
… …
444 @_ = ($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")
445 ->($self, @_); 447 ->($self, @_);
446 } 448 }
447 449
448 if ($self->{filter_w}) { 450 if ($self->{filter_w}) {
449 $self->{filter_w}->($self, \$_[0]); 451 $self->{filter_w}($self, \$_[0]);
450 } else { 452 } else {
451 $self->{wbuf} .= $_[0]; 453 $self->{wbuf} .= $_[0];
452 $self->_drain_wbuf; 454 $self->_drain_wbuf;
453 } 455 }
454} 456}
455 457
456=item $handle->push_write (type => @args) 458=item $handle->push_write (type => @args)
457 459
458=item $handle->unshift_write (type => @args)
459
460Instead 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
461the job by specifying a type and type-specific arguments. 461the job by specifying a type and type-specific arguments.
462 462
463Predefined 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
464drop by and tell us): 464drop by and tell us):
… …
467 467
468=item netstring => $string 468=item netstring => $string
469 469
470Formats the given value as netstring 470Formats the given value as netstring
471(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).
472
473=back
474 472
475=cut 473=cut
476 474
477register_write_type netstring => sub { 475register_write_type netstring => sub {
478 my ($self, $string) = @_; 476 my ($self, $string) = @_;
… …
519 517
520 $self->{json} ? $self->{json}->encode ($ref) 518 $self->{json} ? $self->{json}->encode ($ref)
521 : JSON::encode_json ($ref) 519 : JSON::encode_json ($ref)
522}; 520};
523 521
522=back
523
524=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 524=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
525 525
526This 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>.
527Whenever 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
528reference with the handle object and the remaining arguments. 528reference with the handle object and the remaining arguments.
… …
565the specified number of bytes which give an XML datagram. 565the specified number of bytes which give an XML datagram.
566 566
567 # in the default state, expect some header bytes 567 # in the default state, expect some header bytes
568 $handle->on_read (sub { 568 $handle->on_read (sub {
569 # 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)
570 shift->unshift_read_chunk (4, sub { 570 shift->unshift_read (chunk => 4, sub {
571 # header arrived, decode 571 # header arrived, decode
572 my $len = unpack "N", $_[1]; 572 my $len = unpack "N", $_[1];
573 573
574 # now read the payload 574 # now read the payload
575 shift->unshift_read_chunk ($len, sub { 575 shift->unshift_read (chunk => $len, sub {
576 my $xml = $_[1]; 576 my $xml = $_[1];
577 # handle xml 577 # handle xml
578 }); 578 });
579 }); 579 });
580 }); 580 });
… …
587 587
588 # request one 588 # request one
589 $handle->push_write ("request 1\015\012"); 589 $handle->push_write ("request 1\015\012");
590 590
591 # 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
592 $handle->push_read_line (sub { 592 $handle->push_read (line => sub {
593 # if we got an "OK", we have to _prepend_ another line, 593 # if we got an "OK", we have to _prepend_ another line,
594 # 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
595 # which are already in the queue when this callback is called 595 # which are already in the queue when this callback is called
596 # we don't do this in case we got an error 596 # we don't do this in case we got an error
597 if ($_[1] eq "OK") { 597 if ($_[1] eq "OK") {
598 $_[0]->unshift_read_line (sub { 598 $_[0]->unshift_read (line => sub {
599 my $response = $_[1]; 599 my $response = $_[1];
600 ... 600 ...
601 }); 601 });
602 } 602 }
603 }); 603 });
604 604
605 # request two 605 # request two
606 $handle->push_write ("request 2\015\012"); 606 $handle->push_write ("request 2\015\012");
607 607
608 # simply read 64 bytes, always 608 # simply read 64 bytes, always
609 $handle->push_read_chunk (64, sub { 609 $handle->push_read (chunk => 64, sub {
610 my $response = $_[1]; 610 my $response = $_[1];
611 ... 611 ...
612 }); 612 });
613 613
614=over 4 614=over 4
615 615
616=cut 616=cut
617 617
618sub _drain_rbuf { 618sub _drain_rbuf {
619 my ($self) = @_; 619 my ($self) = @_;
620
621 local $self->{_in_drain} = 1;
620 622
621 if ( 623 if (
622 defined $self->{rbuf_max} 624 defined $self->{rbuf_max}
623 && $self->{rbuf_max} < length $self->{rbuf} 625 && $self->{rbuf_max} < length $self->{rbuf}
624 ) { 626 ) {
625 $! = &Errno::ENOSPC; 627 return $self->_error (&Errno::ENOSPC, 1);
626 $self->error;
627 } 628 }
628 629
629 return if $self->{in_drain}; 630 while () {
630 local $self->{in_drain} = 1;
631
632 while (my $len = length $self->{rbuf}) {
633 no strict 'refs'; 631 no strict 'refs';
632
633 my $len = length $self->{rbuf};
634
634 if (my $cb = shift @{ $self->{_queue} }) { 635 if (my $cb = shift @{ $self->{_queue} }) {
635 unless ($cb->($self)) { 636 unless ($cb->($self)) {
636 if ($self->{_eof}) { 637 if ($self->{_eof}) {
637 # no progress can be made (not enough data and no data forthcoming) 638 # no progress can be made (not enough data and no data forthcoming)
638 $! = &Errno::EPIPE; 639 return $self->_error (&Errno::EPIPE, 1);
639 $self->error;
640 } 640 }
641 641
642 unshift @{ $self->{_queue} }, $cb; 642 unshift @{ $self->{_queue} }, $cb;
643 return; 643 last;
644 } 644 }
645 } elsif ($self->{on_read}) { 645 } elsif ($self->{on_read}) {
646 $self->{on_read}($self); 646 $self->{on_read}($self);
647 647
648 if ( 648 if (
649 $self->{_eof} # if no further data will arrive
650 && $len == length $self->{rbuf} # and no data has been consumed 649 $len == length $self->{rbuf} # if no data has been consumed
651 && !@{ $self->{_queue} } # and the queue is still empty 650 && !@{ $self->{_queue} } # and the queue is still empty
652 && $self->{on_read} # and we still want to read data 651 && $self->{on_read} # but we still have on_read
653 ) { 652 ) {
653 # no further data will arrive
654 # then no progress can be made 654 # so no progress can be made
655 $! = &Errno::EPIPE; 655 return $self->_error (&Errno::EPIPE, 1)
656 $self->error; 656 if $self->{_eof};
657
658 last; # more data might arrive
657 } 659 }
658 } else { 660 } else {
659 # read side becomes idle 661 # read side becomes idle
660 delete $self->{_rw}; 662 delete $self->{_rw};
661 return; 663 last;
662 } 664 }
663 } 665 }
664 666
665 if ($self->{_eof}) {
666 $self->_shutdown;
667 $self->{on_eof}($self) 667 $self->{on_eof}($self)
668 if $self->{on_eof}; 668 if $self->{_eof} && $self->{on_eof};
669
670 # may need to restart read watcher
671 unless ($self->{_rw}) {
672 $self->start_read
673 if $self->{on_read} || @{ $self->{_queue} };
669 } 674 }
670} 675}
671 676
672=item $handle->on_read ($cb) 677=item $handle->on_read ($cb)
673 678
… …
679 684
680sub on_read { 685sub on_read {
681 my ($self, $cb) = @_; 686 my ($self, $cb) = @_;
682 687
683 $self->{on_read} = $cb; 688 $self->{on_read} = $cb;
689 $self->_drain_rbuf if $cb && !$self->{_in_drain};
684} 690}
685 691
686=item $handle->rbuf 692=item $handle->rbuf
687 693
688Returns the read buffer (as a modifiable lvalue). 694Returns the read buffer (as a modifiable lvalue).
… …
737 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 743 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
738 ->($self, $cb, @_); 744 ->($self, $cb, @_);
739 } 745 }
740 746
741 push @{ $self->{_queue} }, $cb; 747 push @{ $self->{_queue} }, $cb;
742 $self->_drain_rbuf; 748 $self->_drain_rbuf unless $self->{_in_drain};
743} 749}
744 750
745sub unshift_read { 751sub unshift_read {
746 my $self = shift; 752 my $self = shift;
747 my $cb = pop; 753 my $cb = pop;
… …
753 ->($self, $cb, @_); 759 ->($self, $cb, @_);
754 } 760 }
755 761
756 762
757 unshift @{ $self->{_queue} }, $cb; 763 unshift @{ $self->{_queue} }, $cb;
758 $self->_drain_rbuf; 764 $self->_drain_rbuf unless $self->{_in_drain};
759} 765}
760 766
761=item $handle->push_read (type => @args, $cb) 767=item $handle->push_read (type => @args, $cb)
762 768
763=item $handle->unshift_read (type => @args, $cb) 769=item $handle->unshift_read (type => @args, $cb)
… …
863 my ($self, $cb) = @_; 869 my ($self, $cb) = @_;
864 870
865 sub { 871 sub {
866 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 872 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
867 if ($_[0]{rbuf} =~ /[^0-9]/) { 873 if ($_[0]{rbuf} =~ /[^0-9]/) {
868 $! = &Errno::EBADMSG; 874 $self->_error (&Errno::EBADMSG);
869 $self->error;
870 } 875 }
871 return; 876 return;
872 } 877 }
873 878
874 my $len = $1; 879 my $len = $1;
… …
877 my $string = $_[1]; 882 my $string = $_[1];
878 $_[0]->unshift_read (chunk => 1, sub { 883 $_[0]->unshift_read (chunk => 1, sub {
879 if ($_[1] eq ",") { 884 if ($_[1] eq ",") {
880 $cb->($_[0], $string); 885 $cb->($_[0], $string);
881 } else { 886 } else {
882 $! = &Errno::EBADMSG; 887 $self->_error (&Errno::EBADMSG);
883 $self->error;
884 } 888 }
885 }); 889 });
886 }); 890 });
887 891
888 1 892 1
… …
945 return 1; 949 return 1;
946 } 950 }
947 951
948 # reject 952 # reject
949 if ($reject && $$rbuf =~ $reject) { 953 if ($reject && $$rbuf =~ $reject) {
950 $! = &Errno::EBADMSG; 954 $self->_error (&Errno::EBADMSG);
951 $self->error;
952 } 955 }
953 956
954 # skip 957 # skip
955 if ($skip && $$rbuf =~ $skip) { 958 if ($skip && $$rbuf =~ $skip) {
956 $data .= substr $$rbuf, 0, $+[0], ""; 959 $data .= substr $$rbuf, 0, $+[0], "";
… …
1029=item $handle->stop_read 1032=item $handle->stop_read
1030 1033
1031=item $handle->start_read 1034=item $handle->start_read
1032 1035
1033In rare cases you actually do not want to read anything from the 1036In rare cases you actually do not want to read anything from the
1034socket. In this case you can call C<stop_read>. Neither C<on_read> no 1037socket. In this case you can call C<stop_read>. Neither C<on_read> nor
1035any queued callbacks will be executed then. To start reading again, call 1038any queued callbacks will be executed then. To start reading again, call
1036C<start_read>. 1039C<start_read>.
1040
1041Note that AnyEvent::Handle will automatically C<start_read> for you when
1042you change the C<on_read> callback or push/unshift a read callback, and it
1043will automatically C<stop_read> for you when neither C<on_read> is set nor
1044there are any read requests in the queue.
1037 1045
1038=cut 1046=cut
1039 1047
1040sub stop_read { 1048sub stop_read {
1041 my ($self) = @_; 1049 my ($self) = @_;
… …
1055 1063
1056 if ($len > 0) { 1064 if ($len > 0) {
1057 $self->{_activity} = AnyEvent->now; 1065 $self->{_activity} = AnyEvent->now;
1058 1066
1059 $self->{filter_r} 1067 $self->{filter_r}
1060 ? $self->{filter_r}->($self, $rbuf) 1068 ? $self->{filter_r}($self, $rbuf)
1061 : $self->_drain_rbuf; 1069 : $self->{_in_drain} || $self->_drain_rbuf;
1062 1070
1063 } elsif (defined $len) { 1071 } elsif (defined $len) {
1064 delete $self->{_rw}; 1072 delete $self->{_rw};
1065 delete $self->{_ww};
1066 delete $self->{_tw};
1067 $self->{_eof} = 1; 1073 $self->{_eof} = 1;
1068 $self->_drain_rbuf; 1074 $self->_drain_rbuf unless $self->{_in_drain};
1069 1075
1070 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1076 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1071 return $self->error; 1077 return $self->_error ($!, 1);
1072 } 1078 }
1073 }); 1079 });
1074 } 1080 }
1075} 1081}
1076 1082
1077sub _dotls { 1083sub _dotls {
1078 my ($self) = @_; 1084 my ($self) = @_;
1085
1086 my $buf;
1079 1087
1080 if (length $self->{_tls_wbuf}) { 1088 if (length $self->{_tls_wbuf}) {
1081 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1089 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
1082 substr $self->{_tls_wbuf}, 0, $len, ""; 1090 substr $self->{_tls_wbuf}, 0, $len, "";
1083 } 1091 }
1084 } 1092 }
1085 1093
1086 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1094 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1087 $self->{wbuf} .= $buf; 1095 $self->{wbuf} .= $buf;
1088 $self->_drain_wbuf; 1096 $self->_drain_wbuf;
1089 } 1097 }
1090 1098
1091 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1099 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1100 if (length $buf) {
1092 $self->{rbuf} .= $buf; 1101 $self->{rbuf} .= $buf;
1093 $self->_drain_rbuf; 1102 $self->_drain_rbuf unless $self->{_in_drain};
1103 } else {
1104 # let's treat SSL-eof as we treat normal EOF
1105 $self->{_eof} = 1;
1106 $self->_shutdown;
1107 return;
1108 }
1094 } 1109 }
1095 1110
1096 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1111 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1097 1112
1098 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1113 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1099 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1114 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1100 $self->error; 1115 return $self->_error ($!, 1);
1101 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1116 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1102 $! = &Errno::EIO; 1117 return $self->_error (&Errno::EIO, 1);
1103 $self->error;
1104 } 1118 }
1105 1119
1106 # all others are fine for our purposes 1120 # all others are fine for our purposes
1107 } 1121 }
1108} 1122}
… …
1123call and can be used or changed to your liking. Note that the handshake 1137call and can be used or changed to your liking. Note that the handshake
1124might have already started when this function returns. 1138might have already started when this function returns.
1125 1139
1126=cut 1140=cut
1127 1141
1128# TODO: maybe document...
1129sub starttls { 1142sub starttls {
1130 my ($self, $ssl, $ctx) = @_; 1143 my ($self, $ssl, $ctx) = @_;
1131 1144
1132 $self->stoptls; 1145 $self->stoptls;
1133 1146

Diff Legend

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