1=head1 NAME 2 3AnyEvent::Handle - non-blocking I/O on streaming handles via AnyEvent 4 5=head1 SYNOPSIS 6 7 use AnyEvent; 8 use AnyEvent::Handle; 9 10 my $cv = AnyEvent->condvar; 11 12 my $hdl; $hdl = new AnyEvent::Handle 13 fh => \*STDIN, 14 on_error => sub { 15 my ($hdl, $fatal, $msg) = @_; 16 AE::log error => $msg; 17 $hdl->destroy; 18 $cv->send; 19 }; 20 21 # send some request line 22 $hdl->push_write ("getinfo\015\012"); 23 24 # read the response line 25 $hdl->push_read (line => sub { 26 my ($hdl, $line) = @_; 27 say "got line <$line>"; 28 $cv->send; 29 }); 30 31 $cv->recv; 32 33=head1 DESCRIPTION 34 35This is a helper module to make it easier to do event-based I/O 36on stream-based filehandles (sockets, pipes, and other stream 37things). Specifically, it doesn't work as expected on files, packet-based 38sockets or similar things. 39 40The L<AnyEvent::Intro> tutorial contains some well-documented 41AnyEvent::Handle examples. 42 43In the following, where the documentation refers to "bytes", it means 44characters. As sysread and syswrite are used for all I/O, their 45treatment of characters applies to this module as well. 46 47At the very minimum, you should specify C<fh> or C<connect>, and the 48C<on_error> callback. 49 50All callbacks will be invoked with the handle object as their first 51argument. 52 53=cut 54 55package AnyEvent::Handle; 56 57use Scalar::Util (); 58use List::Util (); 59use Carp (); 60use Errno qw(EAGAIN EWOULDBLOCK EINTR); 61 62use AnyEvent (); BEGIN { AnyEvent::common_sense } 63use AnyEvent::Util qw(WSAEWOULDBLOCK); 64 65our $VERSION = $AnyEvent::VERSION; 66 67sub _load_func($) { 68 my $func = $_[0]; 69 70 unless (defined &$func) { 71 my $pkg = $func; 72 do { 73 $pkg =~ s/::[^:]+$// 74 or return; 75 eval "require $pkg"; 76 } until defined &$func; 77 } 78 79 \&$func 80} 81 82sub MAX_READ_SIZE() { 131072 } 83 84=head1 METHODS 85 86=over 4 87 88=item $handle = B<new> AnyEvent::Handle fh => $filehandle, key => value... 89 90The constructor supports these arguments (all as C<< key => value >> pairs). 91 92=over 4 93 94=item fh => $filehandle [C<fh> or C<connect> MANDATORY] 95 96The filehandle this L<AnyEvent::Handle> object will operate on. 97NOTE: The filehandle will be set to non-blocking mode (using 98C<AnyEvent::fh_unblock>) by the constructor and needs to stay in 99that mode. 100 101=item connect => [$host, $service] [C<fh> or C<connect> MANDATORY] 102 103Try to connect to the specified host and service (port), using 104C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the 105default C<peername>. 106 107You have to specify either this parameter, or C<fh>, above. 108 109It is possible to push requests on the read and write queues, and modify 110properties of the stream, even while AnyEvent::Handle is connecting. 111 112When this parameter is specified, then the C<on_prepare>, 113C<on_connect_error> and C<on_connect> callbacks will be called under the 114appropriate circumstances: 115 116=over 4 117 118=item on_prepare => $cb->($handle) 119 120This (rarely used) callback is called before a new connection is 121attempted, but after the file handle has been created (you can access that 122file handle via C<< $handle->{fh} >>). It could be used to prepare the 123file handle with parameters required for the actual connect (as opposed to 124settings that can be changed when the connection is already established). 125 126The return value of this callback should be the connect timeout value in 127seconds (or C<0>, or C<undef>, or the empty list, to indicate that the 128default timeout is to be used). 129 130=item on_connect => $cb->($handle, $host, $port, $retry->()) 131 132This callback is called when a connection has been successfully established. 133 134The peer's numeric host and port (the socket peername) are passed as 135parameters, together with a retry callback. At the time it is called the 136read and write queues, EOF status, TLS status and similar properties of 137the handle will have been reset. 138 139If, for some reason, the handle is not acceptable, calling C<$retry> will 140continue with the next connection target (in case of multi-homed hosts or 141SRV records there can be multiple connection endpoints). The C<$retry> 142callback can be invoked after the connect callback returns, i.e. one can 143start a handshake and then decide to retry with the next host if the 144handshake fails. 145 146In most cases, you should ignore the C<$retry> parameter. 147 148=item on_connect_error => $cb->($handle, $message) 149 150This callback is called when the connection could not be 151established. C<$!> will contain the relevant error code, and C<$message> a 152message describing it (usually the same as C<"$!">). 153 154If this callback isn't specified, then C<on_error> will be called with a 155fatal error instead. 156 157=back 158 159=item on_error => $cb->($handle, $fatal, $message) 160 161This is the error callback, which is called when, well, some error 162occured, such as not being able to resolve the hostname, failure to 163connect, or a read error. 164 165Some errors are fatal (which is indicated by C<$fatal> being true). On 166fatal errors the handle object will be destroyed (by a call to C<< -> 167destroy >>) after invoking the error callback (which means you are free to 168examine the handle object). Examples of fatal errors are an EOF condition 169with active (but unsatisfiable) read watchers (C<EPIPE>) or I/O errors. In 170cases where the other side can close the connection at will, it is 171often easiest to not report C<EPIPE> errors in this callback. 172 173AnyEvent::Handle tries to find an appropriate error code for you to check 174against, but in some cases (TLS errors), this does not work well. 175 176If you report the error to the user, it is recommended to always output 177the C<$message> argument in human-readable error messages (you don't need 178to report C<"$!"> if you report C<$message>). 179 180If you want to react programmatically to the error, then looking at C<$!> 181and comparing it against some of the documented C<Errno> values is usually 182better than looking at the C<$message>. 183 184Non-fatal errors can be retried by returning, but it is recommended 185to simply ignore this parameter and instead abondon the handle object 186when this callback is invoked. Examples of non-fatal errors are timeouts 187C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>). 188 189On entry to the callback, the value of C<$!> contains the operating 190system error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or 191C<EPROTO>). 192 193While not mandatory, it is I<highly> recommended to set this callback, as 194you will not be notified of errors otherwise. The default just calls 195C<croak>. 196 197=item on_read => $cb->($handle) 198 199This sets the default read callback, which is called when data arrives 200and no read request is in the queue (unlike read queue callbacks, this 201callback will only be called when at least one octet of data is in the 202read buffer). 203 204To access (and remove data from) the read buffer, use the C<< ->rbuf >> 205method or access the C<< $handle->{rbuf} >> member directly. Note that you 206must not enlarge or modify the read buffer, you can only remove data at 207the beginning from it. 208 209You can also call C<< ->push_read (...) >> or any other function that 210modifies the read queue. Or do both. Or ... 211 212When an EOF condition is detected, AnyEvent::Handle will first try to 213feed all the remaining data to the queued callbacks and C<on_read> before 214calling the C<on_eof> callback. If no progress can be made, then a fatal 215error will be raised (with C<$!> set to C<EPIPE>). 216 217Note that, unlike requests in the read queue, an C<on_read> callback 218doesn't mean you I<require> some data: if there is an EOF and there 219are outstanding read requests then an error will be flagged. With an 220C<on_read> callback, the C<on_eof> callback will be invoked. 221 222=item on_eof => $cb->($handle) 223 224Set the callback to be called when an end-of-file condition is detected, 225i.e. in the case of a socket, when the other side has closed the 226connection cleanly, and there are no outstanding read requests in the 227queue (if there are read requests, then an EOF counts as an unexpected 228connection close and will be flagged as an error). 229 230For sockets, this just means that the other side has stopped sending data, 231you can still try to write data, and, in fact, one can return from the EOF 232callback and continue writing data, as only the read part has been shut 233down. 234 235If an EOF condition has been detected but no C<on_eof> callback has been 236set, then a fatal error will be raised with C<$!> set to <0>. 237 238=item on_drain => $cb->($handle) 239 240This sets the callback that is called once when the write buffer becomes 241empty (and immediately when the handle object is created). 242 243To append to the write buffer, use the C<< ->push_write >> method. 244 245This callback is useful when you don't want to put all of your write data 246into the queue at once, for example, when you want to write the contents 247of some file to the socket you might not want to read the whole file into 248memory and push it into the queue, but instead only read more data from 249the file when the write queue becomes empty. 250 251=item timeout => $fractional_seconds 252 253=item rtimeout => $fractional_seconds 254 255=item wtimeout => $fractional_seconds 256 257If non-zero, then these enables an "inactivity" timeout: whenever this 258many seconds pass without a successful read or write on the underlying 259file handle (or a call to C<timeout_reset>), the C<on_timeout> callback 260will be invoked (and if that one is missing, a non-fatal C<ETIMEDOUT> 261error will be raised). 262 263There are three variants of the timeouts that work independently of each 264other, for both read and write (triggered when nothing was read I<OR> 265written), just read (triggered when nothing was read), and just write: 266C<timeout>, C<rtimeout> and C<wtimeout>, with corresponding callbacks 267C<on_timeout>, C<on_rtimeout> and C<on_wtimeout>, and reset functions 268C<timeout_reset>, C<rtimeout_reset>, and C<wtimeout_reset>. 269 270Note that timeout processing is active even when you do not have any 271outstanding read or write requests: If you plan to keep the connection 272idle then you should disable the timeout temporarily or ignore the 273timeout in the corresponding C<on_timeout> callback, in which case 274AnyEvent::Handle will simply restart the timeout. 275 276Zero (the default) disables the corresponding timeout. 277 278=item on_timeout => $cb->($handle) 279 280=item on_rtimeout => $cb->($handle) 281 282=item on_wtimeout => $cb->($handle) 283 284Called whenever the inactivity timeout passes. If you return from this 285callback, then the timeout will be reset as if some activity had happened, 286so this condition is not fatal in any way. 287 288=item rbuf_max => <bytes> 289 290If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 291when the read buffer ever (strictly) exceeds this size. This is useful to 292avoid some forms of denial-of-service attacks. 293 294For example, a server accepting connections from untrusted sources should 295be configured to accept only so-and-so much data that it cannot act on 296(for example, when expecting a line, an attacker could send an unlimited 297amount of data without a callback ever being called as long as the line 298isn't finished). 299 300=item wbuf_max => <bytes> 301 302If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 303when the write buffer ever (strictly) exceeds this size. This is useful to 304avoid some forms of denial-of-service attacks. 305 306Although the units of this parameter is bytes, this is the I<raw> number 307of bytes not yet accepted by the kernel. This can make a difference when 308you e.g. use TLS, as TLS typically makes your write data larger (but it 309can also make it smaller due to compression). 310 311As an example of when this limit is useful, take a chat server that sends 312chat messages to a client. If the client does not read those in a timely 313manner then the send buffer in the server would grow unbounded. 314 315=item autocork => <boolean> 316 317When disabled (the default), C<push_write> will try to immediately 318write the data to the handle if possible. This avoids having to register 319a write watcher and wait for the next event loop iteration, but can 320be inefficient if you write multiple small chunks (on the wire, this 321disadvantage is usually avoided by your kernel's nagle algorithm, see 322C<no_delay>, but this option can save costly syscalls). 323 324When enabled, writes will always be queued till the next event loop 325iteration. This is efficient when you do many small writes per iteration, 326but less efficient when you do a single write only per iteration (or when 327the write buffer often is full). It also increases write latency. 328 329=item no_delay => <boolean> 330 331When doing small writes on sockets, your operating system kernel might 332wait a bit for more data before actually sending it out. This is called 333the Nagle algorithm, and usually it is beneficial. 334 335In some situations you want as low a delay as possible, which can be 336accomplishd by setting this option to a true value. 337 338The default is your operating system's default behaviour (most likely 339enabled). This option explicitly enables or disables it, if possible. 340 341=item keepalive => <boolean> 342 343Enables (default disable) the SO_KEEPALIVE option on the stream socket: 344normally, TCP connections have no time-out once established, so TCP 345connections, once established, can stay alive forever even when the other 346side has long gone. TCP keepalives are a cheap way to take down long-lived 347TCP connections when the other side becomes unreachable. While the default 348is OS-dependent, TCP keepalives usually kick in after around two hours, 349and, if the other side doesn't reply, take down the TCP connection some 10 350to 15 minutes later. 351 352It is harmless to specify this option for file handles that do not support 353keepalives, and enabling it on connections that are potentially long-lived 354is usually a good idea. 355 356=item oobinline => <boolean> 357 358BSD majorly fucked up the implementation of TCP urgent data. The result 359is that almost no OS implements TCP according to the specs, and every OS 360implements it slightly differently. 361 362If you want to handle TCP urgent data, then setting this flag (the default 363is enabled) gives you the most portable way of getting urgent data, by 364putting it into the stream. 365 366Since BSD emulation of OOB data on top of TCP's urgent data can have 367security implications, AnyEvent::Handle sets this flag automatically 368unless explicitly specified. Note that setting this flag after 369establishing a connection I<may> be a bit too late (data loss could 370already have occured on BSD systems), but at least it will protect you 371from most attacks. 372 373=item read_size => <bytes> 374 375The initial read block size, the number of bytes this module will try 376to read during each loop iteration. Each handle object will consume 377at least this amount of memory for the read buffer as well, so when 378handling many connections watch out for memory requirements). See also 379C<max_read_size>. Default: C<2048>. 380 381=item max_read_size => <bytes> 382 383The maximum read buffer size used by the dynamic adjustment 384algorithm: Each time AnyEvent::Handle can read C<read_size> bytes in 385one go it will double C<read_size> up to the maximum given by this 386option. Default: C<131072> or C<read_size>, whichever is higher. 387 388=item low_water_mark => <bytes> 389 390Sets the number of bytes (default: C<0>) that make up an "empty" write 391buffer: If the buffer reaches this size or gets even samller it is 392considered empty. 393 394Sometimes it can be beneficial (for performance reasons) to add data to 395the write buffer before it is fully drained, but this is a rare case, as 396the operating system kernel usually buffers data as well, so the default 397is good in almost all cases. 398 399=item linger => <seconds> 400 401If this is non-zero (default: C<3600>), the destructor of the 402AnyEvent::Handle object will check whether there is still outstanding 403write data and will install a watcher that will write this data to the 404socket. No errors will be reported (this mostly matches how the operating 405system treats outstanding data at socket close time). 406 407This will not work for partial TLS data that could not be encoded 408yet. This data will be lost. Calling the C<stoptls> method in time might 409help. 410 411=item peername => $string 412 413A string used to identify the remote site - usually the DNS hostname 414(I<not> IDN!) used to create the connection, rarely the IP address. 415 416Apart from being useful in error messages, this string is also used in TLS 417peername verification (see C<verify_peername> in L<AnyEvent::TLS>). This 418verification will be skipped when C<peername> is not specified or is 419C<undef>. 420 421=item tls => "accept" | "connect" | Net::SSLeay::SSL object 422 423When this parameter is given, it enables TLS (SSL) mode, that means 424AnyEvent will start a TLS handshake as soon as the connection has been 425established and will transparently encrypt/decrypt data afterwards. 426 427All TLS protocol errors will be signalled as C<EPROTO>, with an 428appropriate error message. 429 430TLS mode requires Net::SSLeay to be installed (it will be loaded 431automatically when you try to create a TLS handle): this module doesn't 432have a dependency on that module, so if your module requires it, you have 433to add the dependency yourself. If Net::SSLeay cannot be loaded or is too 434old, you get an C<EPROTO> error. 435 436Unlike TCP, TLS has a server and client side: for the TLS server side, use 437C<accept>, and for the TLS client side of a connection, use C<connect> 438mode. 439 440You can also provide your own TLS connection object, but you have 441to make sure that you call either C<Net::SSLeay::set_connect_state> 442or C<Net::SSLeay::set_accept_state> on it before you pass it to 443AnyEvent::Handle. Also, this module will take ownership of this connection 444object. 445 446At some future point, AnyEvent::Handle might switch to another TLS 447implementation, then the option to use your own session object will go 448away. 449 450B<IMPORTANT:> since Net::SSLeay "objects" are really only integers, 451passing in the wrong integer will lead to certain crash. This most often 452happens when one uses a stylish C<< tls => 1 >> and is surprised about the 453segmentation fault. 454 455Use the C<< ->starttls >> method if you need to start TLS negotiation later. 456 457=item tls_ctx => $anyevent_tls 458 459Use the given C<AnyEvent::TLS> object to create the new TLS connection 460(unless a connection object was specified directly). If this 461parameter is missing (or C<undef>), then AnyEvent::Handle will use 462C<AnyEvent::Handle::TLS_CTX>. 463 464Instead of an object, you can also specify a hash reference with C<< key 465=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a 466new TLS context object. 467 468=item on_starttls => $cb->($handle, $success[, $error_message]) 469 470This callback will be invoked when the TLS/SSL handshake has finished. If 471C<$success> is true, then the TLS handshake succeeded, otherwise it failed 472(C<on_stoptls> will not be called in this case). 473 474The session in C<< $handle->{tls} >> can still be examined in this 475callback, even when the handshake was not successful. 476 477TLS handshake failures will not cause C<on_error> to be invoked when this 478callback is in effect, instead, the error message will be passed to C<on_starttls>. 479 480Without this callback, handshake failures lead to C<on_error> being 481called as usual. 482 483Note that you cannot just call C<starttls> again in this callback. If you 484need to do that, start an zero-second timer instead whose callback can 485then call C<< ->starttls >> again. 486 487=item on_stoptls => $cb->($handle) 488 489When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is 490set, then it will be invoked after freeing the TLS session. If it is not, 491then a TLS shutdown condition will be treated like a normal EOF condition 492on the handle. 493 494The session in C<< $handle->{tls} >> can still be examined in this 495callback. 496 497This callback will only be called on TLS shutdowns, not when the 498underlying handle signals EOF. 499 500=item json => L<JSON>, L<JSON::PP> or L<JSON::XS> object 501 502This is the json coder object used by the C<json> read and write types. 503 504If you don't supply it, then AnyEvent::Handle will create and use a 505suitable one (on demand), which will write and expect UTF-8 encoded 506JSON texts (either using L<JSON::XS> or L<JSON>). The written texts are 507guaranteed not to contain any newline character. 508 509For security reasons, this encoder will likely I<not> handle numbers and 510strings, only arrays and objects/hashes. The reason is that originally 511JSON was self-delimited, but Dougles Crockford thought it was a splendid 512idea to redefine JSON incompatibly, so this is no longer true. 513 514For protocols that used back-to-back JSON texts, this might lead to 515run-ins, where two or more JSON texts will be interpreted as one JSON 516text. 517 518For this reason, if the default encoder uses L<JSON::XS>, it will default 519to not allowing anything but arrays and objects/hashes, at least for the 520forseeable future (it will change at some point). This might or might not 521be true for the L<JSON> module, so this might cause a security issue. 522 523If you depend on either behaviour, you should create your own json object 524and pass it in explicitly. 525 526=item cbor => L<CBOR::XS> object 527 528This is the cbor coder object used by the C<cbor> read and write types. 529 530If you don't supply it, then AnyEvent::Handle will create and use a 531suitable one (on demand), which will write CBOR without using extensions, 532if possible. 533 534Note that you are responsible to depend on the L<CBOR::XS> module if you 535want to use this functionality, as AnyEvent does not have a dependency on 536it itself. 537 538=back 539 540=cut 541 542sub new { 543 my $class = shift; 544 my $self = bless { @_ }, $class; 545 546 if ($self->{fh}) { 547 $self->_start; 548 return unless $self->{fh}; # could be gone by now 549 550 } elsif ($self->{connect}) { 551 require AnyEvent::Socket; 552 553 $self->{peername} = $self->{connect}[0] 554 unless exists $self->{peername}; 555 556 $self->{_skip_drain_rbuf} = 1; 557 558 { 559 Scalar::Util::weaken (my $self = $self); 560 561 $self->{_connect} = 562 AnyEvent::Socket::tcp_connect ( 563 $self->{connect}[0], 564 $self->{connect}[1], 565 sub { 566 my ($fh, $host, $port, $retry) = @_; 567 568 delete $self->{_connect}; # no longer needed 569 570 if ($fh) { 571 $self->{fh} = $fh; 572 573 delete $self->{_skip_drain_rbuf}; 574 $self->_start; 575 576 $self->{on_connect} 577 and $self->{on_connect}($self, $host, $port, sub { 578 delete @$self{qw(fh _tw _rtw _wtw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)}; 579 $self->{_skip_drain_rbuf} = 1; 580 &$retry; 581 }); 582 583 } else { 584 if ($self->{on_connect_error}) { 585 $self->{on_connect_error}($self, "$!"); 586 $self->destroy if $self; 587 } else { 588 $self->_error ($!, 1); 589 } 590 } 591 }, 592 sub { 593 local $self->{fh} = $_[0]; 594 595 $self->{on_prepare} 596 ? $self->{on_prepare}->($self) 597 : () 598 } 599 ); 600 } 601 602 } else { 603 Carp::croak "AnyEvent::Handle: either an existing fh or the connect parameter must be specified"; 604 } 605 606 $self 607} 608 609sub _start { 610 my ($self) = @_; 611 612 # too many clueless people try to use udp and similar sockets 613 # with AnyEvent::Handle, do them a favour. 614 my $type = getsockopt $self->{fh}, Socket::SOL_SOCKET (), Socket::SO_TYPE (); 615 Carp::croak "AnyEvent::Handle: only stream sockets supported, anything else will NOT work!" 616 if Socket::SOCK_STREAM () != (unpack "I", $type) && defined $type; 617 618 AnyEvent::fh_unblock $self->{fh}; 619 620 $self->{_activity} = 621 $self->{_ractivity} = 622 $self->{_wactivity} = AE::now; 623 624 $self->{read_size} ||= 2048; 625 $self->{max_read_size} = $self->{read_size} 626 if $self->{read_size} > ($self->{max_read_size} || MAX_READ_SIZE); 627 628 $self->timeout (delete $self->{timeout} ) if $self->{timeout}; 629 $self->rtimeout (delete $self->{rtimeout} ) if $self->{rtimeout}; 630 $self->wtimeout (delete $self->{wtimeout} ) if $self->{wtimeout}; 631 632 $self->no_delay (delete $self->{no_delay} ) if exists $self->{no_delay} && $self->{no_delay}; 633 $self->keepalive (delete $self->{keepalive}) if exists $self->{keepalive} && $self->{keepalive}; 634 635 $self->oobinline (exists $self->{oobinline} ? delete $self->{oobinline} : 1); 636 637 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 638 if $self->{tls}; 639 640 $self->on_drain (delete $self->{on_drain} ) if $self->{on_drain}; 641 642 $self->start_read 643 if $self->{on_read} || @{ $self->{_queue} }; 644 645 $self->_drain_wbuf; 646} 647 648sub _error { 649 my ($self, $errno, $fatal, $message) = @_; 650 651 $! = $errno; 652 $message ||= "$!"; 653 654 if ($self->{on_error}) { 655 $self->{on_error}($self, $fatal, $message); 656 $self->destroy if $fatal; 657 } elsif ($self->{fh} || $self->{connect}) { 658 $self->destroy; 659 Carp::croak "AnyEvent::Handle uncaught error: $message"; 660 } 661} 662 663=item $fh = $handle->fh 664 665This method returns the file handle used to create the L<AnyEvent::Handle> object. 666 667=cut 668 669sub fh { $_[0]{fh} } 670 671=item $handle->on_error ($cb) 672 673Replace the current C<on_error> callback (see the C<on_error> constructor argument). 674 675=cut 676 677sub on_error { 678 $_[0]{on_error} = $_[1]; 679} 680 681=item $handle->on_eof ($cb) 682 683Replace the current C<on_eof> callback (see the C<on_eof> constructor argument). 684 685=cut 686 687sub on_eof { 688 $_[0]{on_eof} = $_[1]; 689} 690 691=item $handle->on_timeout ($cb) 692 693=item $handle->on_rtimeout ($cb) 694 695=item $handle->on_wtimeout ($cb) 696 697Replace the current C<on_timeout>, C<on_rtimeout> or C<on_wtimeout> 698callback, or disables the callback (but not the timeout) if C<$cb> = 699C<undef>. See the C<timeout> constructor argument and method. 700 701=cut 702 703# see below 704 705=item $handle->autocork ($boolean) 706 707Enables or disables the current autocork behaviour (see C<autocork> 708constructor argument). Changes will only take effect on the next write. 709 710=cut 711 712sub autocork { 713 $_[0]{autocork} = $_[1]; 714} 715 716=item $handle->no_delay ($boolean) 717 718Enables or disables the C<no_delay> setting (see constructor argument of 719the same name for details). 720 721=cut 722 723sub no_delay { 724 $_[0]{no_delay} = $_[1]; 725 726 setsockopt $_[0]{fh}, Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), int $_[1] 727 if $_[0]{fh}; 728} 729 730=item $handle->keepalive ($boolean) 731 732Enables or disables the C<keepalive> setting (see constructor argument of 733the same name for details). 734 735=cut 736 737sub keepalive { 738 $_[0]{keepalive} = $_[1]; 739 740 eval { 741 local $SIG{__DIE__}; 742 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1] 743 if $_[0]{fh}; 744 }; 745} 746 747=item $handle->oobinline ($boolean) 748 749Enables or disables the C<oobinline> setting (see constructor argument of 750the same name for details). 751 752=cut 753 754sub oobinline { 755 $_[0]{oobinline} = $_[1]; 756 757 eval { 758 local $SIG{__DIE__}; 759 setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1] 760 if $_[0]{fh}; 761 }; 762} 763 764=item $handle->on_starttls ($cb) 765 766Replace the current C<on_starttls> callback (see the C<on_starttls> constructor argument). 767 768=cut 769 770sub on_starttls { 771 $_[0]{on_starttls} = $_[1]; 772} 773 774=item $handle->on_stoptls ($cb) 775 776Replace the current C<on_stoptls> callback (see the C<on_stoptls> constructor argument). 777 778=cut 779 780sub on_stoptls { 781 $_[0]{on_stoptls} = $_[1]; 782} 783 784=item $handle->rbuf_max ($max_octets) 785 786Configures the C<rbuf_max> setting (C<undef> disables it). 787 788=item $handle->wbuf_max ($max_octets) 789 790Configures the C<wbuf_max> setting (C<undef> disables it). 791 792=cut 793 794sub rbuf_max { 795 $_[0]{rbuf_max} = $_[1]; 796} 797 798sub wbuf_max { 799 $_[0]{wbuf_max} = $_[1]; 800} 801 802############################################################################# 803 804=item $handle->timeout ($seconds) 805 806=item $handle->rtimeout ($seconds) 807 808=item $handle->wtimeout ($seconds) 809 810Configures (or disables) the inactivity timeout. 811 812The timeout will be checked instantly, so this method might destroy the 813handle before it returns. 814 815=item $handle->timeout_reset 816 817=item $handle->rtimeout_reset 818 819=item $handle->wtimeout_reset 820 821Reset the activity timeout, as if data was received or sent. 822 823These methods are cheap to call. 824 825=cut 826 827for my $dir ("", "r", "w") { 828 my $timeout = "${dir}timeout"; 829 my $tw = "_${dir}tw"; 830 my $on_timeout = "on_${dir}timeout"; 831 my $activity = "_${dir}activity"; 832 my $cb; 833 834 *$on_timeout = sub { 835 $_[0]{$on_timeout} = $_[1]; 836 }; 837 838 *$timeout = sub { 839 my ($self, $new_value) = @_; 840 841 $new_value >= 0 842 or Carp::croak "AnyEvent::Handle->$timeout called with negative timeout ($new_value), caught"; 843 844 $self->{$timeout} = $new_value; 845 delete $self->{$tw}; &$cb; 846 }; 847 848 *{"${dir}timeout_reset"} = sub { 849 $_[0]{$activity} = AE::now; 850 }; 851 852 # main workhorse: 853 # reset the timeout watcher, as neccessary 854 # also check for time-outs 855 $cb = sub { 856 my ($self) = @_; 857 858 if ($self->{$timeout} && $self->{fh}) { 859 my $NOW = AE::now; 860 861 # when would the timeout trigger? 862 my $after = $self->{$activity} + $self->{$timeout} - $NOW; 863 864 # now or in the past already? 865 if ($after <= 0) { 866 $self->{$activity} = $NOW; 867 868 if ($self->{$on_timeout}) { 869 $self->{$on_timeout}($self); 870 } else { 871 $self->_error (Errno::ETIMEDOUT); 872 } 873 874 # callback could have changed timeout value, optimise 875 return unless $self->{$timeout}; 876 877 # calculate new after 878 $after = $self->{$timeout}; 879 } 880 881 Scalar::Util::weaken $self; 882 return unless $self; # ->error could have destroyed $self 883 884 $self->{$tw} ||= AE::timer $after, 0, sub { 885 delete $self->{$tw}; 886 $cb->($self); 887 }; 888 } else { 889 delete $self->{$tw}; 890 } 891 } 892} 893 894############################################################################# 895 896=back 897 898=head2 WRITE QUEUE 899 900AnyEvent::Handle manages two queues per handle, one for writing and one 901for reading. 902 903The write queue is very simple: you can add data to its end, and 904AnyEvent::Handle will automatically try to get rid of it for you. 905 906When data could be written and the write buffer is shorter then the low 907water mark, the C<on_drain> callback will be invoked once. 908 909=over 4 910 911=item $handle->on_drain ($cb) 912 913Sets the C<on_drain> callback or clears it (see the description of 914C<on_drain> in the constructor). 915 916This method may invoke callbacks (and therefore the handle might be 917destroyed after it returns). 918 919=cut 920 921sub on_drain { 922 my ($self, $cb) = @_; 923 924 $self->{on_drain} = $cb; 925 926 $cb->($self) 927 if $cb && $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}); 928} 929 930=item $handle->push_write ($data) 931 932Queues the given scalar to be written. You can push as much data as 933you want (only limited by the available memory and C<wbuf_max>), as 934C<AnyEvent::Handle> buffers it independently of the kernel. 935 936This method may invoke callbacks (and therefore the handle might be 937destroyed after it returns). 938 939=cut 940 941sub _drain_wbuf { 942 my ($self) = @_; 943 944 if (!$self->{_ww} && length $self->{wbuf}) { 945 946 Scalar::Util::weaken $self; 947 948 my $cb = sub { 949 my $len = syswrite $self->{fh}, $self->{wbuf}; 950 951 if (defined $len) { 952 substr $self->{wbuf}, 0, $len, ""; 953 954 $self->{_activity} = $self->{_wactivity} = AE::now; 955 956 $self->{on_drain}($self) 957 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}) 958 && $self->{on_drain}; 959 960 delete $self->{_ww} unless length $self->{wbuf}; 961 } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) { 962 $self->_error ($!, 1); 963 } 964 }; 965 966 # try to write data immediately 967 $cb->() unless $self->{autocork}; 968 969 # if still data left in wbuf, we need to poll 970 $self->{_ww} = AE::io $self->{fh}, 1, $cb 971 if length $self->{wbuf}; 972 973 if ( 974 defined $self->{wbuf_max} 975 && $self->{wbuf_max} < length $self->{wbuf} 976 ) { 977 $self->_error (Errno::ENOSPC, 1), return; 978 } 979 }; 980} 981 982our %WH; 983 984# deprecated 985sub register_write_type($$) { 986 $WH{$_[0]} = $_[1]; 987} 988 989sub push_write { 990 my $self = shift; 991 992 if (@_ > 1) { 993 my $type = shift; 994 995 @_ = ($WH{$type} ||= _load_func "$type\::anyevent_write_type" 996 or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_write") 997 ->($self, @_); 998 } 999 1000 # we downgrade here to avoid hard-to-track-down bugs, 1001 # and diagnose the problem earlier and better. 1002 1003 if ($self->{tls}) { 1004 utf8::downgrade $self->{_tls_wbuf} .= $_[0]; 1005 &_dotls ($self) if $self->{fh}; 1006 } else { 1007 utf8::downgrade $self->{wbuf} .= $_[0]; 1008 $self->_drain_wbuf if $self->{fh}; 1009 } 1010} 1011 1012=item $handle->push_write (type => @args) 1013 1014Instead of formatting your data yourself, you can also let this module 1015do the job by specifying a type and type-specific arguments. You 1016can also specify the (fully qualified) name of a package, in which 1017case AnyEvent tries to load the package and then expects to find the 1018C<anyevent_write_type> function inside (see "custom write types", below). 1019 1020Predefined types are (if you have ideas for additional types, feel free to 1021drop by and tell us): 1022 1023=over 4 1024 1025=item netstring => $string 1026 1027Formats the given value as netstring 1028(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 1029 1030=cut 1031 1032register_write_type netstring => sub { 1033 my ($self, $string) = @_; 1034 1035 (length $string) . ":$string," 1036}; 1037 1038=item packstring => $format, $data 1039 1040An octet string prefixed with an encoded length. The encoding C<$format> 1041uses the same format as a Perl C<pack> format, but must specify a single 1042integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an 1043optional C<!>, C<< < >> or C<< > >> modifier). 1044 1045=cut 1046 1047register_write_type packstring => sub { 1048 my ($self, $format, $string) = @_; 1049 1050 pack "$format/a*", $string 1051}; 1052 1053=item json => $array_or_hashref 1054 1055Encodes the given hash or array reference into a JSON object. Unless you 1056provide your own JSON object, this means it will be encoded to JSON text 1057in UTF-8. 1058 1059The default encoder might or might not handle every type of JSON value - 1060it might be limited to arrays and objects for security reasons. See the 1061C<json> constructor attribute for more details. 1062 1063JSON objects (and arrays) are self-delimiting, so if you only use arrays 1064and hashes, you can write JSON at one end of a handle and read them at the 1065other end without using any additional framing. 1066 1067The JSON text generated by the default encoder is guaranteed not to 1068contain any newlines: While this module doesn't need delimiters after or 1069between JSON texts to be able to read them, many other languages depend on 1070them. 1071 1072A simple RPC protocol that interoperates easily with other languages is 1073to send JSON arrays (or objects, although arrays are usually the better 1074choice as they mimic how function argument passing works) and a newline 1075after each JSON text: 1076 1077 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever 1078 $handle->push_write ("\012"); 1079 1080An AnyEvent::Handle receiver would simply use the C<json> read type and 1081rely on the fact that the newline will be skipped as leading whitespace: 1082 1083 $handle->push_read (json => sub { my $array = $_[1]; ... }); 1084 1085Other languages could read single lines terminated by a newline and pass 1086this line into their JSON decoder of choice. 1087 1088=item cbor => $perl_scalar 1089 1090Encodes the given scalar into a CBOR value. Unless you provide your own 1091L<CBOR::XS> object, this means it will be encoded to a CBOR string not 1092using any extensions, if possible. 1093 1094CBOR values are self-delimiting, so you can write CBOR at one end of 1095a handle and read them at the other end without using any additional 1096framing. 1097 1098A simple nd very very fast RPC protocol that interoperates with 1099other languages is to send CBOR and receive CBOR values (arrays are 1100recommended): 1101 1102 $handle->push_write (cbor => ["method", "arg1", "arg2"]); # whatever 1103 1104An AnyEvent::Handle receiver would simply use the C<cbor> read type: 1105 1106 $handle->push_read (cbor => sub { my $array = $_[1]; ... }); 1107 1108=cut 1109 1110sub json_coder() { 1111 eval { require JSON::XS; JSON::XS->new->utf8 } 1112 || do { require JSON::PP; JSON::PP->new->utf8 } 1113} 1114 1115register_write_type json => sub { 1116 my ($self, $ref) = @_; 1117 1118 ($self->{json} ||= json_coder) 1119 ->encode ($ref) 1120}; 1121 1122sub cbor_coder() { 1123 require CBOR::XS; 1124 CBOR::XS->new 1125} 1126 1127register_write_type cbor => sub { 1128 my ($self, $scalar) = @_; 1129 1130 ($self->{cbor} ||= cbor_coder) 1131 ->encode ($scalar) 1132}; 1133 1134=item storable => $reference 1135 1136Freezes the given reference using L<Storable> and writes it to the 1137handle. Uses the C<nfreeze> format. 1138 1139=cut 1140 1141register_write_type storable => sub { 1142 my ($self, $ref) = @_; 1143 1144 require Storable unless $Storable::VERSION; 1145 1146 pack "w/a*", Storable::nfreeze ($ref) 1147}; 1148 1149=back 1150 1151=item $handle->push_shutdown 1152 1153Sometimes you know you want to close the socket after writing your data 1154before it was actually written. One way to do that is to replace your 1155C<on_drain> handler by a callback that shuts down the socket (and set 1156C<low_water_mark> to C<0>). This method is a shorthand for just that, and 1157replaces the C<on_drain> callback with: 1158 1159 sub { shutdown $_[0]{fh}, 1 } 1160 1161This simply shuts down the write side and signals an EOF condition to the 1162the peer. 1163 1164You can rely on the normal read queue and C<on_eof> handling 1165afterwards. This is the cleanest way to close a connection. 1166 1167This method may invoke callbacks (and therefore the handle might be 1168destroyed after it returns). 1169 1170=cut 1171 1172sub push_shutdown { 1173 my ($self) = @_; 1174 1175 delete $self->{low_water_mark}; 1176 $self->on_drain (sub { shutdown $_[0]{fh}, 1 }); 1177} 1178 1179=item custom write types - Package::anyevent_write_type $handle, @args 1180 1181Instead of one of the predefined types, you can also specify the name of 1182a package. AnyEvent will try to load the package and then expects to find 1183a function named C<anyevent_write_type> inside. If it isn't found, it 1184progressively tries to load the parent package until it either finds the 1185function (good) or runs out of packages (bad). 1186 1187Whenever the given C<type> is used, C<push_write> will the function with 1188the handle object and the remaining arguments. 1189 1190The function is supposed to return a single octet string that will be 1191appended to the write buffer, so you can mentally treat this function as a 1192"arguments to on-the-wire-format" converter. 1193 1194Example: implement a custom write type C<join> that joins the remaining 1195arguments using the first one. 1196 1197 $handle->push_write (My::Type => " ", 1,2,3); 1198 1199 # uses the following package, which can be defined in the "My::Type" or in 1200 # the "My" modules to be auto-loaded, or just about anywhere when the 1201 # My::Type::anyevent_write_type is defined before invoking it. 1202 1203 package My::Type; 1204 1205 sub anyevent_write_type { 1206 my ($handle, $delim, @args) = @_; 1207 1208 join $delim, @args 1209 } 1210 1211=cut 1212 1213############################################################################# 1214 1215=back 1216 1217=head2 READ QUEUE 1218 1219AnyEvent::Handle manages two queues per handle, one for writing and one 1220for reading. 1221 1222The read queue is more complex than the write queue. It can be used in two 1223ways, the "simple" way, using only C<on_read> and the "complex" way, using 1224a queue. 1225 1226In the simple case, you just install an C<on_read> callback and whenever 1227new data arrives, it will be called. You can then remove some data (if 1228enough is there) from the read buffer (C<< $handle->rbuf >>). Or you can 1229leave the data there if you want to accumulate more (e.g. when only a 1230partial message has been received so far), or change the read queue with 1231e.g. C<push_read>. 1232 1233In the more complex case, you want to queue multiple callbacks. In this 1234case, AnyEvent::Handle will call the first queued callback each time new 1235data arrives (also the first time it is queued) and remove it when it has 1236done its job (see C<push_read>, below). 1237 1238This way you can, for example, push three line-reads, followed by reading 1239a chunk of data, and AnyEvent::Handle will execute them in order. 1240 1241Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by 1242the specified number of bytes which give an XML datagram. 1243 1244 # in the default state, expect some header bytes 1245 $handle->on_read (sub { 1246 # some data is here, now queue the length-header-read (4 octets) 1247 shift->unshift_read (chunk => 4, sub { 1248 # header arrived, decode 1249 my $len = unpack "N", $_[1]; 1250 1251 # now read the payload 1252 shift->unshift_read (chunk => $len, sub { 1253 my $xml = $_[1]; 1254 # handle xml 1255 }); 1256 }); 1257 }); 1258 1259Example 2: Implement a client for a protocol that replies either with "OK" 1260and another line or "ERROR" for the first request that is sent, and 64 1261bytes for the second request. Due to the availability of a queue, we can 1262just pipeline sending both requests and manipulate the queue as necessary 1263in the callbacks. 1264 1265When the first callback is called and sees an "OK" response, it will 1266C<unshift> another line-read. This line-read will be queued I<before> the 126764-byte chunk callback. 1268 1269 # request one, returns either "OK + extra line" or "ERROR" 1270 $handle->push_write ("request 1\015\012"); 1271 1272 # we expect "ERROR" or "OK" as response, so push a line read 1273 $handle->push_read (line => sub { 1274 # if we got an "OK", we have to _prepend_ another line, 1275 # so it will be read before the second request reads its 64 bytes 1276 # which are already in the queue when this callback is called 1277 # we don't do this in case we got an error 1278 if ($_[1] eq "OK") { 1279 $_[0]->unshift_read (line => sub { 1280 my $response = $_[1]; 1281 ... 1282 }); 1283 } 1284 }); 1285 1286 # request two, simply returns 64 octets 1287 $handle->push_write ("request 2\015\012"); 1288 1289 # simply read 64 bytes, always 1290 $handle->push_read (chunk => 64, sub { 1291 my $response = $_[1]; 1292 ... 1293 }); 1294 1295=over 4 1296 1297=cut 1298 1299sub _drain_rbuf { 1300 my ($self) = @_; 1301 1302 # avoid recursion 1303 return if $self->{_skip_drain_rbuf}; 1304 local $self->{_skip_drain_rbuf} = 1; 1305 1306 while () { 1307 # we need to use a separate tls read buffer, as we must not receive data while 1308 # we are draining the buffer, and this can only happen with TLS. 1309 $self->{rbuf} .= delete $self->{_tls_rbuf} 1310 if exists $self->{_tls_rbuf}; 1311 1312 my $len = length $self->{rbuf}; 1313 1314 if (my $cb = shift @{ $self->{_queue} }) { 1315 unless ($cb->($self)) { 1316 # no progress can be made 1317 # (not enough data and no data forthcoming) 1318 $self->_error (Errno::EPIPE, 1), return 1319 if $self->{_eof}; 1320 1321 unshift @{ $self->{_queue} }, $cb; 1322 last; 1323 } 1324 } elsif ($self->{on_read}) { 1325 last unless $len; 1326 1327 $self->{on_read}($self); 1328 1329 if ( 1330 $len == length $self->{rbuf} # if no data has been consumed 1331 && !@{ $self->{_queue} } # and the queue is still empty 1332 && $self->{on_read} # but we still have on_read 1333 ) { 1334 # no further data will arrive 1335 # so no progress can be made 1336 $self->_error (Errno::EPIPE, 1), return 1337 if $self->{_eof}; 1338 1339 last; # more data might arrive 1340 } 1341 } else { 1342 # read side becomes idle 1343 delete $self->{_rw} unless $self->{tls}; 1344 last; 1345 } 1346 } 1347 1348 if ($self->{_eof}) { 1349 $self->{on_eof} 1350 ? $self->{on_eof}($self) 1351 : $self->_error (0, 1, "Unexpected end-of-file"); 1352 1353 return; 1354 } 1355 1356 if ( 1357 defined $self->{rbuf_max} 1358 && $self->{rbuf_max} < length $self->{rbuf} 1359 ) { 1360 $self->_error (Errno::ENOSPC, 1), return; 1361 } 1362 1363 # may need to restart read watcher 1364 unless ($self->{_rw}) { 1365 $self->start_read 1366 if $self->{on_read} || @{ $self->{_queue} }; 1367 } 1368} 1369 1370=item $handle->on_read ($cb) 1371 1372This replaces the currently set C<on_read> callback, or clears it (when 1373the new callback is C<undef>). See the description of C<on_read> in the 1374constructor. 1375 1376This method may invoke callbacks (and therefore the handle might be 1377destroyed after it returns). 1378 1379=cut 1380 1381sub on_read { 1382 my ($self, $cb) = @_; 1383 1384 $self->{on_read} = $cb; 1385 $self->_drain_rbuf if $cb; 1386} 1387 1388=item $handle->rbuf 1389 1390Returns the read buffer (as a modifiable lvalue). You can also access the 1391read buffer directly as the C<< ->{rbuf} >> member, if you want (this is 1392much faster, and no less clean). 1393 1394The only operation allowed on the read buffer (apart from looking at it) 1395is removing data from its beginning. Otherwise modifying or appending to 1396it is not allowed and will lead to hard-to-track-down bugs. 1397 1398NOTE: The read buffer should only be used or modified in the C<on_read> 1399callback or when C<push_read> or C<unshift_read> are used with a single 1400callback (i.e. untyped). Typed C<push_read> and C<unshift_read> methods 1401will manage the read buffer on their own. 1402 1403=cut 1404 1405sub rbuf : lvalue { 1406 $_[0]{rbuf} 1407} 1408 1409=item $handle->push_read ($cb) 1410 1411=item $handle->unshift_read ($cb) 1412 1413Append the given callback to the end of the queue (C<push_read>) or 1414prepend it (C<unshift_read>). 1415 1416The callback is called each time some additional read data arrives. 1417 1418It must check whether enough data is in the read buffer already. 1419 1420If not enough data is available, it must return the empty list or a false 1421value, in which case it will be called repeatedly until enough data is 1422available (or an error condition is detected). 1423 1424If enough data was available, then the callback must remove all data it is 1425interested in (which can be none at all) and return a true value. After returning 1426true, it will be removed from the queue. 1427 1428These methods may invoke callbacks (and therefore the handle might be 1429destroyed after it returns). 1430 1431=cut 1432 1433our %RH; 1434 1435sub register_read_type($$) { 1436 $RH{$_[0]} = $_[1]; 1437} 1438 1439sub push_read { 1440 my $self = shift; 1441 my $cb = pop; 1442 1443 if (@_) { 1444 my $type = shift; 1445 1446 $cb = ($RH{$type} ||= _load_func "$type\::anyevent_read_type" 1447 or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_read") 1448 ->($self, $cb, @_); 1449 } 1450 1451 push @{ $self->{_queue} }, $cb; 1452 $self->_drain_rbuf; 1453} 1454 1455sub unshift_read { 1456 my $self = shift; 1457 my $cb = pop; 1458 1459 if (@_) { 1460 my $type = shift; 1461 1462 $cb = ($RH{$type} ||= _load_func "$type\::anyevent_read_type" 1463 or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::unshift_read") 1464 ->($self, $cb, @_); 1465 } 1466 1467 unshift @{ $self->{_queue} }, $cb; 1468 $self->_drain_rbuf; 1469} 1470 1471=item $handle->push_read (type => @args, $cb) 1472 1473=item $handle->unshift_read (type => @args, $cb) 1474 1475Instead of providing a callback that parses the data itself you can chose 1476between a number of predefined parsing formats, for chunks of data, lines 1477etc. You can also specify the (fully qualified) name of a package, in 1478which case AnyEvent tries to load the package and then expects to find the 1479C<anyevent_read_type> function inside (see "custom read types", below). 1480 1481Predefined types are (if you have ideas for additional types, feel free to 1482drop by and tell us): 1483 1484=over 4 1485 1486=item chunk => $octets, $cb->($handle, $data) 1487 1488Invoke the callback only once C<$octets> bytes have been read. Pass the 1489data read to the callback. The callback will never be called with less 1490data. 1491 1492Example: read 2 bytes. 1493 1494 $handle->push_read (chunk => 2, sub { 1495 say "yay " . unpack "H*", $_[1]; 1496 }); 1497 1498=cut 1499 1500register_read_type chunk => sub { 1501 my ($self, $cb, $len) = @_; 1502 1503 sub { 1504 $len <= length $_[0]{rbuf} or return; 1505 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 1506 1 1507 } 1508}; 1509 1510=item line => [$eol, ]$cb->($handle, $line, $eol) 1511 1512The callback will be called only once a full line (including the end of 1513line marker, C<$eol>) has been read. This line (excluding the end of line 1514marker) will be passed to the callback as second argument (C<$line>), and 1515the end of line marker as the third argument (C<$eol>). 1516 1517The end of line marker, C<$eol>, can be either a string, in which case it 1518will be interpreted as a fixed record end marker, or it can be a regex 1519object (e.g. created by C<qr>), in which case it is interpreted as a 1520regular expression. 1521 1522The end of line marker argument C<$eol> is optional, if it is missing (NOT 1523undef), then C<qr|\015?\012|> is used (which is good for most internet 1524protocols). 1525 1526Partial lines at the end of the stream will never be returned, as they are 1527not marked by the end of line marker. 1528 1529=cut 1530 1531register_read_type line => sub { 1532 my ($self, $cb, $eol) = @_; 1533 1534 if (@_ < 3) { 1535 # this is faster then the generic code below 1536 sub { 1537 (my $pos = index $_[0]{rbuf}, "\012") >= 0 1538 or return; 1539 1540 (my $str = substr $_[0]{rbuf}, 0, $pos + 1, "") =~ s/(\015?\012)\Z// or die; 1541 $cb->($_[0], $str, "$1"); 1542 1 1543 } 1544 } else { 1545 $eol = quotemeta $eol unless ref $eol; 1546 $eol = qr|^(.*?)($eol)|s; 1547 1548 sub { 1549 $_[0]{rbuf} =~ s/$eol// or return; 1550 1551 $cb->($_[0], "$1", "$2"); 1552 1 1553 } 1554 } 1555}; 1556 1557=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 1558 1559Makes a regex match against the regex object C<$accept> and returns 1560everything up to and including the match. All the usual regex variables 1561($1, %+ etc.) from the regex match are available in the callback. 1562 1563Example: read a single line terminated by '\n'. 1564 1565 $handle->push_read (regex => qr<\n>, sub { ... }); 1566 1567If C<$reject> is given and not undef, then it determines when the data is 1568to be rejected: it is matched against the data when the C<$accept> regex 1569does not match and generates an C<EBADMSG> error when it matches. This is 1570useful to quickly reject wrong data (to avoid waiting for a timeout or a 1571receive buffer overflow). 1572 1573Example: expect a single decimal number followed by whitespace, reject 1574anything else (not the use of an anchor). 1575 1576 $handle->push_read (regex => qr<^[0-9]+\s>, qr<[^0-9]>, sub { ... }); 1577 1578If C<$skip> is given and not C<undef>, then it will be matched against 1579the receive buffer when neither C<$accept> nor C<$reject> match, 1580and everything preceding and including the match will be accepted 1581unconditionally. This is useful to skip large amounts of data that you 1582know cannot be matched, so that the C<$accept> or C<$reject> regex do not 1583have to start matching from the beginning. This is purely an optimisation 1584and is usually worth it only when you expect more than a few kilobytes. 1585 1586Example: expect a http header, which ends at C<\015\012\015\012>. Since we 1587expect the header to be very large (it isn't in practice, but...), we use 1588a skip regex to skip initial portions. The skip regex is tricky in that 1589it only accepts something not ending in either \015 or \012, as these are 1590required for the accept regex. 1591 1592 $handle->push_read (regex => 1593 qr<\015\012\015\012>, 1594 undef, # no reject 1595 qr<^.*[^\015\012]>, 1596 sub { ... }); 1597 1598=cut 1599 1600register_read_type regex => sub { 1601 my ($self, $cb, $accept, $reject, $skip) = @_; 1602 1603 my $data; 1604 my $rbuf = \$self->{rbuf}; 1605 1606 sub { 1607 # accept 1608 if ($$rbuf =~ $accept) { 1609 $data .= substr $$rbuf, 0, $+[0], ""; 1610 $cb->($_[0], $data); 1611 return 1; 1612 } 1613 1614 # reject 1615 if ($reject && $$rbuf =~ $reject) { 1616 $_[0]->_error (Errno::EBADMSG); 1617 } 1618 1619 # skip 1620 if ($skip && $$rbuf =~ $skip) { 1621 $data .= substr $$rbuf, 0, $+[0], ""; 1622 } 1623 1624 () 1625 } 1626}; 1627 1628=item netstring => $cb->($handle, $string) 1629 1630A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement). 1631 1632Throws an error with C<$!> set to EBADMSG on format violations. 1633 1634=cut 1635 1636register_read_type netstring => sub { 1637 my ($self, $cb) = @_; 1638 1639 sub { 1640 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 1641 if ($_[0]{rbuf} =~ /[^0-9]/) { 1642 $_[0]->_error (Errno::EBADMSG); 1643 } 1644 return; 1645 } 1646 1647 my $len = $1; 1648 1649 $_[0]->unshift_read (chunk => $len, sub { 1650 my $string = $_[1]; 1651 $_[0]->unshift_read (chunk => 1, sub { 1652 if ($_[1] eq ",") { 1653 $cb->($_[0], $string); 1654 } else { 1655 $_[0]->_error (Errno::EBADMSG); 1656 } 1657 }); 1658 }); 1659 1660 1 1661 } 1662}; 1663 1664=item packstring => $format, $cb->($handle, $string) 1665 1666An octet string prefixed with an encoded length. The encoding C<$format> 1667uses the same format as a Perl C<pack> format, but must specify a single 1668integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an 1669optional C<!>, C<< < >> or C<< > >> modifier). 1670 1671For example, DNS over TCP uses a prefix of C<n> (2 octet network order), 1672EPP uses a prefix of C<N> (4 octtes). 1673 1674Example: read a block of data prefixed by its length in BER-encoded 1675format (very efficient). 1676 1677 $handle->push_read (packstring => "w", sub { 1678 my ($handle, $data) = @_; 1679 }); 1680 1681=cut 1682 1683register_read_type packstring => sub { 1684 my ($self, $cb, $format) = @_; 1685 1686 sub { 1687 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1688 defined (my $len = eval { unpack $format, $_[0]{rbuf} }) 1689 or return; 1690 1691 $format = length pack $format, $len; 1692 1693 # bypass unshift if we already have the remaining chunk 1694 if ($format + $len <= length $_[0]{rbuf}) { 1695 my $data = substr $_[0]{rbuf}, $format, $len; 1696 substr $_[0]{rbuf}, 0, $format + $len, ""; 1697 $cb->($_[0], $data); 1698 } else { 1699 # remove prefix 1700 substr $_[0]{rbuf}, 0, $format, ""; 1701 1702 # read remaining chunk 1703 $_[0]->unshift_read (chunk => $len, $cb); 1704 } 1705 1706 1 1707 } 1708}; 1709 1710=item json => $cb->($handle, $hash_or_arrayref) 1711 1712Reads a JSON object or array, decodes it and passes it to the 1713callback. When a parse error occurs, an C<EBADMSG> error will be raised. 1714 1715If a C<json> object was passed to the constructor, then that will be 1716used for the final decode, otherwise it will create a L<JSON::XS> or 1717L<JSON::PP> coder object expecting UTF-8. 1718 1719This read type uses the incremental parser available with JSON version 17202.09 (and JSON::XS version 2.2) and above. 1721 1722Since JSON texts are fully self-delimiting, the C<json> read and write 1723types are an ideal simple RPC protocol: just exchange JSON datagrams. See 1724the C<json> write type description, above, for an actual example. 1725 1726=cut 1727 1728register_read_type json => sub { 1729 my ($self, $cb) = @_; 1730 1731 my $json = $self->{json} ||= json_coder; 1732 1733 my $data; 1734 1735 sub { 1736 my $ref = eval { $json->incr_parse ($_[0]{rbuf}) }; 1737 1738 if ($ref) { 1739 $_[0]{rbuf} = $json->incr_text; 1740 $json->incr_text = ""; 1741 $cb->($_[0], $ref); 1742 1743 1 1744 } elsif ($@) { 1745 # error case 1746 $json->incr_skip; 1747 1748 $_[0]{rbuf} = $json->incr_text; 1749 $json->incr_text = ""; 1750 1751 $_[0]->_error (Errno::EBADMSG); 1752 1753 () 1754 } else { 1755 $_[0]{rbuf} = ""; 1756 1757 () 1758 } 1759 } 1760}; 1761 1762=item cbor => $cb->($handle, $scalar) 1763 1764Reads a CBOR value, decodes it and passes it to the callback. When a parse 1765error occurs, an C<EBADMSG> error will be raised. 1766 1767If a L<CBOR::XS> object was passed to the constructor, then that will be 1768used for the final decode, otherwise it will create a CBOR coder without 1769enabling any options. 1770 1771You have to provide a dependency to L<CBOR::XS> on your own: this module 1772will load the L<CBOR::XS> module, but AnyEvent does not depend on it 1773itself. 1774 1775Since CBOR values are fully self-delimiting, the C<cbor> read and write 1776types are an ideal simple RPC protocol: just exchange CBOR datagrams. See 1777the C<cbor> write type description, above, for an actual example. 1778 1779=cut 1780 1781register_read_type cbor => sub { 1782 my ($self, $cb) = @_; 1783 1784 my $cbor = $self->{cbor} ||= cbor_coder; 1785 1786 my $data; 1787 1788 sub { 1789 my (@value) = eval { $cbor->incr_parse ($_[0]{rbuf}) }; 1790 1791 if (@value) { 1792 $cb->($_[0], @value); 1793 1794 1 1795 } elsif ($@) { 1796 # error case 1797 $cbor->incr_reset; 1798 1799 $_[0]->_error (Errno::EBADMSG); 1800 1801 () 1802 } else { 1803 () 1804 } 1805 } 1806}; 1807 1808=item storable => $cb->($handle, $ref) 1809 1810Deserialises a L<Storable> frozen representation as written by the 1811C<storable> write type (BER-encoded length prefix followed by nfreeze'd 1812data). 1813 1814Raises C<EBADMSG> error if the data could not be decoded. 1815 1816=cut 1817 1818register_read_type storable => sub { 1819 my ($self, $cb) = @_; 1820 1821 require Storable unless $Storable::VERSION; 1822 1823 sub { 1824 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1825 defined (my $len = eval { unpack "w", $_[0]{rbuf} }) 1826 or return; 1827 1828 my $format = length pack "w", $len; 1829 1830 # bypass unshift if we already have the remaining chunk 1831 if ($format + $len <= length $_[0]{rbuf}) { 1832 my $data = substr $_[0]{rbuf}, $format, $len; 1833 substr $_[0]{rbuf}, 0, $format + $len, ""; 1834 1835 eval { $cb->($_[0], Storable::thaw ($data)); 1 } 1836 or return $_[0]->_error (Errno::EBADMSG); 1837 } else { 1838 # remove prefix 1839 substr $_[0]{rbuf}, 0, $format, ""; 1840 1841 # read remaining chunk 1842 $_[0]->unshift_read (chunk => $len, sub { 1843 eval { $cb->($_[0], Storable::thaw ($_[1])); 1 } 1844 or $_[0]->_error (Errno::EBADMSG); 1845 }); 1846 } 1847 1848 1 1849 } 1850}; 1851 1852=item tls_detect => $cb->($handle, $detect, $major, $minor) 1853 1854Checks the input stream for a valid SSL or TLS handshake TLSPaintext 1855record without consuming anything. Only SSL version 3 or higher 1856is handled, up to the fictituous protocol 4.x (but both SSL3+ and 1857SSL2-compatible framing is supported). 1858 1859If it detects that the input data is likely TLS, it calls the callback 1860with a true value for C<$detect> and the (on-wire) TLS version as second 1861and third argument (C<$major> is C<3>, and C<$minor> is 0..4 for SSL 18623.0, TLS 1.0, 1.1, 1.2 and 1.3, respectively). If it detects the input 1863to be definitely not TLS, it calls the callback with a false value for 1864C<$detect>. 1865 1866The callback could use this information to decide whether or not to start 1867TLS negotiation. 1868 1869In all cases the data read so far is passed to the following read 1870handlers. 1871 1872Usually you want to use the C<tls_autostart> read type instead. 1873 1874If you want to design a protocol that works in the presence of TLS 1875dtection, make sure that any non-TLS data doesn't start with the octet 22 1876(ASCII SYN, 16 hex) or 128-255 (i.e. highest bit set). The checks this 1877read type does are a bit more strict, but might losen in the future to 1878accomodate protocol changes. 1879 1880This read type does not rely on L<AnyEvent::TLS> (and thus, not on 1881L<Net::SSLeay>). 1882 1883=item tls_autostart => [$tls_ctx, ]$tls 1884 1885Tries to detect a valid SSL or TLS handshake. If one is detected, it tries 1886to start tls by calling C<starttls> with the given arguments. 1887 1888In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has 1889been configured to accept, as servers do not normally send a handshake on 1890their own and ths cannot be detected in this way. 1891 1892See C<tls_detect> above for more details. 1893 1894Example: give the client a chance to start TLS before accepting a text 1895line. 1896 1897 $hdl->push_read (tls_autostart => "accept"); 1898 $hdl->push_read (line => sub { 1899 print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n"; 1900 }); 1901 1902=cut 1903 1904register_read_type tls_detect => sub { 1905 my ($self, $cb) = @_; 1906 1907 sub { 1908 # this regex matches a full or partial tls record 1909 if ( 1910 # ssl3+: type(22=handshake) major(=3) minor(any) length_hi 1911 $self->{rbuf} =~ /^(?:\z| \x16 (\z| [\x03\x04] (?:\z| . (?:\z| [\x00-\x40] ))))/xs 1912 # ssl2 comapatible: len_hi len_lo type(1) major minor dummy(forlength) 1913 or $self->{rbuf} =~ /^(?:\z| [\x80-\xff] (?:\z| . (?:\z| \x01 (\z| [\x03\x04] (?:\z| . (?:\z| . ))))))/xs 1914 ) { 1915 return if 3 != length $1; # partial match, can't decide yet 1916 1917 # full match, valid TLS record 1918 my ($major, $minor) = unpack "CC", $1; 1919 $cb->($self, "accept", $major, $minor); 1920 } else { 1921 # mismatch == guaranteed not TLS 1922 $cb->($self, undef); 1923 } 1924 1925 1 1926 } 1927}; 1928 1929register_read_type tls_autostart => sub { 1930 my ($self, @tls) = @_; 1931 1932 $RH{tls_detect}($self, sub { 1933 return unless $_[1]; 1934 $_[0]->starttls (@tls); 1935 }) 1936}; 1937 1938=back 1939 1940=item custom read types - Package::anyevent_read_type $handle, $cb, @args 1941 1942Instead of one of the predefined types, you can also specify the name 1943of a package. AnyEvent will try to load the package and then expects to 1944find a function named C<anyevent_read_type> inside. If it isn't found, it 1945progressively tries to load the parent package until it either finds the 1946function (good) or runs out of packages (bad). 1947 1948Whenever this type is used, C<push_read> will invoke the function with the 1949handle object, the original callback and the remaining arguments. 1950 1951The function is supposed to return a callback (usually a closure) that 1952works as a plain read callback (see C<< ->push_read ($cb) >>), so you can 1953mentally treat the function as a "configurable read type to read callback" 1954converter. 1955 1956It should invoke the original callback when it is done reading (remember 1957to pass C<$handle> as first argument as all other callbacks do that, 1958although there is no strict requirement on this). 1959 1960For examples, see the source of this module (F<perldoc -m 1961AnyEvent::Handle>, search for C<register_read_type>)). 1962 1963=item $handle->stop_read 1964 1965=item $handle->start_read 1966 1967In rare cases you actually do not want to read anything from the 1968socket. In this case you can call C<stop_read>. Neither C<on_read> nor 1969any queued callbacks will be executed then. To start reading again, call 1970C<start_read>. 1971 1972Note that AnyEvent::Handle will automatically C<start_read> for you when 1973you change the C<on_read> callback or push/unshift a read callback, and it 1974will automatically C<stop_read> for you when neither C<on_read> is set nor 1975there are any read requests in the queue. 1976 1977In older versions of this module (<= 5.3), these methods had no effect, 1978as TLS does not support half-duplex connections. In current versions they 1979work as expected, as this behaviour is required to avoid certain resource 1980attacks, where the program would be forced to read (and buffer) arbitrary 1981amounts of data before being able to send some data. The drawback is that 1982some readings of the the SSL/TLS specifications basically require this 1983attack to be working, as SSL/TLS implementations might stall sending data 1984during a rehandshake. 1985 1986As a guideline, during the initial handshake, you should not stop reading, 1987and as a client, it might cause problems, depending on your application. 1988 1989=cut 1990 1991sub stop_read { 1992 my ($self) = @_; 1993 1994 delete $self->{_rw}; 1995} 1996 1997sub start_read { 1998 my ($self) = @_; 1999 2000 unless ($self->{_rw} || $self->{_eof} || !$self->{fh}) { 2001 Scalar::Util::weaken $self; 2002 2003 $self->{_rw} = AE::io $self->{fh}, 0, sub { 2004 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf}); 2005 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size}, length $$rbuf; 2006 2007 if ($len > 0) { 2008 $self->{_activity} = $self->{_ractivity} = AE::now; 2009 2010 if ($self->{tls}) { 2011 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); 2012 2013 &_dotls ($self); 2014 } else { 2015 $self->_drain_rbuf; 2016 } 2017 2018 if ($len == $self->{read_size}) { 2019 $self->{read_size} *= 2; 2020 $self->{read_size} = $self->{max_read_size} || MAX_READ_SIZE 2021 if $self->{read_size} > ($self->{max_read_size} || MAX_READ_SIZE); 2022 } 2023 2024 } elsif (defined $len) { 2025 delete $self->{_rw}; 2026 $self->{_eof} = 1; 2027 $self->_drain_rbuf; 2028 2029 } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) { 2030 return $self->_error ($!, 1); 2031 } 2032 }; 2033 } 2034} 2035 2036our $ERROR_SYSCALL; 2037our $ERROR_WANT_READ; 2038 2039sub _tls_error { 2040 my ($self, $err) = @_; 2041 2042 return $self->_error ($!, 1) 2043 if $err == Net::SSLeay::ERROR_SYSCALL (); 2044 2045 my $err = Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()); 2046 2047 # reduce error string to look less scary 2048 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /; 2049 2050 if ($self->{_on_starttls}) { 2051 (delete $self->{_on_starttls})->($self, undef, $err); 2052 &_freetls; 2053 } else { 2054 &_freetls; 2055 $self->_error (Errno::EPROTO, 1, $err); 2056 } 2057} 2058 2059# poll the write BIO and send the data if applicable 2060# also decode read data if possible 2061# this is basiclaly our TLS state machine 2062# more efficient implementations are possible with openssl, 2063# but not with the buggy and incomplete Net::SSLeay. 2064sub _dotls { 2065 my ($self) = @_; 2066 2067 my $tmp; 2068 2069 while (length $self->{_tls_wbuf}) { 2070 if (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) <= 0) { 2071 $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp); 2072 2073 return $self->_tls_error ($tmp) 2074 if $tmp != $ERROR_WANT_READ 2075 && ($tmp != $ERROR_SYSCALL || $!); 2076 2077 last; 2078 } 2079 2080 substr $self->{_tls_wbuf}, 0, $tmp, ""; 2081 } 2082 2083 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { 2084 unless (length $tmp) { 2085 $self->{_on_starttls} 2086 and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ??? 2087 &_freetls; 2088 2089 if ($self->{on_stoptls}) { 2090 $self->{on_stoptls}($self); 2091 return; 2092 } else { 2093 # let's treat SSL-eof as we treat normal EOF 2094 delete $self->{_rw}; 2095 $self->{_eof} = 1; 2096 } 2097 } 2098 2099 $self->{_tls_rbuf} .= $tmp; 2100 $self->_drain_rbuf; 2101 $self->{tls} or return; # tls session might have gone away in callback 2102 } 2103 2104 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); # -1 is not neccessarily correct, but Net::SSLeay doesn't tell us 2105 return $self->_tls_error ($tmp) 2106 if $tmp != $ERROR_WANT_READ 2107 && ($tmp != $ERROR_SYSCALL || $!); 2108 2109 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) { 2110 $self->{wbuf} .= $tmp; 2111 $self->_drain_wbuf; 2112 $self->{tls} or return; # tls session might have gone away in callback 2113 } 2114 2115 $self->{_on_starttls} 2116 and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK () 2117 and (delete $self->{_on_starttls})->($self, 1, "TLS/SSL connection established"); 2118} 2119 2120=item $handle->starttls ($tls[, $tls_ctx]) 2121 2122Instead of starting TLS negotiation immediately when the AnyEvent::Handle 2123object is created, you can also do that at a later time by calling 2124C<starttls>. See the C<tls> constructor argument for general info. 2125 2126Starting TLS is currently an asynchronous operation - when you push some 2127write data and then call C<< ->starttls >> then TLS negotiation will start 2128immediately, after which the queued write data is then sent. This might 2129change in future versions, so best make sure you have no outstanding write 2130data when calling this method. 2131 2132The first argument is the same as the C<tls> constructor argument (either 2133C<"connect">, C<"accept"> or an existing Net::SSLeay object). 2134 2135The second argument is the optional C<AnyEvent::TLS> object that is used 2136when AnyEvent::Handle has to create its own TLS connection object, or 2137a hash reference with C<< key => value >> pairs that will be used to 2138construct a new context. 2139 2140The TLS connection object will end up in C<< $handle->{tls} >>, the TLS 2141context in C<< $handle->{tls_ctx} >> after this call and can be used or 2142changed to your liking. Note that the handshake might have already started 2143when this function returns. 2144 2145Due to bugs in OpenSSL, it might or might not be possible to do multiple 2146handshakes on the same stream. It is best to not attempt to use the 2147stream after stopping TLS. 2148 2149This method may invoke callbacks (and therefore the handle might be 2150destroyed after it returns). 2151 2152=cut 2153 2154our %TLS_CACHE; #TODO not yet documented, should we? 2155 2156sub starttls { 2157 my ($self, $tls, $ctx) = @_; 2158 2159 Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught" 2160 if $self->{tls}; 2161 2162 unless (defined $AnyEvent::TLS::VERSION) { 2163 eval { 2164 require Net::SSLeay; 2165 require AnyEvent::TLS; 2166 1 2167 } or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system"); 2168 } 2169 2170 $self->{tls} = $tls; 2171 $self->{tls_ctx} = $ctx if @_ > 2; 2172 2173 return unless $self->{fh}; 2174 2175 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 2176 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 2177 2178 $tls = delete $self->{tls}; 2179 $ctx = $self->{tls_ctx}; 2180 2181 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session 2182 2183 if ("HASH" eq ref $ctx) { 2184 if ($ctx->{cache}) { 2185 my $key = $ctx+0; 2186 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx; 2187 } else { 2188 $ctx = new AnyEvent::TLS %$ctx; 2189 } 2190 } 2191 2192 $self->{tls_ctx} = $ctx || TLS_CTX (); 2193 $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername}); 2194 2195 # basically, this is deep magic (because SSL_read should have the same issues) 2196 # but the openssl maintainers basically said: "trust us, it just works". 2197 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 2198 # and mismaintained ssleay-module didn't offer them for a decade or so). 2199 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 2200 # 2201 # in short: this is a mess. 2202 # 2203 # note that we do not try to keep the length constant between writes as we are required to do. 2204 # we assume that most (but not all) of this insanity only applies to non-blocking cases, 2205 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 2206 # have identity issues in that area. 2207# Net::SSLeay::set_mode ($ssl, 2208# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 2209# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 2210 Net::SSLeay::set_mode ($tls, 1|2); 2211 2212 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 2213 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 2214 2215 Net::SSLeay::BIO_write ($self->{_rbio}, $self->{rbuf}); 2216 $self->{rbuf} = ""; 2217 2218 Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio}); 2219 2220 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 2221 if $self->{on_starttls}; 2222 2223 &_dotls; # need to trigger the initial handshake 2224 $self->start_read; # make sure we actually do read 2225} 2226 2227=item $handle->stoptls 2228 2229Shuts down the SSL connection - this makes a proper EOF handshake by 2230sending a close notify to the other side, but since OpenSSL doesn't 2231support non-blocking shut downs, it is not guaranteed that you can re-use 2232the stream afterwards. 2233 2234This method may invoke callbacks (and therefore the handle might be 2235destroyed after it returns). 2236 2237=cut 2238 2239sub stoptls { 2240 my ($self) = @_; 2241 2242 if ($self->{tls} && $self->{fh}) { 2243 Net::SSLeay::shutdown ($self->{tls}); 2244 2245 &_dotls; 2246 2247# # we don't give a shit. no, we do, but we can't. no...#d# 2248# # we, we... have to use openssl :/#d# 2249# &_freetls;#d# 2250 } 2251} 2252 2253sub _freetls { 2254 my ($self) = @_; 2255 2256 return unless $self->{tls}; 2257 2258 $self->{tls_ctx}->_put_session (delete $self->{tls}) 2259 if $self->{tls} > 0; 2260 2261 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; 2262} 2263 2264=item $handle->resettls 2265 2266This rarely-used method simply resets and TLS state on the handle, usually 2267causing data loss. 2268 2269One case where it may be useful is when you want to skip over the data in 2270the stream but you are not interested in interpreting it, so data loss is 2271no concern. 2272 2273=cut 2274 2275*resettls = \&_freetls; 2276 2277sub DESTROY { 2278 my ($self) = @_; 2279 2280 &_freetls; 2281 2282 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 2283 2284 if ($linger && length $self->{wbuf} && $self->{fh}) { 2285 my $fh = delete $self->{fh}; 2286 my $wbuf = delete $self->{wbuf}; 2287 2288 my @linger; 2289 2290 push @linger, AE::io $fh, 1, sub { 2291 my $len = syswrite $fh, $wbuf, length $wbuf; 2292 2293 if ($len > 0) { 2294 substr $wbuf, 0, $len, ""; 2295 } elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK)) { 2296 @linger = (); # end 2297 } 2298 }; 2299 push @linger, AE::timer $linger, 0, sub { 2300 @linger = (); 2301 }; 2302 } 2303} 2304 2305=item $handle->destroy 2306 2307Shuts down the handle object as much as possible - this call ensures that 2308no further callbacks will be invoked and as many resources as possible 2309will be freed. Any method you will call on the handle object after 2310destroying it in this way will be silently ignored (and it will return the 2311empty list). 2312 2313Normally, you can just "forget" any references to an AnyEvent::Handle 2314object and it will simply shut down. This works in fatal error and EOF 2315callbacks, as well as code outside. It does I<NOT> work in a read or write 2316callback, so when you want to destroy the AnyEvent::Handle object from 2317within such an callback. You I<MUST> call C<< ->destroy >> explicitly in 2318that case. 2319 2320Destroying the handle object in this way has the advantage that callbacks 2321will be removed as well, so if those are the only reference holders (as 2322is common), then one doesn't need to do anything special to break any 2323reference cycles. 2324 2325The handle might still linger in the background and write out remaining 2326data, as specified by the C<linger> option, however. 2327 2328=cut 2329 2330sub destroy { 2331 my ($self) = @_; 2332 2333 $self->DESTROY; 2334 %$self = (); 2335 bless $self, "AnyEvent::Handle::destroyed"; 2336} 2337 2338sub AnyEvent::Handle::destroyed::AUTOLOAD { 2339 #nop 2340} 2341 2342=item $handle->destroyed 2343 2344Returns false as long as the handle hasn't been destroyed by a call to C<< 2345->destroy >>, true otherwise. 2346 2347Can be useful to decide whether the handle is still valid after some 2348callback possibly destroyed the handle. For example, C<< ->push_write >>, 2349C<< ->starttls >> and other methods can call user callbacks, which in turn 2350can destroy the handle, so work can be avoided by checking sometimes: 2351 2352 $hdl->starttls ("accept"); 2353 return if $hdl->destroyed; 2354 $hdl->push_write (... 2355 2356Note that the call to C<push_write> will silently be ignored if the handle 2357has been destroyed, so often you can just ignore the possibility of the 2358handle being destroyed. 2359 2360=cut 2361 2362sub destroyed { 0 } 2363sub AnyEvent::Handle::destroyed::destroyed { 1 } 2364 2365=item AnyEvent::Handle::TLS_CTX 2366 2367This function creates and returns the AnyEvent::TLS object used by default 2368for TLS mode. 2369 2370The context is created by calling L<AnyEvent::TLS> without any arguments. 2371 2372=cut 2373 2374our $TLS_CTX; 2375 2376sub TLS_CTX() { 2377 $TLS_CTX ||= do { 2378 require AnyEvent::TLS; 2379 2380 new AnyEvent::TLS 2381 } 2382} 2383 2384=back 2385 2386 2387=head1 NONFREQUENTLY ASKED QUESTIONS 2388 2389=over 4 2390 2391=item I C<undef> the AnyEvent::Handle reference inside my callback and 2392still get further invocations! 2393 2394That's because AnyEvent::Handle keeps a reference to itself when handling 2395read or write callbacks. 2396 2397It is only safe to "forget" the reference inside EOF or error callbacks, 2398from within all other callbacks, you need to explicitly call the C<< 2399->destroy >> method. 2400 2401=item Why is my C<on_eof> callback never called? 2402 2403Probably because your C<on_error> callback is being called instead: When 2404you have outstanding requests in your read queue, then an EOF is 2405considered an error as you clearly expected some data. 2406 2407To avoid this, make sure you have an empty read queue whenever your handle 2408is supposed to be "idle" (i.e. connection closes are O.K.). You can set 2409an C<on_read> handler that simply pushes the first read requests in the 2410queue. 2411 2412See also the next question, which explains this in a bit more detail. 2413 2414=item How can I serve requests in a loop? 2415 2416Most protocols consist of some setup phase (authentication for example) 2417followed by a request handling phase, where the server waits for requests 2418and handles them, in a loop. 2419 2420There are two important variants: The first (traditional, better) variant 2421handles requests until the server gets some QUIT command, causing it to 2422close the connection first (highly desirable for a busy TCP server). A 2423client dropping the connection is an error, which means this variant can 2424detect an unexpected detection close. 2425 2426To handle this case, always make sure you have a non-empty read queue, by 2427pushing the "read request start" handler on it: 2428 2429 # we assume a request starts with a single line 2430 my @start_request; @start_request = (line => sub { 2431 my ($hdl, $line) = @_; 2432 2433 ... handle request 2434 2435 # push next request read, possibly from a nested callback 2436 $hdl->push_read (@start_request); 2437 }); 2438 2439 # auth done, now go into request handling loop 2440 # now push the first @start_request 2441 $hdl->push_read (@start_request); 2442 2443By always having an outstanding C<push_read>, the handle always expects 2444some data and raises the C<EPIPE> error when the connction is dropped 2445unexpectedly. 2446 2447The second variant is a protocol where the client can drop the connection 2448at any time. For TCP, this means that the server machine may run out of 2449sockets easier, and in general, it means you cannot distinguish a protocl 2450failure/client crash from a normal connection close. Nevertheless, these 2451kinds of protocols are common (and sometimes even the best solution to the 2452problem). 2453 2454Having an outstanding read request at all times is possible if you ignore 2455C<EPIPE> errors, but this doesn't help with when the client drops the 2456connection during a request, which would still be an error. 2457 2458A better solution is to push the initial request read in an C<on_read> 2459callback. This avoids an error, as when the server doesn't expect data 2460(i.e. is idly waiting for the next request, an EOF will not raise an 2461error, but simply result in an C<on_eof> callback. It is also a bit slower 2462and simpler: 2463 2464 # auth done, now go into request handling loop 2465 $hdl->on_read (sub { 2466 my ($hdl) = @_; 2467 2468 # called each time we receive data but the read queue is empty 2469 # simply start read the request 2470 2471 $hdl->push_read (line => sub { 2472 my ($hdl, $line) = @_; 2473 2474 ... handle request 2475 2476 # do nothing special when the request has been handled, just 2477 # let the request queue go empty. 2478 }); 2479 }); 2480 2481=item I get different callback invocations in TLS mode/Why can't I pause 2482reading? 2483 2484Unlike, say, TCP, TLS connections do not consist of two independent 2485communication channels, one for each direction. Or put differently, the 2486read and write directions are not independent of each other: you cannot 2487write data unless you are also prepared to read, and vice versa. 2488 2489This means that, in TLS mode, you might get C<on_error> or C<on_eof> 2490callback invocations when you are not expecting any read data - the reason 2491is that AnyEvent::Handle always reads in TLS mode. 2492 2493During the connection, you have to make sure that you always have a 2494non-empty read-queue, or an C<on_read> watcher. At the end of the 2495connection (or when you no longer want to use it) you can call the 2496C<destroy> method. 2497 2498=item How do I read data until the other side closes the connection? 2499 2500If you just want to read your data into a perl scalar, the easiest way 2501to achieve this is by setting an C<on_read> callback that does nothing, 2502clearing the C<on_eof> callback and in the C<on_error> callback, the data 2503will be in C<$_[0]{rbuf}>: 2504 2505 $handle->on_read (sub { }); 2506 $handle->on_eof (undef); 2507 $handle->on_error (sub { 2508 my $data = delete $_[0]{rbuf}; 2509 }); 2510 2511Note that this example removes the C<rbuf> member from the handle object, 2512which is not normally allowed by the API. It is expressly permitted in 2513this case only, as the handle object needs to be destroyed afterwards. 2514 2515The reason to use C<on_error> is that TCP connections, due to latencies 2516and packets loss, might get closed quite violently with an error, when in 2517fact all data has been received. 2518 2519It is usually better to use acknowledgements when transferring data, 2520to make sure the other side hasn't just died and you got the data 2521intact. This is also one reason why so many internet protocols have an 2522explicit QUIT command. 2523 2524=item I don't want to destroy the handle too early - how do I wait until 2525all data has been written? 2526 2527After writing your last bits of data, set the C<on_drain> callback 2528and destroy the handle in there - with the default setting of 2529C<low_water_mark> this will be called precisely when all data has been 2530written to the socket: 2531 2532 $handle->push_write (...); 2533 $handle->on_drain (sub { 2534 AE::log debug => "All data submitted to the kernel."; 2535 undef $handle; 2536 }); 2537 2538If you just want to queue some data and then signal EOF to the other side, 2539consider using C<< ->push_shutdown >> instead. 2540 2541=item I want to contact a TLS/SSL server, I don't care about security. 2542 2543If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS, 2544connect to it and then create the AnyEvent::Handle with the C<tls> 2545parameter: 2546 2547 tcp_connect $host, $port, sub { 2548 my ($fh) = @_; 2549 2550 my $handle = new AnyEvent::Handle 2551 fh => $fh, 2552 tls => "connect", 2553 on_error => sub { ... }; 2554 2555 $handle->push_write (...); 2556 }; 2557 2558=item I want to contact a TLS/SSL server, I do care about security. 2559 2560Then you should additionally enable certificate verification, including 2561peername verification, if the protocol you use supports it (see 2562L<AnyEvent::TLS>, C<verify_peername>). 2563 2564E.g. for HTTPS: 2565 2566 tcp_connect $host, $port, sub { 2567 my ($fh) = @_; 2568 2569 my $handle = new AnyEvent::Handle 2570 fh => $fh, 2571 peername => $host, 2572 tls => "connect", 2573 tls_ctx => { verify => 1, verify_peername => "https" }, 2574 ... 2575 2576Note that you must specify the hostname you connected to (or whatever 2577"peername" the protocol needs) as the C<peername> argument, otherwise no 2578peername verification will be done. 2579 2580The above will use the system-dependent default set of trusted CA 2581certificates. If you want to check against a specific CA, add the 2582C<ca_file> (or C<ca_cert>) arguments to C<tls_ctx>: 2583 2584 tls_ctx => { 2585 verify => 1, 2586 verify_peername => "https", 2587 ca_file => "my-ca-cert.pem", 2588 }, 2589 2590=item I want to create a TLS/SSL server, how do I do that? 2591 2592Well, you first need to get a server certificate and key. You have 2593three options: a) ask a CA (buy one, use cacert.org etc.) b) create a 2594self-signed certificate (cheap. check the search engine of your choice, 2595there are many tutorials on the net) or c) make your own CA (tinyca2 is a 2596nice program for that purpose). 2597 2598Then create a file with your private key (in PEM format, see 2599L<AnyEvent::TLS>), followed by the certificate (also in PEM format). The 2600file should then look like this: 2601 2602 -----BEGIN RSA PRIVATE KEY----- 2603 ...header data 2604 ... lots of base64'y-stuff 2605 -----END RSA PRIVATE KEY----- 2606 2607 -----BEGIN CERTIFICATE----- 2608 ... lots of base64'y-stuff 2609 -----END CERTIFICATE----- 2610 2611The important bits are the "PRIVATE KEY" and "CERTIFICATE" parts. Then 2612specify this file as C<cert_file>: 2613 2614 tcp_server undef, $port, sub { 2615 my ($fh) = @_; 2616 2617 my $handle = new AnyEvent::Handle 2618 fh => $fh, 2619 tls => "accept", 2620 tls_ctx => { cert_file => "my-server-keycert.pem" }, 2621 ... 2622 2623When you have intermediate CA certificates that your clients might not 2624know about, just append them to the C<cert_file>. 2625 2626=back 2627 2628=head1 SUBCLASSING AnyEvent::Handle 2629 2630In many cases, you might want to subclass AnyEvent::Handle. 2631 2632To make this easier, a given version of AnyEvent::Handle uses these 2633conventions: 2634 2635=over 4 2636 2637=item * all constructor arguments become object members. 2638 2639At least initially, when you pass a C<tls>-argument to the constructor it 2640will end up in C<< $handle->{tls} >>. Those members might be changed or 2641mutated later on (for example C<tls> will hold the TLS connection object). 2642 2643=item * other object member names are prefixed with an C<_>. 2644 2645All object members not explicitly documented (internal use) are prefixed 2646with an underscore character, so the remaining non-C<_>-namespace is free 2647for use for subclasses. 2648 2649=item * all members not documented here and not prefixed with an underscore 2650are free to use in subclasses. 2651 2652Of course, new versions of AnyEvent::Handle may introduce more "public" 2653member variables, but that's just life. At least it is documented. 2654 2655=back 2656 2657=head1 AUTHOR 2658 2659Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 2660 2661=cut 2662 26631 2664 2665