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.158 by root, Fri Jul 24 08:40:35 2009 UTC vs.
Revision 1.183 by root, Thu Sep 3 12:45:35 2009 UTC

1package AnyEvent::Handle;
2
3use Scalar::Util ();
4use Carp ();
5use Errno qw(EAGAIN EINTR);
6
7use AnyEvent (); BEGIN { AnyEvent::common_sense }
8use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
10=head1 NAME 1=head1 NAME
11 2
12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 3AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
13
14=cut
15
16our $VERSION = 4.86;
17 4
18=head1 SYNOPSIS 5=head1 SYNOPSIS
19 6
20 use AnyEvent; 7 use AnyEvent;
21 use AnyEvent::Handle; 8 use AnyEvent::Handle;
44 $cv->recv; 31 $cv->recv;
45 32
46=head1 DESCRIPTION 33=head1 DESCRIPTION
47 34
48This module is a helper module to make it easier to do event-based I/O on 35This module is a helper module to make it easier to do event-based I/O on
49filehandles. For utility functions for doing non-blocking connects and accepts 36filehandles.
50on sockets see L<AnyEvent::Util>.
51 37
52The L<AnyEvent::Intro> tutorial contains some well-documented 38The L<AnyEvent::Intro> tutorial contains some well-documented
53AnyEvent::Handle examples. 39AnyEvent::Handle examples.
54 40
55In the following, when the documentation refers to of "bytes" then this 41In the following, when the documentation refers to of "bytes" then this
56means characters. As sysread and syswrite are used for all I/O, their 42means characters. As sysread and syswrite are used for all I/O, their
57treatment of characters applies to this module as well. 43treatment of characters applies to this module as well.
58 44
45At the very minimum, you should specify C<fh> or C<connect>, and the
46C<on_error> callback.
47
59All callbacks will be invoked with the handle object as their first 48All callbacks will be invoked with the handle object as their first
60argument. 49argument.
61 50
51=cut
52
53package AnyEvent::Handle;
54
55use Scalar::Util ();
56use List::Util ();
57use Carp ();
58use Errno qw(EAGAIN EINTR);
59
60use AnyEvent (); BEGIN { AnyEvent::common_sense }
61use AnyEvent::Util qw(WSAEWOULDBLOCK);
62
63our $VERSION = $AnyEvent::VERSION;
64
62=head1 METHODS 65=head1 METHODS
63 66
64=over 4 67=over 4
65 68
66=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value... 69=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
67 70
68The constructor supports these arguments (all as C<< key => value >> pairs). 71The constructor supports these arguments (all as C<< key => value >> pairs).
69 72
70=over 4 73=over 4
71 74
72=item fh => $filehandle [MANDATORY]
73
74#=item fh => $filehandle [C<fh> or C<connect> MANDATORY] 75=item fh => $filehandle [C<fh> or C<connect> MANDATORY]
75 76
76The filehandle this L<AnyEvent::Handle> object will operate on. 77The filehandle this L<AnyEvent::Handle> object will operate on.
77NOTE: The filehandle will be set to non-blocking mode (using 78NOTE: The filehandle will be set to non-blocking mode (using
78C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in 79C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
79that mode. 80that mode.
80 81
81#=item connect => [$host, $service] 82=item connect => [$host, $service] [C<fh> or C<connect> MANDATORY]
82# 83
83# You have to specify either this parameter, or C<connect>, below.
84#Try to connect to the specified host and service (port), using 84Try to connect to the specified host and service (port), using
85#C<AnyEvent::Socket::tcp_connect>. 85C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the
86# 86default C<peername>.
87#When this 87
88You have to specify either this parameter, or C<fh>, above.
89
90It is possible to push requests on the read and write queues, and modify
91properties of the stream, even while AnyEvent::Handle is connecting.
92
93When this parameter is specified, then the C<on_prepare>,
94C<on_connect_error> and C<on_connect> callbacks will be called under the
95appropriate circumstances:
96
97=over 4
98
99=item on_prepare => $cb->($handle)
100
101This (rarely used) callback is called before a new connection is
102attempted, but after the file handle has been created. It could be used to
103prepare the file handle with parameters required for the actual connect
104(as opposed to settings that can be changed when the connection is already
105established).
106
107The return value of this callback should be the connect timeout value in
108seconds (or C<0>, or C<undef>, or the empty list, to indicate the default
109timeout is to be used).
110
111=item on_connect => $cb->($handle, $host, $port, $retry->())
112
113This callback is called when a connection has been successfully established.
114
115The actual numeric host and port (the socket peername) are passed as
116parameters, together with a retry callback.
117
118When, for some reason, the handle is not acceptable, then calling
119C<$retry> will continue with the next conenction target (in case of
120multi-homed hosts or SRV records there can be multiple connection
121endpoints). When it is called then the read and write queues, eof status,
122tls status and similar properties of the handle are being reset.
123
124In most cases, ignoring the C<$retry> parameter is the way to go.
125
126=item on_connect_error => $cb->($handle, $message)
127
128This callback is called when the conenction could not be
129established. C<$!> will contain the relevant error code, and C<$message> a
130message describing it (usually the same as C<"$!">).
131
132If this callback isn't specified, then C<on_error> will be called with a
133fatal error instead.
134
135=back
136
137=item on_error => $cb->($handle, $fatal, $message)
138
139This is the error callback, which is called when, well, some error
140occured, such as not being able to resolve the hostname, failure to
141connect or a read error.
142
143Some errors are fatal (which is indicated by C<$fatal> being true). On
144fatal errors the handle object will be destroyed (by a call to C<< ->
145destroy >>) after invoking the error callback (which means you are free to
146examine the handle object). Examples of fatal errors are an EOF condition
147with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors. In
148cases where the other side can close the connection at their will it is
149often easiest to not report C<EPIPE> errors in this callback.
150
151AnyEvent::Handle tries to find an appropriate error code for you to check
152against, but in some cases (TLS errors), this does not work well. It is
153recommended to always output the C<$message> argument in human-readable
154error messages (it's usually the same as C<"$!">).
155
156Non-fatal errors can be retried by simply returning, but it is recommended
157to simply ignore this parameter and instead abondon the handle object
158when this callback is invoked. Examples of non-fatal errors are timeouts
159C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
160
161On callback entrance, the value of C<$!> contains the operating system
162error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
163C<EPROTO>).
164
165While not mandatory, it is I<highly> recommended to set this callback, as
166you will not be notified of errors otherwise. The default simply calls
167C<croak>.
168
169=item on_read => $cb->($handle)
170
171This sets the default read callback, which is called when data arrives
172and no read request is in the queue (unlike read queue callbacks, this
173callback will only be called when at least one octet of data is in the
174read buffer).
175
176To access (and remove data from) the read buffer, use the C<< ->rbuf >>
177method or access the C<< $handle->{rbuf} >> member directly. Note that you
178must not enlarge or modify the read buffer, you can only remove data at
179the beginning from it.
180
181When an EOF condition is detected then AnyEvent::Handle will first try to
182feed all the remaining data to the queued callbacks and C<on_read> before
183calling the C<on_eof> callback. If no progress can be made, then a fatal
184error will be raised (with C<$!> set to C<EPIPE>).
185
186Note that, unlike requests in the read queue, an C<on_read> callback
187doesn't mean you I<require> some data: if there is an EOF and there
188are outstanding read requests then an error will be flagged. With an
189C<on_read> callback, the C<on_eof> callback will be invoked.
88 190
89=item on_eof => $cb->($handle) 191=item on_eof => $cb->($handle)
90 192
91Set the callback to be called when an end-of-file condition is detected, 193Set the callback to be called when an end-of-file condition is detected,
92i.e. in the case of a socket, when the other side has closed the 194i.e. in the case of a socket, when the other side has closed the
100down. 202down.
101 203
102If an EOF condition has been detected but no C<on_eof> callback has been 204If an EOF condition has been detected but no C<on_eof> callback has been
103set, then a fatal error will be raised with C<$!> set to <0>. 205set, then a fatal error will be raised with C<$!> set to <0>.
104 206
105=item on_error => $cb->($handle, $fatal, $message)
106
107This is the error callback, which is called when, well, some error
108occured, such as not being able to resolve the hostname, failure to
109connect or a read error.
110
111Some errors are fatal (which is indicated by C<$fatal> being true). On
112fatal errors the handle object will be destroyed (by a call to C<< ->
113destroy >>) after invoking the error callback (which means you are free to
114examine the handle object). Examples of fatal errors are an EOF condition
115with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors.
116
117AnyEvent::Handle tries to find an appropriate error code for you to check
118against, but in some cases (TLS errors), this does not work well. It is
119recommended to always output the C<$message> argument in human-readable
120error messages (it's usually the same as C<"$!">).
121
122Non-fatal errors can be retried by simply returning, but it is recommended
123to simply ignore this parameter and instead abondon the handle object
124when this callback is invoked. Examples of non-fatal errors are timeouts
125C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
126
127On callback entrance, the value of C<$!> contains the operating system
128error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
129C<EPROTO>).
130
131While not mandatory, it is I<highly> recommended to set this callback, as
132you will not be notified of errors otherwise. The default simply calls
133C<croak>.
134
135=item on_read => $cb->($handle)
136
137This sets the default read callback, which is called when data arrives
138and no read request is in the queue (unlike read queue callbacks, this
139callback will only be called when at least one octet of data is in the
140read buffer).
141
142To access (and remove data from) the read buffer, use the C<< ->rbuf >>
143method or access the C<< $handle->{rbuf} >> member directly. Note that you
144must not enlarge or modify the read buffer, you can only remove data at
145the beginning from it.
146
147When an EOF condition is detected then AnyEvent::Handle will first try to
148feed all the remaining data to the queued callbacks and C<on_read> before
149calling the C<on_eof> callback. If no progress can be made, then a fatal
150error will be raised (with C<$!> set to C<EPIPE>).
151
152Note that, unlike requests in the read queue, an C<on_read> callback
153doesn't mean you I<require> some data: if there is an EOF and there
154are outstanding read requests then an error will be flagged. With an
155C<on_read> callback, the C<on_eof> callback will be invoked.
156
157=item on_drain => $cb->($handle) 207=item on_drain => $cb->($handle)
158 208
159This sets the callback that is called when the write buffer becomes empty 209This sets the callback that is called when the write buffer becomes empty
160(or when the callback is set and the buffer is empty already). 210(or when the callback is set and the buffer is empty already).
161 211
167memory and push it into the queue, but instead only read more data from 217memory and push it into the queue, but instead only read more data from
168the file when the write queue becomes empty. 218the file when the write queue becomes empty.
169 219
170=item timeout => $fractional_seconds 220=item timeout => $fractional_seconds
171 221
222=item rtimeout => $fractional_seconds
223
224=item wtimeout => $fractional_seconds
225
172If non-zero, then this enables an "inactivity" timeout: whenever this many 226If non-zero, then these enables an "inactivity" timeout: whenever this
173seconds pass without a successful read or write on the underlying file 227many seconds pass without a successful read or write on the underlying
174handle, the C<on_timeout> callback will be invoked (and if that one is 228file handle (or a call to C<timeout_reset>), the C<on_timeout> callback
175missing, a non-fatal C<ETIMEDOUT> error will be raised). 229will be invoked (and if that one is missing, a non-fatal C<ETIMEDOUT>
230error will be raised).
231
232There are three variants of the timeouts that work fully independent
233of each other, for both read and write, just read, and just write:
234C<timeout>, C<rtimeout> and C<wtimeout>, with corresponding callbacks
235C<on_timeout>, C<on_rtimeout> and C<on_wtimeout>, and reset functions
236C<timeout_reset>, C<rtimeout_reset>, and C<wtimeout_reset>.
176 237
177Note that timeout processing is also active when you currently do not have 238Note that timeout processing is also active when you currently do not have
178any outstanding read or write requests: If you plan to keep the connection 239any outstanding read or write requests: If you plan to keep the connection
179idle then you should disable the timout temporarily or ignore the timeout 240idle then you should disable the timout temporarily or ignore the timeout
180in the C<on_timeout> callback, in which case AnyEvent::Handle will simply 241in the C<on_timeout> callback, in which case AnyEvent::Handle will simply
224accomplishd by setting this option to a true value. 285accomplishd by setting this option to a true value.
225 286
226The default is your opertaing system's default behaviour (most likely 287The default is your opertaing system's default behaviour (most likely
227enabled), this option explicitly enables or disables it, if possible. 288enabled), this option explicitly enables or disables it, if possible.
228 289
290=item keepalive => <boolean>
291
292Enables (default disable) the SO_KEEPALIVE option on the stream socket:
293normally, TCP connections have no time-out once established, so TCP
294conenctions, once established, can stay alive forever even when the other
295side has long gone. TCP keepalives are a cheap way to take down long-lived
296TCP connections whent he other side becomes unreachable. While the default
297is OS-dependent, TCP keepalives usually kick in after around two hours,
298and, if the other side doesn't reply, take down the TCP connection some 10
299to 15 minutes later.
300
301It is harmless to specify this option for file handles that do not support
302keepalives, and enabling it on connections that are potentially long-lived
303is usually a good idea.
304
305=item oobinline => <boolean>
306
307BSD majorly fucked up the implementation of TCP urgent data. The result
308is that almost no OS implements TCP according to the specs, and every OS
309implements it slightly differently.
310
311If you want to handle TCP urgent data, then setting this flag (the default
312is enabled) gives you the most portable way of getting urgent data, by
313putting it into the stream.
314
315Since BSD emulation of OOB data on top of TCP's urgent data can have
316security implications, AnyEvent::Handle sets this flag automatically
317unless explicitly specified.
318
229=item read_size => <bytes> 319=item read_size => <bytes>
230 320
231The default read block size (the amount of bytes this module will 321The default read block size (the amount of bytes this module will
232try to read during each loop iteration, which affects memory 322try to read during each loop iteration, which affects memory
233requirements). Default: C<8192>. 323requirements). Default: C<8192>.
359 449
360sub new { 450sub new {
361 my $class = shift; 451 my $class = shift;
362 my $self = bless { @_ }, $class; 452 my $self = bless { @_ }, $class;
363 453
364 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 454 if ($self->{fh}) {
455 $self->_start;
456 return unless $self->{fh}; # could be gone by now
457
458 } elsif ($self->{connect}) {
459 require AnyEvent::Socket;
460
461 $self->{peername} = $self->{connect}[0]
462 unless exists $self->{peername};
463
464 $self->{_skip_drain_rbuf} = 1;
465
466 {
467 Scalar::Util::weaken (my $self = $self);
468
469 $self->{_connect} =
470 AnyEvent::Socket::tcp_connect (
471 $self->{connect}[0],
472 $self->{connect}[1],
473 sub {
474 my ($fh, $host, $port, $retry) = @_;
475
476 if ($fh) {
477 $self->{fh} = $fh;
478
479 delete $self->{_skip_drain_rbuf};
480 $self->_start;
481
482 $self->{on_connect}
483 and $self->{on_connect}($self, $host, $port, sub {
484 delete @$self{qw(fh _tw _rtw _wtw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)};
485 $self->{_skip_drain_rbuf} = 1;
486 &$retry;
487 });
488
489 } else {
490 if ($self->{on_connect_error}) {
491 $self->{on_connect_error}($self, "$!");
492 $self->destroy;
493 } else {
494 $self->_error ($!, 1);
495 }
496 }
497 },
498 sub {
499 local $self->{fh} = $_[0];
500
501 $self->{on_prepare}
502 ? $self->{on_prepare}->($self)
503 : ()
504 }
505 );
506 }
507
508 } else {
509 Carp::croak "AnyEvent::Handle: either an existing fh or the connect parameter must be specified";
510 }
511
512 $self
513}
514
515sub _start {
516 my ($self) = @_;
365 517
366 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 518 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
367 519
520 $self->{_activity} =
521 $self->{_ractivity} =
368 $self->{_activity} = AnyEvent->now; 522 $self->{_wactivity} = AE::now;
369 $self->_timeout;
370 523
524 $self->timeout (delete $self->{timeout} ) if $self->{timeout};
525 $self->rtimeout (delete $self->{rtimeout} ) if $self->{rtimeout};
526 $self->wtimeout (delete $self->{wtimeout} ) if $self->{wtimeout};
527
371 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay}; 528 $self->no_delay (delete $self->{no_delay} ) if exists $self->{no_delay} && $self->{no_delay};
529 $self->keepalive (delete $self->{keepalive}) if exists $self->{keepalive} && $self->{keepalive};
372 530
531 $self->oobinline (exists $self->{oobinline} ? delete $self->{oobinline} : 1);
532
373 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 533 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
374 if $self->{tls}; 534 if $self->{tls};
375 535
376 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 536 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
377 537
378 $self->start_read 538 $self->start_read
379 if $self->{on_read}; 539 if $self->{on_read} || @{ $self->{_queue} };
380 540
381 $self->{fh} && $self 541 $self->_drain_wbuf;
382} 542}
383
384#sub _shutdown {
385# my ($self) = @_;
386#
387# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
388# $self->{_eof} = 1; # tell starttls et. al to stop trying
389#
390# &_freetls;
391#}
392 543
393sub _error { 544sub _error {
394 my ($self, $errno, $fatal, $message) = @_; 545 my ($self, $errno, $fatal, $message) = @_;
395 546
396 $! = $errno; 547 $! = $errno;
433 $_[0]{on_eof} = $_[1]; 584 $_[0]{on_eof} = $_[1];
434} 585}
435 586
436=item $handle->on_timeout ($cb) 587=item $handle->on_timeout ($cb)
437 588
438Replace the current C<on_timeout> callback, or disables the callback (but 589=item $handle->on_rtimeout ($cb)
439not the timeout) if C<$cb> = C<undef>. See the C<timeout> constructor
440argument and method.
441 590
442=cut 591=item $handle->on_wtimeout ($cb)
443 592
444sub on_timeout { 593Replace the current C<on_timeout>, C<on_rtimeout> or C<on_wtimeout>
445 $_[0]{on_timeout} = $_[1]; 594callback, or disables the callback (but not the timeout) if C<$cb> =
446} 595C<undef>. See the C<timeout> constructor argument and method.
596
597=cut
598
599# see below
447 600
448=item $handle->autocork ($boolean) 601=item $handle->autocork ($boolean)
449 602
450Enables or disables the current autocork behaviour (see C<autocork> 603Enables or disables the current autocork behaviour (see C<autocork>
451constructor argument). Changes will only take effect on the next write. 604constructor argument). Changes will only take effect on the next write.
466sub no_delay { 619sub no_delay {
467 $_[0]{no_delay} = $_[1]; 620 $_[0]{no_delay} = $_[1];
468 621
469 eval { 622 eval {
470 local $SIG{__DIE__}; 623 local $SIG{__DIE__};
471 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1]; 624 setsockopt $_[0]{fh}, Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), int $_[1]
625 if $_[0]{fh};
626 };
627}
628
629=item $handle->keepalive ($boolean)
630
631Enables or disables the C<keepalive> setting (see constructor argument of
632the same name for details).
633
634=cut
635
636sub keepalive {
637 $_[0]{keepalive} = $_[1];
638
639 eval {
640 local $SIG{__DIE__};
641 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
642 if $_[0]{fh};
643 };
644}
645
646=item $handle->oobinline ($boolean)
647
648Enables or disables the C<oobinline> setting (see constructor argument of
649the same name for details).
650
651=cut
652
653sub oobinline {
654 $_[0]{oobinline} = $_[1];
655
656 eval {
657 local $SIG{__DIE__};
658 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1]
659 if $_[0]{fh};
660 };
661}
662
663=item $handle->keepalive ($boolean)
664
665Enables or disables the C<keepalive> setting (see constructor argument of
666the same name for details).
667
668=cut
669
670sub keepalive {
671 $_[0]{keepalive} = $_[1];
672
673 eval {
674 local $SIG{__DIE__};
675 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
676 if $_[0]{fh};
472 }; 677 };
473} 678}
474 679
475=item $handle->on_starttls ($cb) 680=item $handle->on_starttls ($cb)
476 681
490 695
491sub on_starttls { 696sub on_starttls {
492 $_[0]{on_stoptls} = $_[1]; 697 $_[0]{on_stoptls} = $_[1];
493} 698}
494 699
700=item $handle->rbuf_max ($max_octets)
701
702Configures the C<rbuf_max> setting (C<undef> disables it).
703
704=cut
705
706sub rbuf_max {
707 $_[0]{rbuf_max} = $_[1];
708}
709
495############################################################################# 710#############################################################################
496 711
497=item $handle->timeout ($seconds) 712=item $handle->timeout ($seconds)
498 713
714=item $handle->rtimeout ($seconds)
715
716=item $handle->wtimeout ($seconds)
717
499Configures (or disables) the inactivity timeout. 718Configures (or disables) the inactivity timeout.
500 719
501=cut 720=item $handle->timeout_reset
502 721
503sub timeout { 722=item $handle->rtimeout_reset
723
724=item $handle->wtimeout_reset
725
726Reset the activity timeout, as if data was received or sent.
727
728These methods are cheap to call.
729
730=cut
731
732for my $dir ("", "r", "w") {
733 my $timeout = "${dir}timeout";
734 my $tw = "_${dir}tw";
735 my $on_timeout = "on_${dir}timeout";
736 my $activity = "_${dir}activity";
737 my $cb;
738
739 *$on_timeout = sub {
740 $_[0]{$on_timeout} = $_[1];
741 };
742
743 *$timeout = sub {
504 my ($self, $timeout) = @_; 744 my ($self, $new_value) = @_;
505 745
506 $self->{timeout} = $timeout; 746 $self->{$timeout} = $new_value;
507 $self->_timeout; 747 delete $self->{$tw}; &$cb;
508} 748 };
509 749
750 *{"${dir}timeout_reset"} = sub {
751 $_[0]{$activity} = AE::now;
752 };
753
754 # main workhorse:
510# reset the timeout watcher, as neccessary 755 # reset the timeout watcher, as neccessary
511# also check for time-outs 756 # also check for time-outs
512sub _timeout { 757 $cb = sub {
513 my ($self) = @_; 758 my ($self) = @_;
514 759
515 if ($self->{timeout}) { 760 if ($self->{$timeout} && $self->{fh}) {
516 my $NOW = AnyEvent->now; 761 my $NOW = AE::now;
517 762
518 # when would the timeout trigger? 763 # when would the timeout trigger?
519 my $after = $self->{_activity} + $self->{timeout} - $NOW; 764 my $after = $self->{$activity} + $self->{$timeout} - $NOW;
520 765
521 # now or in the past already? 766 # now or in the past already?
522 if ($after <= 0) { 767 if ($after <= 0) {
523 $self->{_activity} = $NOW; 768 $self->{$activity} = $NOW;
524 769
525 if ($self->{on_timeout}) { 770 if ($self->{$on_timeout}) {
526 $self->{on_timeout}($self); 771 $self->{$on_timeout}($self);
527 } else { 772 } else {
528 $self->_error (Errno::ETIMEDOUT); 773 $self->_error (Errno::ETIMEDOUT);
774 }
775
776 # callback could have changed timeout value, optimise
777 return unless $self->{$timeout};
778
779 # calculate new after
780 $after = $self->{$timeout};
529 } 781 }
530 782
531 # callback could have changed timeout value, optimise 783 Scalar::Util::weaken $self;
532 return unless $self->{timeout}; 784 return unless $self; # ->error could have destroyed $self
533 785
534 # calculate new after 786 $self->{$tw} ||= AE::timer $after, 0, sub {
535 $after = $self->{timeout}; 787 delete $self->{$tw};
788 $cb->($self);
789 };
790 } else {
791 delete $self->{$tw};
536 } 792 }
537
538 Scalar::Util::weaken $self;
539 return unless $self; # ->error could have destroyed $self
540
541 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
542 delete $self->{_tw};
543 $self->_timeout;
544 });
545 } else {
546 delete $self->{_tw};
547 } 793 }
548} 794}
549 795
550############################################################################# 796#############################################################################
551 797
599 my $len = syswrite $self->{fh}, $self->{wbuf}; 845 my $len = syswrite $self->{fh}, $self->{wbuf};
600 846
601 if (defined $len) { 847 if (defined $len) {
602 substr $self->{wbuf}, 0, $len, ""; 848 substr $self->{wbuf}, 0, $len, "";
603 849
604 $self->{_activity} = AnyEvent->now; 850 $self->{_activity} = $self->{_wactivity} = AE::now;
605 851
606 $self->{on_drain}($self) 852 $self->{on_drain}($self)
607 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}) 853 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})
608 && $self->{on_drain}; 854 && $self->{on_drain};
609 855
615 861
616 # try to write data immediately 862 # try to write data immediately
617 $cb->() unless $self->{autocork}; 863 $cb->() unless $self->{autocork};
618 864
619 # if still data left in wbuf, we need to poll 865 # if still data left in wbuf, we need to poll
620 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 866 $self->{_ww} = AE::io $self->{fh}, 1, $cb
621 if length $self->{wbuf}; 867 if length $self->{wbuf};
622 }; 868 };
623} 869}
624 870
625our %WH; 871our %WH;
638 ->($self, @_); 884 ->($self, @_);
639 } 885 }
640 886
641 if ($self->{tls}) { 887 if ($self->{tls}) {
642 $self->{_tls_wbuf} .= $_[0]; 888 $self->{_tls_wbuf} .= $_[0];
643 889 &_dotls ($self) if $self->{fh};
644 &_dotls ($self);
645 } else { 890 } else {
646 $self->{wbuf} .= $_[0]; 891 $self->{wbuf} .= $_[0];
647 $self->_drain_wbuf; 892 $self->_drain_wbuf if $self->{fh};
648 } 893 }
649} 894}
650 895
651=item $handle->push_write (type => @args) 896=item $handle->push_write (type => @args)
652 897
716Other languages could read single lines terminated by a newline and pass 961Other languages could read single lines terminated by a newline and pass
717this line into their JSON decoder of choice. 962this line into their JSON decoder of choice.
718 963
719=cut 964=cut
720 965
966sub json_coder() {
967 eval { require JSON::XS; JSON::XS->new->utf8 }
968 || do { require JSON; JSON->new->utf8 }
969}
970
721register_write_type json => sub { 971register_write_type json => sub {
722 my ($self, $ref) = @_; 972 my ($self, $ref) = @_;
723 973
724 require JSON; 974 my $json = $self->{json} ||= json_coder;
725 975
726 $self->{json} ? $self->{json}->encode ($ref) 976 $json->encode ($ref)
727 : JSON::encode_json ($ref)
728}; 977};
729 978
730=item storable => $reference 979=item storable => $reference
731 980
732Freezes the given reference using L<Storable> and writes it to the 981Freezes the given reference using L<Storable> and writes it to the
869=cut 1118=cut
870 1119
871sub _drain_rbuf { 1120sub _drain_rbuf {
872 my ($self) = @_; 1121 my ($self) = @_;
873 1122
1123 # avoid recursion
1124 return if $self->{_skip_drain_rbuf};
874 local $self->{_in_drain} = 1; 1125 local $self->{_skip_drain_rbuf} = 1;
875
876 if (
877 defined $self->{rbuf_max}
878 && $self->{rbuf_max} < length $self->{rbuf}
879 ) {
880 $self->_error (Errno::ENOSPC, 1), return;
881 }
882 1126
883 while () { 1127 while () {
884 # we need to use a separate tls read buffer, as we must not receive data while 1128 # we need to use a separate tls read buffer, as we must not receive data while
885 # we are draining the buffer, and this can only happen with TLS. 1129 # we are draining the buffer, and this can only happen with TLS.
886 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf}; 1130 $self->{rbuf} .= delete $self->{_tls_rbuf}
1131 if exists $self->{_tls_rbuf};
887 1132
888 my $len = length $self->{rbuf}; 1133 my $len = length $self->{rbuf};
889 1134
890 if (my $cb = shift @{ $self->{_queue} }) { 1135 if (my $cb = shift @{ $self->{_queue} }) {
891 unless ($cb->($self)) { 1136 unless ($cb->($self)) {
892 if ($self->{_eof}) { 1137 # no progress can be made
893 # no progress can be made (not enough data and no data forthcoming) 1138 # (not enough data and no data forthcoming)
894 $self->_error (Errno::EPIPE, 1), return; 1139 $self->_error (Errno::EPIPE, 1), return
895 } 1140 if $self->{_eof};
896 1141
897 unshift @{ $self->{_queue} }, $cb; 1142 unshift @{ $self->{_queue} }, $cb;
898 last; 1143 last;
899 } 1144 }
900 } elsif ($self->{on_read}) { 1145 } elsif ($self->{on_read}) {
920 last; 1165 last;
921 } 1166 }
922 } 1167 }
923 1168
924 if ($self->{_eof}) { 1169 if ($self->{_eof}) {
925 if ($self->{on_eof}) { 1170 $self->{on_eof}
926 $self->{on_eof}($self) 1171 ? $self->{on_eof}($self)
927 } else {
928 $self->_error (0, 1, "Unexpected end-of-file"); 1172 : $self->_error (0, 1, "Unexpected end-of-file");
929 } 1173
1174 return;
1175 }
1176
1177 if (
1178 defined $self->{rbuf_max}
1179 && $self->{rbuf_max} < length $self->{rbuf}
1180 ) {
1181 $self->_error (Errno::ENOSPC, 1), return;
930 } 1182 }
931 1183
932 # may need to restart read watcher 1184 # may need to restart read watcher
933 unless ($self->{_rw}) { 1185 unless ($self->{_rw}) {
934 $self->start_read 1186 $self->start_read
946 1198
947sub on_read { 1199sub on_read {
948 my ($self, $cb) = @_; 1200 my ($self, $cb) = @_;
949 1201
950 $self->{on_read} = $cb; 1202 $self->{on_read} = $cb;
951 $self->_drain_rbuf if $cb && !$self->{_in_drain}; 1203 $self->_drain_rbuf if $cb;
952} 1204}
953 1205
954=item $handle->rbuf 1206=item $handle->rbuf
955 1207
956Returns the read buffer (as a modifiable lvalue). 1208Returns the read buffer (as a modifiable lvalue).
1008 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 1260 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
1009 ->($self, $cb, @_); 1261 ->($self, $cb, @_);
1010 } 1262 }
1011 1263
1012 push @{ $self->{_queue} }, $cb; 1264 push @{ $self->{_queue} }, $cb;
1013 $self->_drain_rbuf unless $self->{_in_drain}; 1265 $self->_drain_rbuf;
1014} 1266}
1015 1267
1016sub unshift_read { 1268sub unshift_read {
1017 my $self = shift; 1269 my $self = shift;
1018 my $cb = pop; 1270 my $cb = pop;
1022 1274
1023 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read") 1275 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
1024 ->($self, $cb, @_); 1276 ->($self, $cb, @_);
1025 } 1277 }
1026 1278
1027
1028 unshift @{ $self->{_queue} }, $cb; 1279 unshift @{ $self->{_queue} }, $cb;
1029 $self->_drain_rbuf unless $self->{_in_drain}; 1280 $self->_drain_rbuf;
1030} 1281}
1031 1282
1032=item $handle->push_read (type => @args, $cb) 1283=item $handle->push_read (type => @args, $cb)
1033 1284
1034=item $handle->unshift_read (type => @args, $cb) 1285=item $handle->unshift_read (type => @args, $cb)
1283=cut 1534=cut
1284 1535
1285register_read_type json => sub { 1536register_read_type json => sub {
1286 my ($self, $cb) = @_; 1537 my ($self, $cb) = @_;
1287 1538
1288 my $json = $self->{json} ||= 1539 my $json = $self->{json} ||= json_coder;
1289 eval { require JSON::XS; JSON::XS->new->utf8 }
1290 || do { require JSON; JSON->new->utf8 };
1291 1540
1292 my $data; 1541 my $data;
1293 my $rbuf = \$self->{rbuf}; 1542 my $rbuf = \$self->{rbuf};
1294 1543
1295 sub { 1544 sub {
1415 my ($self) = @_; 1664 my ($self) = @_;
1416 1665
1417 unless ($self->{_rw} || $self->{_eof}) { 1666 unless ($self->{_rw} || $self->{_eof}) {
1418 Scalar::Util::weaken $self; 1667 Scalar::Util::weaken $self;
1419 1668
1420 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1669 $self->{_rw} = AE::io $self->{fh}, 0, sub {
1421 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf}); 1670 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});
1422 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1671 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
1423 1672
1424 if ($len > 0) { 1673 if ($len > 0) {
1425 $self->{_activity} = AnyEvent->now; 1674 $self->{_activity} = $self->{_ractivity} = AE::now;
1426 1675
1427 if ($self->{tls}) { 1676 if ($self->{tls}) {
1428 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); 1677 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1429 1678
1430 &_dotls ($self); 1679 &_dotls ($self);
1431 } else { 1680 } else {
1432 $self->_drain_rbuf unless $self->{_in_drain}; 1681 $self->_drain_rbuf;
1433 } 1682 }
1434 1683
1435 } elsif (defined $len) { 1684 } elsif (defined $len) {
1436 delete $self->{_rw}; 1685 delete $self->{_rw};
1437 $self->{_eof} = 1; 1686 $self->{_eof} = 1;
1438 $self->_drain_rbuf unless $self->{_in_drain}; 1687 $self->_drain_rbuf;
1439 1688
1440 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1689 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1441 return $self->_error ($!, 1); 1690 return $self->_error ($!, 1);
1442 } 1691 }
1443 }); 1692 };
1444 } 1693 }
1445} 1694}
1446 1695
1447our $ERROR_SYSCALL; 1696our $ERROR_SYSCALL;
1448our $ERROR_WANT_READ; 1697our $ERROR_WANT_READ;
1503 $self->{_eof} = 1; 1752 $self->{_eof} = 1;
1504 } 1753 }
1505 } 1754 }
1506 1755
1507 $self->{_tls_rbuf} .= $tmp; 1756 $self->{_tls_rbuf} .= $tmp;
1508 $self->_drain_rbuf unless $self->{_in_drain}; 1757 $self->_drain_rbuf;
1509 $self->{tls} or return; # tls session might have gone away in callback 1758 $self->{tls} or return; # tls session might have gone away in callback
1510 } 1759 }
1511 1760
1512 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1761 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1513 return $self->_tls_error ($tmp) 1762 return $self->_tls_error ($tmp)
1545The TLS connection object will end up in C<< $handle->{tls} >>, the TLS 1794The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1546context in C<< $handle->{tls_ctx} >> after this call and can be used or 1795context in C<< $handle->{tls_ctx} >> after this call and can be used or
1547changed to your liking. Note that the handshake might have already started 1796changed to your liking. Note that the handshake might have already started
1548when this function returns. 1797when this function returns.
1549 1798
1550If it an error to start a TLS handshake more than once per 1799Due to bugs in OpenSSL, it might or might not be possible to do multiple
1551AnyEvent::Handle object (this is due to bugs in OpenSSL). 1800handshakes on the same stream. Best do not attempt to use the stream after
1801stopping TLS.
1552 1802
1553=cut 1803=cut
1554 1804
1555our %TLS_CACHE; #TODO not yet documented, should we? 1805our %TLS_CACHE; #TODO not yet documented, should we?
1556 1806
1557sub starttls { 1807sub starttls {
1558 my ($self, $ssl, $ctx) = @_; 1808 my ($self, $tls, $ctx) = @_;
1809
1810 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
1811 if $self->{tls};
1812
1813 $self->{tls} = $tls;
1814 $self->{tls_ctx} = $ctx if @_ > 2;
1815
1816 return unless $self->{fh};
1559 1817
1560 require Net::SSLeay; 1818 require Net::SSLeay;
1561
1562 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1563 if $self->{tls};
1564 1819
1565 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1820 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1566 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1821 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1567 1822
1823 $tls = delete $self->{tls};
1568 $ctx ||= $self->{tls_ctx}; 1824 $ctx = $self->{tls_ctx};
1569 1825
1570 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 1826 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1571 1827
1572 if ("HASH" eq ref $ctx) { 1828 if ("HASH" eq ref $ctx) {
1573 require AnyEvent::TLS; 1829 require AnyEvent::TLS;
1579 $ctx = new AnyEvent::TLS %$ctx; 1835 $ctx = new AnyEvent::TLS %$ctx;
1580 } 1836 }
1581 } 1837 }
1582 1838
1583 $self->{tls_ctx} = $ctx || TLS_CTX (); 1839 $self->{tls_ctx} = $ctx || TLS_CTX ();
1584 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername}); 1840 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
1585 1841
1586 # basically, this is deep magic (because SSL_read should have the same issues) 1842 # basically, this is deep magic (because SSL_read should have the same issues)
1587 # but the openssl maintainers basically said: "trust us, it just works". 1843 # but the openssl maintainers basically said: "trust us, it just works".
1588 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1844 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1589 # and mismaintained ssleay-module doesn't even offer them). 1845 # and mismaintained ssleay-module doesn't even offer them).
1596 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 1852 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1597 # have identity issues in that area. 1853 # have identity issues in that area.
1598# Net::SSLeay::CTX_set_mode ($ssl, 1854# Net::SSLeay::CTX_set_mode ($ssl,
1599# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1855# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1600# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1856# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1601 Net::SSLeay::CTX_set_mode ($ssl, 1|2); 1857 Net::SSLeay::CTX_set_mode ($tls, 1|2);
1602 1858
1603 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1859 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1604 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1860 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1605 1861
1862 Net::SSLeay::BIO_write ($self->{_rbio}, delete $self->{rbuf});
1863
1606 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1864 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio});
1607 1865
1608 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 1866 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1609 if $self->{on_starttls}; 1867 if $self->{on_starttls};
1610 1868
1611 &_dotls; # need to trigger the initial handshake 1869 &_dotls; # need to trigger the initial handshake
1614 1872
1615=item $handle->stoptls 1873=item $handle->stoptls
1616 1874
1617Shuts down the SSL connection - this makes a proper EOF handshake by 1875Shuts down the SSL connection - this makes a proper EOF handshake by
1618sending a close notify to the other side, but since OpenSSL doesn't 1876sending a close notify to the other side, but since OpenSSL doesn't
1619support non-blocking shut downs, it is not possible to re-use the stream 1877support non-blocking shut downs, it is not guarenteed that you can re-use
1620afterwards. 1878the stream afterwards.
1621 1879
1622=cut 1880=cut
1623 1881
1624sub stoptls { 1882sub stoptls {
1625 my ($self) = @_; 1883 my ($self) = @_;
1638sub _freetls { 1896sub _freetls {
1639 my ($self) = @_; 1897 my ($self) = @_;
1640 1898
1641 return unless $self->{tls}; 1899 return unless $self->{tls};
1642 1900
1643 $self->{tls_ctx}->_put_session (delete $self->{tls}); 1901 $self->{tls_ctx}->_put_session (delete $self->{tls})
1902 if $self->{tls} > 0;
1644 1903
1645 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 1904 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1646} 1905}
1647 1906
1648sub DESTROY { 1907sub DESTROY {
1656 my $fh = delete $self->{fh}; 1915 my $fh = delete $self->{fh};
1657 my $wbuf = delete $self->{wbuf}; 1916 my $wbuf = delete $self->{wbuf};
1658 1917
1659 my @linger; 1918 my @linger;
1660 1919
1661 push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub { 1920 push @linger, AE::io $fh, 1, sub {
1662 my $len = syswrite $fh, $wbuf, length $wbuf; 1921 my $len = syswrite $fh, $wbuf, length $wbuf;
1663 1922
1664 if ($len > 0) { 1923 if ($len > 0) {
1665 substr $wbuf, 0, $len, ""; 1924 substr $wbuf, 0, $len, "";
1666 } else { 1925 } else {
1667 @linger = (); # end 1926 @linger = (); # end
1668 } 1927 }
1669 }); 1928 };
1670 push @linger, AnyEvent->timer (after => $linger, cb => sub { 1929 push @linger, AE::timer $linger, 0, sub {
1671 @linger = (); 1930 @linger = ();
1672 }); 1931 };
1673 } 1932 }
1674} 1933}
1675 1934
1676=item $handle->destroy 1935=item $handle->destroy
1677 1936
1678Shuts down the handle object as much as possible - this call ensures that 1937Shuts down the handle object as much as possible - this call ensures that
1679no further callbacks will be invoked and as many resources as possible 1938no further callbacks will be invoked and as many resources as possible
1680will be freed. You must not call any methods on the object afterwards. 1939will be freed. Any method you will call on the handle object after
1940destroying it in this way will be silently ignored (and it will return the
1941empty list).
1681 1942
1682Normally, you can just "forget" any references to an AnyEvent::Handle 1943Normally, you can just "forget" any references to an AnyEvent::Handle
1683object and it will simply shut down. This works in fatal error and EOF 1944object and it will simply shut down. This works in fatal error and EOF
1684callbacks, as well as code outside. It does I<NOT> work in a read or write 1945callbacks, as well as code outside. It does I<NOT> work in a read or write
1685callback, so when you want to destroy the AnyEvent::Handle object from 1946callback, so when you want to destroy the AnyEvent::Handle object from
1699sub destroy { 1960sub destroy {
1700 my ($self) = @_; 1961 my ($self) = @_;
1701 1962
1702 $self->DESTROY; 1963 $self->DESTROY;
1703 %$self = (); 1964 %$self = ();
1965 bless $self, "AnyEvent::Handle::destroyed";
1966}
1967
1968sub AnyEvent::Handle::destroyed::AUTOLOAD {
1969 #nop
1704} 1970}
1705 1971
1706=item AnyEvent::Handle::TLS_CTX 1972=item AnyEvent::Handle::TLS_CTX
1707 1973
1708This function creates and returns the AnyEvent::TLS object used by default 1974This function creates and returns the AnyEvent::TLS object used by default

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines