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.56 by root, Wed Jun 4 09:55:16 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.12;
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
… …
228# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop 229# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
229# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop 230# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
230# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop 231# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
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
233 $self->{_activity} = time; 234 $self->{_activity} = AnyEvent->now;
234 $self->_timeout; 235 $self->_timeout;
235 236
236 $self->start_read; 237 $self->start_read;
237 238
238 $self 239 $self
239} 240}
240 241
241sub _shutdown { 242sub _shutdown {
242 my ($self) = @_; 243 my ($self) = @_;
243 244
245 delete $self->{_tw};
244 delete $self->{_rw}; 246 delete $self->{_rw};
245 delete $self->{_ww}; 247 delete $self->{_ww};
246 delete $self->{fh}; 248 delete $self->{fh};
247}
248 249
250 $self->stoptls;
251}
252
249sub error { 253sub _error {
250 my ($self) = @_; 254 my ($self, $errno, $fatal) = @_;
251 255
252 {
253 local $!;
254 $self->_shutdown; 256 $self->_shutdown
255 } 257 if $fatal;
256 258
257 $self->{on_error}($self) 259 $! = $errno;
260
258 if $self->{on_error}; 261 if ($self->{on_error}) {
259 262 $self->{on_error}($self, $fatal);
263 } else {
260 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 264 Carp::croak "AnyEvent::Handle uncaught error: $!";
265 }
261} 266}
262 267
263=item $fh = $handle->fh 268=item $fh = $handle->fh
264 269
265This method returns the file handle of the L<AnyEvent::Handle> object. 270This method returns the file handle of the L<AnyEvent::Handle> object.
… …
319# also check for time-outs 324# also check for time-outs
320sub _timeout { 325sub _timeout {
321 my ($self) = @_; 326 my ($self) = @_;
322 327
323 if ($self->{timeout}) { 328 if ($self->{timeout}) {
324 my $NOW = time; 329 my $NOW = AnyEvent->now;
325 330
326 # when would the timeout trigger? 331 # when would the timeout trigger?
327 my $after = $self->{_activity} + $self->{timeout} - $NOW; 332 my $after = $self->{_activity} + $self->{timeout} - $NOW;
328
329 warn "next to in $after\n";#d#
330 333
331 # now or in the past already? 334 # now or in the past already?
332 if ($after <= 0) { 335 if ($after <= 0) {
333 $self->{_activity} = $NOW; 336 $self->{_activity} = $NOW;
334 337
335 if ($self->{on_timeout}) { 338 if ($self->{on_timeout}) {
336 $self->{on_timeout}->($self); 339 $self->{on_timeout}($self);
337 } else { 340 } else {
338 $! = Errno::ETIMEDOUT; 341 $self->_error (&Errno::ETIMEDOUT);
339 $self->error;
340 } 342 }
341 343
342 # callbakx could have changed timeout value, optimise 344 # callback could have changed timeout value, optimise
343 return unless $self->{timeout}; 345 return unless $self->{timeout};
344 346
345 # calculate new after 347 # calculate new after
346 $after = $self->{timeout}; 348 $after = $self->{timeout};
347 } 349 }
348 350
349 Scalar::Util::weaken $self; 351 Scalar::Util::weaken $self;
352 return unless $self; # ->error could have destroyed $self
350 353
351 warn "after $after\n";#d#
352 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub { 354 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
353 delete $self->{_tw}; 355 delete $self->{_tw};
354 $self->_timeout; 356 $self->_timeout;
355 }); 357 });
356 } else { 358 } else {
… …
410 my $len = syswrite $self->{fh}, $self->{wbuf}; 412 my $len = syswrite $self->{fh}, $self->{wbuf};
411 413
412 if ($len >= 0) { 414 if ($len >= 0) {
413 substr $self->{wbuf}, 0, $len, ""; 415 substr $self->{wbuf}, 0, $len, "";
414 416
415 $self->{_activity} = time; 417 $self->{_activity} = AnyEvent->now;
416 418
417 $self->{on_drain}($self) 419 $self->{on_drain}($self)
418 if $self->{low_water_mark} >= length $self->{wbuf} 420 if $self->{low_water_mark} >= length $self->{wbuf}
419 && $self->{on_drain}; 421 && $self->{on_drain};
420 422
421 delete $self->{_ww} unless length $self->{wbuf}; 423 delete $self->{_ww} unless length $self->{wbuf};
422 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 424 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
423 $self->error; 425 $self->_error ($!, 1);
424 } 426 }
425 }; 427 };
426 428
427 # try to write data immediately 429 # try to write data immediately
428 $cb->(); 430 $cb->();
… …
448 @_ = ($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")
449 ->($self, @_); 451 ->($self, @_);
450 } 452 }
451 453
452 if ($self->{filter_w}) { 454 if ($self->{filter_w}) {
453 $self->{filter_w}->($self, \$_[0]); 455 $self->{filter_w}($self, \$_[0]);
454 } else { 456 } else {
455 $self->{wbuf} .= $_[0]; 457 $self->{wbuf} .= $_[0];
456 $self->_drain_wbuf; 458 $self->_drain_wbuf;
457 } 459 }
458} 460}
459 461
460=item $handle->push_write (type => @args) 462=item $handle->push_write (type => @args)
461 463
462=item $handle->unshift_write (type => @args)
463
464Instead 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
465the job by specifying a type and type-specific arguments. 465the job by specifying a type and type-specific arguments.
466 466
467Predefined 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
468drop by and tell us): 468drop by and tell us):
… …
471 471
472=item netstring => $string 472=item netstring => $string
473 473
474Formats the given value as netstring 474Formats the given value as netstring
475(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).
476
477=back
478 476
479=cut 477=cut
480 478
481register_write_type netstring => sub { 479register_write_type netstring => sub {
482 my ($self, $string) = @_; 480 my ($self, $string) = @_;
… …
523 521
524 $self->{json} ? $self->{json}->encode ($ref) 522 $self->{json} ? $self->{json}->encode ($ref)
525 : JSON::encode_json ($ref) 523 : JSON::encode_json ($ref)
526}; 524};
527 525
526=back
527
528=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 528=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
529 529
530This 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>.
531Whenever 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
532reference with the handle object and the remaining arguments. 532reference with the handle object and the remaining arguments.
… …
569the specified number of bytes which give an XML datagram. 569the specified number of bytes which give an XML datagram.
570 570
571 # in the default state, expect some header bytes 571 # in the default state, expect some header bytes
572 $handle->on_read (sub { 572 $handle->on_read (sub {
573 # 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)
574 shift->unshift_read_chunk (4, sub { 574 shift->unshift_read (chunk => 4, sub {
575 # header arrived, decode 575 # header arrived, decode
576 my $len = unpack "N", $_[1]; 576 my $len = unpack "N", $_[1];
577 577
578 # now read the payload 578 # now read the payload
579 shift->unshift_read_chunk ($len, sub { 579 shift->unshift_read (chunk => $len, sub {
580 my $xml = $_[1]; 580 my $xml = $_[1];
581 # handle xml 581 # handle xml
582 }); 582 });
583 }); 583 });
584 }); 584 });
… …
591 591
592 # request one 592 # request one
593 $handle->push_write ("request 1\015\012"); 593 $handle->push_write ("request 1\015\012");
594 594
595 # 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
596 $handle->push_read_line (sub { 596 $handle->push_read (line => sub {
597 # if we got an "OK", we have to _prepend_ another line, 597 # 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 598 # 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 599 # which are already in the queue when this callback is called
600 # we don't do this in case we got an error 600 # we don't do this in case we got an error
601 if ($_[1] eq "OK") { 601 if ($_[1] eq "OK") {
602 $_[0]->unshift_read_line (sub { 602 $_[0]->unshift_read (line => sub {
603 my $response = $_[1]; 603 my $response = $_[1];
604 ... 604 ...
605 }); 605 });
606 } 606 }
607 }); 607 });
608 608
609 # request two 609 # request two
610 $handle->push_write ("request 2\015\012"); 610 $handle->push_write ("request 2\015\012");
611 611
612 # simply read 64 bytes, always 612 # simply read 64 bytes, always
613 $handle->push_read_chunk (64, sub { 613 $handle->push_read (chunk => 64, sub {
614 my $response = $_[1]; 614 my $response = $_[1];
615 ... 615 ...
616 }); 616 });
617 617
618=over 4 618=over 4
… …
624 624
625 if ( 625 if (
626 defined $self->{rbuf_max} 626 defined $self->{rbuf_max}
627 && $self->{rbuf_max} < length $self->{rbuf} 627 && $self->{rbuf_max} < length $self->{rbuf}
628 ) { 628 ) {
629 $! = &Errno::ENOSPC; 629 return $self->_error (&Errno::ENOSPC, 1);
630 $self->error;
631 } 630 }
632 631
633 return if $self->{in_drain}; 632 return if $self->{in_drain};
634 local $self->{in_drain} = 1; 633 local $self->{in_drain} = 1;
635 634
… …
637 no strict 'refs'; 636 no strict 'refs';
638 if (my $cb = shift @{ $self->{_queue} }) { 637 if (my $cb = shift @{ $self->{_queue} }) {
639 unless ($cb->($self)) { 638 unless ($cb->($self)) {
640 if ($self->{_eof}) { 639 if ($self->{_eof}) {
641 # 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)
642 $! = &Errno::EPIPE; 641 return $self->_error (&Errno::EPIPE, 1);
643 $self->error;
644 } 642 }
645 643
646 unshift @{ $self->{_queue} }, $cb; 644 unshift @{ $self->{_queue} }, $cb;
647 return; 645 last;
648 } 646 }
649 } elsif ($self->{on_read}) { 647 } elsif ($self->{on_read}) {
650 $self->{on_read}($self); 648 $self->{on_read}($self);
651 649
652 if ( 650 if (
653 $self->{_eof} # if no further data will arrive
654 && $len == length $self->{rbuf} # and no data has been consumed 651 $len == length $self->{rbuf} # if no data has been consumed
655 && !@{ $self->{_queue} } # and the queue is still empty 652 && !@{ $self->{_queue} } # and the queue is still empty
656 && $self->{on_read} # and we still want to read data 653 && $self->{on_read} # but we still have on_read
657 ) { 654 ) {
655 # no further data will arrive
658 # then no progress can be made 656 # so no progress can be made
659 $! = &Errno::EPIPE; 657 return $self->_error (&Errno::EPIPE, 1)
660 $self->error; 658 if $self->{_eof};
659
660 last; # more data might arrive
661 } 661 }
662 } else { 662 } else {
663 # read side becomes idle 663 # read side becomes idle
664 delete $self->{_rw}; 664 delete $self->{_rw};
665 return; 665 last;
666 } 666 }
667 } 667 }
668 668
669 if ($self->{_eof}) {
670 $self->_shutdown;
671 $self->{on_eof}($self) 669 $self->{on_eof}($self)
672 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} };
673 } 676 }
674} 677}
675 678
676=item $handle->on_read ($cb) 679=item $handle->on_read ($cb)
677 680
… …
867 my ($self, $cb) = @_; 870 my ($self, $cb) = @_;
868 871
869 sub { 872 sub {
870 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 873 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
871 if ($_[0]{rbuf} =~ /[^0-9]/) { 874 if ($_[0]{rbuf} =~ /[^0-9]/) {
872 $! = &Errno::EBADMSG; 875 $self->_error (&Errno::EBADMSG);
873 $self->error;
874 } 876 }
875 return; 877 return;
876 } 878 }
877 879
878 my $len = $1; 880 my $len = $1;
… …
881 my $string = $_[1]; 883 my $string = $_[1];
882 $_[0]->unshift_read (chunk => 1, sub { 884 $_[0]->unshift_read (chunk => 1, sub {
883 if ($_[1] eq ",") { 885 if ($_[1] eq ",") {
884 $cb->($_[0], $string); 886 $cb->($_[0], $string);
885 } else { 887 } else {
886 $! = &Errno::EBADMSG; 888 $self->_error (&Errno::EBADMSG);
887 $self->error;
888 } 889 }
889 }); 890 });
890 }); 891 });
891 892
892 1 893 1
… …
949 return 1; 950 return 1;
950 } 951 }
951 952
952 # reject 953 # reject
953 if ($reject && $$rbuf =~ $reject) { 954 if ($reject && $$rbuf =~ $reject) {
954 $! = &Errno::EBADMSG; 955 $self->_error (&Errno::EBADMSG);
955 $self->error;
956 } 956 }
957 957
958 # skip 958 # skip
959 if ($skip && $$rbuf =~ $skip) { 959 if ($skip && $$rbuf =~ $skip) {
960 $data .= substr $$rbuf, 0, $+[0], ""; 960 $data .= substr $$rbuf, 0, $+[0], "";
… …
1037In 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
1038socket. 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
1039any queued callbacks will be executed then. To start reading again, call 1039any queued callbacks will be executed then. To start reading again, call
1040C<start_read>. 1040C<start_read>.
1041 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
1042=cut 1047=cut
1043 1048
1044sub stop_read { 1049sub stop_read {
1045 my ($self) = @_; 1050 my ($self) = @_;
1046 1051
… …
1056 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1061 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
1057 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1062 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
1058 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;
1059 1064
1060 if ($len > 0) { 1065 if ($len > 0) {
1061 $self->{_activity} = time; 1066 $self->{_activity} = AnyEvent->now;
1062 1067
1063 $self->{filter_r} 1068 $self->{filter_r}
1064 ? $self->{filter_r}->($self, $rbuf) 1069 ? $self->{filter_r}($self, $rbuf)
1065 : $self->_drain_rbuf; 1070 : $self->_drain_rbuf;
1066 1071
1067 } elsif (defined $len) { 1072 } elsif (defined $len) {
1068 delete $self->{_rw}; 1073 delete $self->{_rw};
1069 delete $self->{_ww};
1070 delete $self->{_tw};
1071 $self->{_eof} = 1; 1074 $self->{_eof} = 1;
1072 $self->_drain_rbuf; 1075 $self->_drain_rbuf;
1073 1076
1074 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1077 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1075 return $self->error; 1078 return $self->_error ($!, 1);
1076 } 1079 }
1077 }); 1080 });
1078 } 1081 }
1079} 1082}
1080 1083
1081sub _dotls { 1084sub _dotls {
1082 my ($self) = @_; 1085 my ($self) = @_;
1086
1087 my $buf;
1083 1088
1084 if (length $self->{_tls_wbuf}) { 1089 if (length $self->{_tls_wbuf}) {
1085 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) {
1086 substr $self->{_tls_wbuf}, 0, $len, ""; 1091 substr $self->{_tls_wbuf}, 0, $len, "";
1087 } 1092 }
1088 } 1093 }
1089 1094
1090 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1095 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1091 $self->{wbuf} .= $buf; 1096 $self->{wbuf} .= $buf;
1092 $self->_drain_wbuf; 1097 $self->_drain_wbuf;
1093 } 1098 }
1094 1099
1095 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1100 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1101 if (length $buf) {
1096 $self->{rbuf} .= $buf; 1102 $self->{rbuf} .= $buf;
1097 $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 }
1098 } 1110 }
1099 1111
1100 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1112 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1101 1113
1102 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1114 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1103 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1115 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1104 $self->error; 1116 return $self->_error ($!, 1);
1105 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1117 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1106 $! = &Errno::EIO; 1118 return $self->_error (&Errno::EIO, 1);
1107 $self->error;
1108 } 1119 }
1109 1120
1110 # all others are fine for our purposes 1121 # all others are fine for our purposes
1111 } 1122 }
1112} 1123}
… …
1127call 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
1128might have already started when this function returns. 1139might have already started when this function returns.
1129 1140
1130=cut 1141=cut
1131 1142
1132# TODO: maybe document...
1133sub starttls { 1143sub starttls {
1134 my ($self, $ssl, $ctx) = @_; 1144 my ($self, $ssl, $ctx) = @_;
1135 1145
1136 $self->stoptls; 1146 $self->stoptls;
1137 1147

Diff Legend

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