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.42 by root, Tue May 27 06:23:15 2008 UTC vs.
Revision 1.58 by root, Wed Jun 4 22:51:15 2008 UTC

… …
6use AnyEvent (); 6use AnyEvent ();
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);
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.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> 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->{_activity} = AnyEvent->now;
208 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 230 $self->_timeout;
231
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 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
211 234
212 $self->start_read;
213
214 $self 235 $self
215} 236}
216 237
217sub _shutdown { 238sub _shutdown {
218 my ($self) = @_; 239 my ($self) = @_;
219 240
241 delete $self->{_tw};
220 delete $self->{_rw}; 242 delete $self->{_rw};
221 delete $self->{_ww}; 243 delete $self->{_ww};
222 delete $self->{fh}; 244 delete $self->{fh};
223}
224 245
246 $self->stoptls;
247}
248
225sub error { 249sub _error {
226 my ($self) = @_; 250 my ($self, $errno, $fatal) = @_;
227 251
228 {
229 local $!;
230 $self->_shutdown; 252 $self->_shutdown
231 } 253 if $fatal;
232 254
233 $self->{on_error}($self) 255 $! = $errno;
256
234 if $self->{on_error}; 257 if ($self->{on_error}) {
235 258 $self->{on_error}($self, $fatal);
259 } else {
236 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 260 Carp::croak "AnyEvent::Handle uncaught error: $!";
261 }
237} 262}
238 263
239=item $fh = $handle->fh 264=item $fh = $handle->fh
240 265
241This method returns the file handle of the L<AnyEvent::Handle> object. 266This method returns the file handle of the L<AnyEvent::Handle> object.
… …
260 285
261=cut 286=cut
262 287
263sub on_eof { 288sub on_eof {
264 $_[0]{on_eof} = $_[1]; 289 $_[0]{on_eof} = $_[1];
290}
291
292=item $handle->on_timeout ($cb)
293
294Replace the current C<on_timeout> callback, or disables the callback
295(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
296argument.
297
298=cut
299
300sub on_timeout {
301 $_[0]{on_timeout} = $_[1];
302}
303
304#############################################################################
305
306=item $handle->timeout ($seconds)
307
308Configures (or disables) the inactivity timeout.
309
310=cut
311
312sub timeout {
313 my ($self, $timeout) = @_;
314
315 $self->{timeout} = $timeout;
316 $self->_timeout;
317}
318
319# reset the timeout watcher, as neccessary
320# also check for time-outs
321sub _timeout {
322 my ($self) = @_;
323
324 if ($self->{timeout}) {
325 my $NOW = AnyEvent->now;
326
327 # when would the timeout trigger?
328 my $after = $self->{_activity} + $self->{timeout} - $NOW;
329
330 # now or in the past already?
331 if ($after <= 0) {
332 $self->{_activity} = $NOW;
333
334 if ($self->{on_timeout}) {
335 $self->{on_timeout}($self);
336 } else {
337 $self->_error (&Errno::ETIMEDOUT);
338 }
339
340 # callback could have changed timeout value, optimise
341 return unless $self->{timeout};
342
343 # calculate new after
344 $after = $self->{timeout};
345 }
346
347 Scalar::Util::weaken $self;
348 return unless $self; # ->error could have destroyed $self
349
350 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
351 delete $self->{_tw};
352 $self->_timeout;
353 });
354 } else {
355 delete $self->{_tw};
356 }
265} 357}
266 358
267############################################################################# 359#############################################################################
268 360
269=back 361=back
… …
316 my $len = syswrite $self->{fh}, $self->{wbuf}; 408 my $len = syswrite $self->{fh}, $self->{wbuf};
317 409
318 if ($len >= 0) { 410 if ($len >= 0) {
319 substr $self->{wbuf}, 0, $len, ""; 411 substr $self->{wbuf}, 0, $len, "";
320 412
413 $self->{_activity} = AnyEvent->now;
414
321 $self->{on_drain}($self) 415 $self->{on_drain}($self)
322 if $self->{low_water_mark} >= length $self->{wbuf} 416 if $self->{low_water_mark} >= length $self->{wbuf}
323 && $self->{on_drain}; 417 && $self->{on_drain};
324 418
325 delete $self->{_ww} unless length $self->{wbuf}; 419 delete $self->{_ww} unless length $self->{wbuf};
326 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 420 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
327 $self->error; 421 $self->_error ($!, 1);
328 } 422 }
329 }; 423 };
330 424
331 # try to write data immediately 425 # try to write data immediately
332 $cb->(); 426 $cb->();
… …
352 @_ = ($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")
353 ->($self, @_); 447 ->($self, @_);
354 } 448 }
355 449
356 if ($self->{filter_w}) { 450 if ($self->{filter_w}) {
357 $self->{filter_w}->($self, \$_[0]); 451 $self->{filter_w}($self, \$_[0]);
358 } else { 452 } else {
359 $self->{wbuf} .= $_[0]; 453 $self->{wbuf} .= $_[0];
360 $self->_drain_wbuf; 454 $self->_drain_wbuf;
361 } 455 }
362} 456}
363 457
364=item $handle->push_write (type => @args) 458=item $handle->push_write (type => @args)
365 459
366=item $handle->unshift_write (type => @args)
367
368Instead 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
369the job by specifying a type and type-specific arguments. 461the job by specifying a type and type-specific arguments.
370 462
371Predefined 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
372drop by and tell us): 464drop by and tell us):
… …
375 467
376=item netstring => $string 468=item netstring => $string
377 469
378Formats the given value as netstring 470Formats the given value as netstring
379(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).
380
381=back
382 472
383=cut 473=cut
384 474
385register_write_type netstring => sub { 475register_write_type netstring => sub {
386 my ($self, $string) = @_; 476 my ($self, $string) = @_;
… …
427 517
428 $self->{json} ? $self->{json}->encode ($ref) 518 $self->{json} ? $self->{json}->encode ($ref)
429 : JSON::encode_json ($ref) 519 : JSON::encode_json ($ref)
430}; 520};
431 521
522=back
523
432=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 524=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
433 525
434This 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>.
435Whenever 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
436reference with the handle object and the remaining arguments. 528reference with the handle object and the remaining arguments.
… …
473the specified number of bytes which give an XML datagram. 565the specified number of bytes which give an XML datagram.
474 566
475 # in the default state, expect some header bytes 567 # in the default state, expect some header bytes
476 $handle->on_read (sub { 568 $handle->on_read (sub {
477 # 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)
478 shift->unshift_read_chunk (4, sub { 570 shift->unshift_read (chunk => 4, sub {
479 # header arrived, decode 571 # header arrived, decode
480 my $len = unpack "N", $_[1]; 572 my $len = unpack "N", $_[1];
481 573
482 # now read the payload 574 # now read the payload
483 shift->unshift_read_chunk ($len, sub { 575 shift->unshift_read (chunk => $len, sub {
484 my $xml = $_[1]; 576 my $xml = $_[1];
485 # handle xml 577 # handle xml
486 }); 578 });
487 }); 579 });
488 }); 580 });
… …
495 587
496 # request one 588 # request one
497 $handle->push_write ("request 1\015\012"); 589 $handle->push_write ("request 1\015\012");
498 590
499 # 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
500 $handle->push_read_line (sub { 592 $handle->push_read (line => sub {
501 # if we got an "OK", we have to _prepend_ another line, 593 # 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 594 # 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 595 # which are already in the queue when this callback is called
504 # we don't do this in case we got an error 596 # we don't do this in case we got an error
505 if ($_[1] eq "OK") { 597 if ($_[1] eq "OK") {
506 $_[0]->unshift_read_line (sub { 598 $_[0]->unshift_read (line => sub {
507 my $response = $_[1]; 599 my $response = $_[1];
508 ... 600 ...
509 }); 601 });
510 } 602 }
511 }); 603 });
512 604
513 # request two 605 # request two
514 $handle->push_write ("request 2\015\012"); 606 $handle->push_write ("request 2\015\012");
515 607
516 # simply read 64 bytes, always 608 # simply read 64 bytes, always
517 $handle->push_read_chunk (64, sub { 609 $handle->push_read (chunk => 64, sub {
518 my $response = $_[1]; 610 my $response = $_[1];
519 ... 611 ...
520 }); 612 });
521 613
522=over 4 614=over 4
… …
528 620
529 if ( 621 if (
530 defined $self->{rbuf_max} 622 defined $self->{rbuf_max}
531 && $self->{rbuf_max} < length $self->{rbuf} 623 && $self->{rbuf_max} < length $self->{rbuf}
532 ) { 624 ) {
533 $! = &Errno::ENOSPC; 625 return $self->_error (&Errno::ENOSPC, 1);
534 $self->error;
535 } 626 }
536 627
537 return if $self->{in_drain}; 628 return if $self->{in_drain};
538 local $self->{in_drain} = 1; 629 local $self->{in_drain} = 1;
539 630
… …
541 no strict 'refs'; 632 no strict 'refs';
542 if (my $cb = shift @{ $self->{_queue} }) { 633 if (my $cb = shift @{ $self->{_queue} }) {
543 unless ($cb->($self)) { 634 unless ($cb->($self)) {
544 if ($self->{_eof}) { 635 if ($self->{_eof}) {
545 # 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)
546 $! = &Errno::EPIPE; 637 return $self->_error (&Errno::EPIPE, 1);
547 $self->error;
548 } 638 }
549 639
550 unshift @{ $self->{_queue} }, $cb; 640 unshift @{ $self->{_queue} }, $cb;
551 return; 641 last;
552 } 642 }
553 } elsif ($self->{on_read}) { 643 } elsif ($self->{on_read}) {
554 $self->{on_read}($self); 644 $self->{on_read}($self);
555 645
556 if ( 646 if (
557 $self->{_eof} # if no further data will arrive
558 && $len == length $self->{rbuf} # and no data has been consumed 647 $len == length $self->{rbuf} # if no data has been consumed
559 && !@{ $self->{_queue} } # and the queue is still empty 648 && !@{ $self->{_queue} } # and the queue is still empty
560 && $self->{on_read} # and we still want to read data 649 && $self->{on_read} # but we still have on_read
561 ) { 650 ) {
651 # no further data will arrive
562 # then no progress can be made 652 # so no progress can be made
563 $! = &Errno::EPIPE; 653 return $self->_error (&Errno::EPIPE, 1)
564 $self->error; 654 if $self->{_eof};
655
656 last; # more data might arrive
565 } 657 }
566 } else { 658 } else {
567 # read side becomes idle 659 # read side becomes idle
568 delete $self->{_rw}; 660 delete $self->{_rw};
569 return; 661 last;
570 } 662 }
571 } 663 }
572 664
573 if ($self->{_eof}) {
574 $self->_shutdown;
575 $self->{on_eof}($self) 665 $self->{on_eof}($self)
576 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} };
577 } 672 }
578} 673}
579 674
580=item $handle->on_read ($cb) 675=item $handle->on_read ($cb)
581 676
… …
587 682
588sub on_read { 683sub on_read {
589 my ($self, $cb) = @_; 684 my ($self, $cb) = @_;
590 685
591 $self->{on_read} = $cb; 686 $self->{on_read} = $cb;
687 $self->_drain_rbuf if $cb;
592} 688}
593 689
594=item $handle->rbuf 690=item $handle->rbuf
595 691
596Returns the read buffer (as a modifiable lvalue). 692Returns the read buffer (as a modifiable lvalue).
… …
771 my ($self, $cb) = @_; 867 my ($self, $cb) = @_;
772 868
773 sub { 869 sub {
774 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 870 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
775 if ($_[0]{rbuf} =~ /[^0-9]/) { 871 if ($_[0]{rbuf} =~ /[^0-9]/) {
776 $! = &Errno::EBADMSG; 872 $self->_error (&Errno::EBADMSG);
777 $self->error;
778 } 873 }
779 return; 874 return;
780 } 875 }
781 876
782 my $len = $1; 877 my $len = $1;
… …
785 my $string = $_[1]; 880 my $string = $_[1];
786 $_[0]->unshift_read (chunk => 1, sub { 881 $_[0]->unshift_read (chunk => 1, sub {
787 if ($_[1] eq ",") { 882 if ($_[1] eq ",") {
788 $cb->($_[0], $string); 883 $cb->($_[0], $string);
789 } else { 884 } else {
790 $! = &Errno::EBADMSG; 885 $self->_error (&Errno::EBADMSG);
791 $self->error;
792 } 886 }
793 }); 887 });
794 }); 888 });
795 889
796 1 890 1
… …
853 return 1; 947 return 1;
854 } 948 }
855 949
856 # reject 950 # reject
857 if ($reject && $$rbuf =~ $reject) { 951 if ($reject && $$rbuf =~ $reject) {
858 $! = &Errno::EBADMSG; 952 $self->_error (&Errno::EBADMSG);
859 $self->error;
860 } 953 }
861 954
862 # skip 955 # skip
863 if ($skip && $$rbuf =~ $skip) { 956 if ($skip && $$rbuf =~ $skip) {
864 $data .= substr $$rbuf, 0, $+[0], ""; 957 $data .= substr $$rbuf, 0, $+[0], "";
… …
937=item $handle->stop_read 1030=item $handle->stop_read
938 1031
939=item $handle->start_read 1032=item $handle->start_read
940 1033
941In 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
942socket. 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
943any queued callbacks will be executed then. To start reading again, call 1036any queued callbacks will be executed then. To start reading again, call
944C<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.
945 1043
946=cut 1044=cut
947 1045
948sub stop_read { 1046sub stop_read {
949 my ($self) = @_; 1047 my ($self) = @_;
… …
960 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1058 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
961 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1059 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
962 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;
963 1061
964 if ($len > 0) { 1062 if ($len > 0) {
1063 $self->{_activity} = AnyEvent->now;
1064
965 $self->{filter_r} 1065 $self->{filter_r}
966 ? $self->{filter_r}->($self, $rbuf) 1066 ? $self->{filter_r}($self, $rbuf)
967 : $self->_drain_rbuf; 1067 : $self->_drain_rbuf;
968 1068
969 } elsif (defined $len) { 1069 } elsif (defined $len) {
970 delete $self->{_rw}; 1070 delete $self->{_rw};
971 $self->{_eof} = 1; 1071 $self->{_eof} = 1;
972 $self->_drain_rbuf; 1072 $self->_drain_rbuf;
973 1073
974 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1074 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
975 return $self->error; 1075 return $self->_error ($!, 1);
976 } 1076 }
977 }); 1077 });
978 } 1078 }
979} 1079}
980 1080
981sub _dotls { 1081sub _dotls {
982 my ($self) = @_; 1082 my ($self) = @_;
1083
1084 my $buf;
983 1085
984 if (length $self->{_tls_wbuf}) { 1086 if (length $self->{_tls_wbuf}) {
985 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) {
986 substr $self->{_tls_wbuf}, 0, $len, ""; 1088 substr $self->{_tls_wbuf}, 0, $len, "";
987 } 1089 }
988 } 1090 }
989 1091
990 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1092 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
991 $self->{wbuf} .= $buf; 1093 $self->{wbuf} .= $buf;
992 $self->_drain_wbuf; 1094 $self->_drain_wbuf;
993 } 1095 }
994 1096
995 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) { 1097 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1098 if (length $buf) {
996 $self->{rbuf} .= $buf; 1099 $self->{rbuf} .= $buf;
997 $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 }
998 } 1107 }
999 1108
1000 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1109 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1001 1110
1002 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1111 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1003 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1112 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1004 $self->error; 1113 return $self->_error ($!, 1);
1005 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1114 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1006 $! = &Errno::EIO; 1115 return $self->_error (&Errno::EIO, 1);
1007 $self->error;
1008 } 1116 }
1009 1117
1010 # all others are fine for our purposes 1118 # all others are fine for our purposes
1011 } 1119 }
1012} 1120}
… …
1027call 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
1028might have already started when this function returns. 1136might have already started when this function returns.
1029 1137
1030=cut 1138=cut
1031 1139
1032# TODO: maybe document...
1033sub starttls { 1140sub starttls {
1034 my ($self, $ssl, $ctx) = @_; 1141 my ($self, $ssl, $ctx) = @_;
1035 1142
1036 $self->stoptls; 1143 $self->stoptls;
1037 1144

Diff Legend

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