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.14 by root, Sat May 17 19:05:51 2008 UTC vs.
Revision 1.29 by root, Sat May 24 23:10:18 2008 UTC

… …
10use Fcntl (); 10use Fcntl ();
11use Errno qw/EAGAIN EINTR/; 11use Errno qw/EAGAIN EINTR/;
12 12
13=head1 NAME 13=head1 NAME
14 14
15AnyEvent::Handle - non-blocking I/O on filehandles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17This module is experimental.
18 18
19=cut
20
19our $VERSION = '0.02'; 21our $VERSION = '0.04';
20 22
21=head1 SYNOPSIS 23=head1 SYNOPSIS
22 24
23 use AnyEvent; 25 use AnyEvent;
24 use AnyEvent::Handle; 26 use AnyEvent::Handle;
… …
70The filehandle this L<AnyEvent::Handle> object will operate on. 72The filehandle this L<AnyEvent::Handle> object will operate on.
71 73
72NOTE: The filehandle will be set to non-blocking (using 74NOTE: The filehandle will be set to non-blocking (using
73AnyEvent::Util::fh_nonblocking). 75AnyEvent::Util::fh_nonblocking).
74 76
75=item on_eof => $cb->($self) [MANDATORY] 77=item on_eof => $cb->($self)
76 78
77Set the callback to be called on EOF. 79Set the callback to be called on EOF.
78 80
81While not mandatory, it is highly recommended to set an eof callback,
82otherwise you might end up with a closed socket while you are still
83waiting for data.
84
79=item on_error => $cb->($self) 85=item on_error => $cb->($self)
80 86
81This is the fatal error callback, that is called when, well, a fatal error 87This is the fatal error callback, that is called when, well, a fatal error
82ocurs, such as not being able to resolve the hostname, failure to connect 88occurs, such as not being able to resolve the hostname, failure to connect
83or a read error. 89or a read error.
84 90
85The object will not be in a usable state when this callback has been 91The object will not be in a usable state when this callback has been
86called. 92called.
87 93
88On callback entrance, the value of C<$!> contains the operating system 94On callback entrance, the value of C<$!> contains the operating system
89error (or C<ENOSPC> or C<EPIPE>). 95error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).
90 96
91While not mandatory, it is I<highly> recommended to set this callback, as 97While not mandatory, it is I<highly> recommended to set this callback, as
92you will not be notified of errors otherwise. The default simply calls 98you will not be notified of errors otherwise. The default simply calls
93die. 99die.
94 100
… …
96 102
97This sets the default read callback, which is called when data arrives 103This sets the default read callback, which is called when data arrives
98and no read request is in the queue. 104and no read request is in the queue.
99 105
100To access (and remove data from) the read buffer, use the C<< ->rbuf >> 106To access (and remove data from) the read buffer, use the C<< ->rbuf >>
101method or acces sthe C<$self->{rbuf}> member directly. 107method or access the C<$self->{rbuf}> member directly.
102 108
103When an EOF condition is detected then AnyEvent::Handle will first try to 109When an EOF condition is detected then AnyEvent::Handle will first try to
104feed all the remaining data to the queued callbacks and C<on_read> before 110feed all the remaining data to the queued callbacks and C<on_read> before
105calling the C<on_eof> callback. If no progress can be made, then a fatal 111calling the C<on_eof> callback. If no progress can be made, then a fatal
106error will be raised (with C<$!> set to C<EPIPE>). 112error will be raised (with C<$!> set to C<EPIPE>).
… …
133 139
134Sets the amount of bytes (default: C<0>) that make up an "empty" write 140Sets the amount of bytes (default: C<0>) that make up an "empty" write
135buffer: If the write reaches this size or gets even samller it is 141buffer: If the write reaches this size or gets even samller it is
136considered empty. 142considered empty.
137 143
144=item tls => "accept" | "connect" | Net::SSLeay::SSL object
145
146When this parameter is given, it enables TLS (SSL) mode, that means it
147will start making tls handshake and will transparently encrypt/decrypt
148data.
149
150TLS mode requires Net::SSLeay to be installed (it will be loaded
151automatically when you try to create a TLS handle).
152
153For the TLS server side, use C<accept>, and for the TLS client side of a
154connection, use C<connect> mode.
155
156You can also provide your own TLS connection object, but you have
157to make sure that you call either C<Net::SSLeay::set_connect_state>
158or C<Net::SSLeay::set_accept_state> on it before you pass it to
159AnyEvent::Handle.
160
161See the C<starttls> method if you need to start TLs negotiation later.
162
163=item tls_ctx => $ssl_ctx
164
165Use the given Net::SSLeay::CTX object to create the new TLS connection
166(unless a connection object was specified directly). If this parameter is
167missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
168
138=back 169=back
139 170
140=cut 171=cut
172
173our (%RH, %WH);
174
175sub register_read_type($$) {
176 $RH{$_[0]} = $_[1];
177}
178
179sub register_write_type($$) {
180 $WH{$_[0]} = $_[1];
181}
141 182
142sub new { 183sub new {
143 my $class = shift; 184 my $class = shift;
144 185
145 my $self = bless { @_ }, $class; 186 my $self = bless { @_ }, $class;
146 187
147 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 188 $self->{fh} or Carp::croak "mandatory argument fh is missing";
148 189
149 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 190 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
150 191
151 $self->on_eof ((delete $self->{on_eof} ) or Carp::croak "mandatory argument on_eof is missing"); 192 if ($self->{tls}) {
193 require Net::SSLeay;
194 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
195 }
152 196
197 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
153 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 198 $self->on_error (delete $self->{on_error}) if $self->{on_error};
154 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 199 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
155 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 200 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
156 201
157 $self->start_read; 202 $self->start_read;
… …
176 } 221 }
177 222
178 if ($self->{on_error}) { 223 if ($self->{on_error}) {
179 $self->{on_error}($self); 224 $self->{on_error}($self);
180 } else { 225 } else {
181 die "AnyEvent::Handle uncaught fatal error: $!"; 226 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
182 } 227 }
183} 228}
184 229
185=item $fh = $handle->fh 230=item $fh = $handle->fh
186 231
187This method returns the filehandle of the L<AnyEvent::Handle> object. 232This method returns the file handle of the L<AnyEvent::Handle> object.
188 233
189=cut 234=cut
190 235
191sub fh { $_[0]->{fh} } 236sub fh { $_[0]->{fh} }
192 237
… …
220for reading. 265for reading.
221 266
222The write queue is very simple: you can add data to its end, and 267The write queue is very simple: you can add data to its end, and
223AnyEvent::Handle will automatically try to get rid of it for you. 268AnyEvent::Handle will automatically try to get rid of it for you.
224 269
225When data could be writtena nd the write buffer is shorter then the low 270When data could be written and the write buffer is shorter then the low
226water mark, the C<on_drain> callback will be invoked. 271water mark, the C<on_drain> callback will be invoked.
227 272
228=over 4 273=over 4
229 274
230=item $handle->on_drain ($cb) 275=item $handle->on_drain ($cb)
… …
249want (only limited by the available memory), as C<AnyEvent::Handle> 294want (only limited by the available memory), as C<AnyEvent::Handle>
250buffers it independently of the kernel. 295buffers it independently of the kernel.
251 296
252=cut 297=cut
253 298
254sub push_write { 299sub _drain_wbuf {
255 my ($self, $data) = @_; 300 my ($self) = @_;
256 301
257 $self->{wbuf} .= $data; 302 if (!$self->{ww} && length $self->{wbuf}) {
258
259 unless ($self->{ww}) {
260 Scalar::Util::weaken $self; 303 Scalar::Util::weaken $self;
261 my $cb = sub { 304 my $cb = sub {
262 my $len = syswrite $self->{fh}, $self->{wbuf}; 305 my $len = syswrite $self->{fh}, $self->{wbuf};
263 306
264 if ($len > 0) { 307 if ($len >= 0) {
265 substr $self->{wbuf}, 0, $len, ""; 308 substr $self->{wbuf}, 0, $len, "";
266
267 309
268 $self->{on_drain}($self) 310 $self->{on_drain}($self)
269 if $self->{low_water_mark} >= length $self->{wbuf} 311 if $self->{low_water_mark} >= length $self->{wbuf}
270 && $self->{on_drain}; 312 && $self->{on_drain};
271 313
… …
278 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 320 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
279 321
280 $cb->($self); 322 $cb->($self);
281 }; 323 };
282} 324}
325
326sub push_write {
327 my $self = shift;
328
329 if (@_ > 1) {
330 my $type = shift;
331
332 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
333 ->($self, @_);
334 }
335
336 if ($self->{filter_w}) {
337 $self->{filter_w}->($self, \$_[0]);
338 } else {
339 $self->{wbuf} .= $_[0];
340 $self->_drain_wbuf;
341 }
342}
343
344=item $handle->push_write (type => @args)
345
346=item $handle->unshift_write (type => @args)
347
348Instead of formatting your data yourself, you can also let this module do
349the job by specifying a type and type-specific arguments.
350
351Predefined types are:
352
353=over 4
354
355=item netstring => $string
356
357Formats the given value as netstring
358(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
359
360=cut
361
362register_write_type netstring => sub {
363 my ($self, $string) = @_;
364
365 sprintf "%d:%s,", (length $string), $string
366};
367
368=back
369
370=cut
371
372
283 373
284############################################################################# 374#############################################################################
285 375
286=back 376=back
287 377
… …
362=cut 452=cut
363 453
364sub _drain_rbuf { 454sub _drain_rbuf {
365 my ($self) = @_; 455 my ($self) = @_;
366 456
457 if (
458 defined $self->{rbuf_max}
459 && $self->{rbuf_max} < length $self->{rbuf}
460 ) {
461 $! = &Errno::ENOSPC; return $self->error;
462 }
463
367 return if $self->{in_drain}; 464 return if $self->{in_drain};
368 local $self->{in_drain} = 1; 465 local $self->{in_drain} = 1;
369 466
370 while (my $len = length $self->{rbuf}) { 467 while (my $len = length $self->{rbuf}) {
371 no strict 'refs'; 468 no strict 'refs';
372 if (my $cb = shift @{ $self->{queue} }) { 469 if (my $cb = shift @{ $self->{queue} }) {
373 if (!$cb->($self)) { 470 unless ($cb->($self)) {
374 if ($self->{eof}) { 471 if ($self->{eof}) {
375 # no progress can be made (not enough data and no data forthcoming) 472 # no progress can be made (not enough data and no data forthcoming)
376 $! = &Errno::EPIPE; return $self->error; 473 $! = &Errno::EPIPE; return $self->error;
377 } 474 }
378 475
… …
398 } 495 }
399 } 496 }
400 497
401 if ($self->{eof}) { 498 if ($self->{eof}) {
402 $self->_shutdown; 499 $self->_shutdown;
403 $self->{on_eof}($self); 500 $self->{on_eof}($self)
501 if $self->{on_eof};
404 } 502 }
405} 503}
406 504
407=item $handle->on_read ($cb) 505=item $handle->on_read ($cb)
408 506
… …
442Append the given callback to the end of the queue (C<push_read>) or 540Append the given callback to the end of the queue (C<push_read>) or
443prepend it (C<unshift_read>). 541prepend it (C<unshift_read>).
444 542
445The callback is called each time some additional read data arrives. 543The callback is called each time some additional read data arrives.
446 544
447It must check wether enough data is in the read buffer already. 545It must check whether enough data is in the read buffer already.
448 546
449If not enough data is available, it must return the empty list or a false 547If not enough data is available, it must return the empty list or a false
450value, in which case it will be called repeatedly until enough data is 548value, in which case it will be called repeatedly until enough data is
451available (or an error condition is detected). 549available (or an error condition is detected).
452 550
… …
455true, it will be removed from the queue. 553true, it will be removed from the queue.
456 554
457=cut 555=cut
458 556
459sub push_read { 557sub push_read {
460 my ($self, $cb) = @_; 558 my $self = shift;
559 my $cb = pop;
560
561 if (@_) {
562 my $type = shift;
563
564 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
565 ->($self, $cb, @_);
566 }
461 567
462 push @{ $self->{queue} }, $cb; 568 push @{ $self->{queue} }, $cb;
463 $self->_drain_rbuf; 569 $self->_drain_rbuf;
464} 570}
465 571
466sub unshift_read { 572sub unshift_read {
467 my ($self, $cb) = @_; 573 my $self = shift;
574 my $cb = pop;
468 575
576 if (@_) {
577 my $type = shift;
578
579 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
580 ->($self, $cb, @_);
581 }
582
583
469 push @{ $self->{queue} }, $cb; 584 unshift @{ $self->{queue} }, $cb;
470 $self->_drain_rbuf; 585 $self->_drain_rbuf;
471} 586}
472 587
473=item $handle->push_read_chunk ($len, $cb->($self, $data)) 588=item $handle->push_read (type => @args, $cb)
474 589
475=item $handle->unshift_read_chunk ($len, $cb->($self, $data)) 590=item $handle->unshift_read (type => @args, $cb)
476 591
477Append the given callback to the end of the queue (C<push_read_chunk>) or 592Instead of providing a callback that parses the data itself you can chose
478prepend it (C<unshift_read_chunk>). 593between a number of predefined parsing formats, for chunks of data, lines
594etc.
479 595
480The callback will be called only once C<$len> bytes have been read, and 596The types currently supported are:
481these C<$len> bytes will be passed to the callback.
482 597
483=cut 598=over 4
484 599
485sub _read_chunk($$) { 600=item chunk => $octets, $cb->($self, $data)
601
602Invoke the callback only once C<$octets> bytes have been read. Pass the
603data read to the callback. The callback will never be called with less
604data.
605
606Example: read 2 bytes.
607
608 $handle->push_read (chunk => 2, sub {
609 warn "yay ", unpack "H*", $_[1];
610 });
611
612=cut
613
614register_read_type chunk => sub {
486 my ($self, $len, $cb) = @_; 615 my ($self, $cb, $len) = @_;
487 616
488 sub { 617 sub {
489 $len <= length $_[0]{rbuf} or return; 618 $len <= length $_[0]{rbuf} or return;
490 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 619 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
491 1 620 1
492 } 621 }
493} 622};
494 623
624# compatibility with older API
495sub push_read_chunk { 625sub push_read_chunk {
496 $_[0]->push_read (&_read_chunk); 626 $_[0]->push_read (chunk => $_[1], $_[2]);
497} 627}
498
499 628
500sub unshift_read_chunk { 629sub unshift_read_chunk {
501 $_[0]->unshift_read (&_read_chunk); 630 $_[0]->unshift_read (chunk => $_[1], $_[2]);
502} 631}
503 632
504=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol)) 633=item line => [$eol, ]$cb->($self, $line, $eol)
505
506=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol))
507
508Append the given callback to the end of the queue (C<push_read_line>) or
509prepend it (C<unshift_read_line>).
510 634
511The callback will be called only once a full line (including the end of 635The callback will be called only once a full line (including the end of
512line marker, C<$eol>) has been read. This line (excluding the end of line 636line marker, C<$eol>) has been read. This line (excluding the end of line
513marker) will be passed to the callback as second argument (C<$line>), and 637marker) will be passed to the callback as second argument (C<$line>), and
514the end of line marker as the third argument (C<$eol>). 638the end of line marker as the third argument (C<$eol>).
… …
525Partial lines at the end of the stream will never be returned, as they are 649Partial lines at the end of the stream will never be returned, as they are
526not marked by the end of line marker. 650not marked by the end of line marker.
527 651
528=cut 652=cut
529 653
530sub _read_line($$) { 654register_read_type line => sub {
531 my $self = shift; 655 my ($self, $cb, $eol) = @_;
532 my $cb = pop;
533 my $eol = @_ ? shift : qr|(\015?\012)|;
534 my $pos;
535 656
657 $eol = qr|(\015?\012)| if @_ < 3;
536 $eol = quotemeta $eol unless ref $eol; 658 $eol = quotemeta $eol unless ref $eol;
537 $eol = qr|^(.*?)($eol)|s; 659 $eol = qr|^(.*?)($eol)|s;
538 660
539 sub { 661 sub {
540 $_[0]{rbuf} =~ s/$eol// or return; 662 $_[0]{rbuf} =~ s/$eol// or return;
541 663
542 $cb->($_[0], $1, $2); 664 $cb->($_[0], $1, $2);
543 1 665 1
544 } 666 }
545} 667};
546 668
669# compatibility with older API
547sub push_read_line { 670sub push_read_line {
548 $_[0]->push_read (&_read_line); 671 my $self = shift;
672 $self->push_read (line => @_);
549} 673}
550 674
551sub unshift_read_line { 675sub unshift_read_line {
552 $_[0]->unshift_read (&_read_line); 676 my $self = shift;
677 $self->unshift_read (line => @_);
553} 678}
679
680=item netstring => $cb->($string)
681
682A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
683
684Throws an error with C<$!> set to EBADMSG on format violations.
685
686=cut
687
688register_read_type netstring => sub {
689 my ($self, $cb) = @_;
690
691 sub {
692 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
693 if ($_[0]{rbuf} =~ /[^0-9]/) {
694 $! = &Errno::EBADMSG;
695 $self->error;
696 }
697 return;
698 }
699
700 my $len = $1;
701
702 $self->unshift_read (chunk => $len, sub {
703 my $string = $_[1];
704 $_[0]->unshift_read (chunk => 1, sub {
705 if ($_[1] eq ",") {
706 $cb->($_[0], $string);
707 } else {
708 $! = &Errno::EBADMSG;
709 $self->error;
710 }
711 });
712 });
713
714 1
715 }
716};
717
718=back
554 719
555=item $handle->stop_read 720=item $handle->stop_read
556 721
557=item $handle->start_read 722=item $handle->start_read
558 723
559In rare cases you actually do not want to read anything form the 724In rare cases you actually do not want to read anything from the
560socket. In this case you can call C<stop_read>. Neither C<on_read> no 725socket. In this case you can call C<stop_read>. Neither C<on_read> no
561any queued callbacks will be executed then. To start readign again, call 726any queued callbacks will be executed then. To start reading again, call
562C<start_read>. 727C<start_read>.
563 728
564=cut 729=cut
565 730
566sub stop_read { 731sub stop_read {
… …
574 739
575 unless ($self->{rw} || $self->{eof}) { 740 unless ($self->{rw} || $self->{eof}) {
576 Scalar::Util::weaken $self; 741 Scalar::Util::weaken $self;
577 742
578 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 743 $self->{rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
744 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
579 my $len = sysread $self->{fh}, $self->{rbuf}, $self->{read_size} || 8192, length $self->{rbuf}; 745 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
580 746
581 if ($len > 0) { 747 if ($len > 0) {
582 if (defined $self->{rbuf_max}) { 748 $self->{filter_r}
583 if ($self->{rbuf_max} < length $self->{rbuf}) { 749 ? $self->{filter_r}->($self, $rbuf)
584 $! = &Errno::ENOSPC; return $self->error; 750 : $self->_drain_rbuf;
585 }
586 }
587 751
588 } elsif (defined $len) { 752 } elsif (defined $len) {
753 delete $self->{rw};
589 $self->{eof} = 1; 754 $self->{eof} = 1;
590 delete $self->{rw}; 755 $self->_drain_rbuf;
591 756
592 } elsif ($! != EAGAIN && $! != EINTR) { 757 } elsif ($! != EAGAIN && $! != EINTR) {
593 return $self->error; 758 return $self->error;
594 } 759 }
595
596 $self->_drain_rbuf;
597 }); 760 });
598 } 761 }
599} 762}
600 763
764sub _dotls {
765 my ($self) = @_;
766
767 if (length $self->{tls_wbuf}) {
768 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {
769 substr $self->{tls_wbuf}, 0, $len, "";
770 }
771 }
772
773 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
774 $self->{wbuf} .= $buf;
775 $self->_drain_wbuf;
776 }
777
778 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
779 $self->{rbuf} .= $buf;
780 $self->_drain_rbuf;
781 }
782
783 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
784
785 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
786 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
787 $self->error;
788 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
789 $! = &Errno::EIO;
790 $self->error;
791 }
792
793 # all others are fine for our purposes
794 }
795}
796
797=item $handle->starttls ($tls[, $tls_ctx])
798
799Instead of starting TLS negotiation immediately when the AnyEvent::Handle
800object is created, you can also do that at a later time by calling
801C<starttls>.
802
803The first argument is the same as the C<tls> constructor argument (either
804C<"connect">, C<"accept"> or an existing Net::SSLeay object).
805
806The second argument is the optional C<Net::SSLeay::CTX> object that is
807used when AnyEvent::Handle has to create its own TLS connection object.
808
809=cut
810
811# TODO: maybe document...
812sub starttls {
813 my ($self, $ssl, $ctx) = @_;
814
815 $self->stoptls;
816
817 if ($ssl eq "accept") {
818 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
819 Net::SSLeay::set_accept_state ($ssl);
820 } elsif ($ssl eq "connect") {
821 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
822 Net::SSLeay::set_connect_state ($ssl);
823 }
824
825 $self->{tls} = $ssl;
826
827 # basically, this is deep magic (because SSL_read should have the same issues)
828 # but the openssl maintainers basically said: "trust us, it just works".
829 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
830 # and mismaintained ssleay-module doesn't even offer them).
831 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
832 Net::SSLeay::CTX_set_mode ($self->{tls},
833 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
834 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
835
836 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
837 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
838
839 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
840
841 $self->{filter_w} = sub {
842 $_[0]{tls_wbuf} .= ${$_[1]};
843 &_dotls;
844 };
845 $self->{filter_r} = sub {
846 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
847 &_dotls;
848 };
849}
850
851=item $handle->stoptls
852
853Destroys the SSL connection, if any. Partial read or write data will be
854lost.
855
856=cut
857
858sub stoptls {
859 my ($self) = @_;
860
861 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
862 delete $self->{tls_rbio};
863 delete $self->{tls_wbio};
864 delete $self->{tls_wbuf};
865 delete $self->{filter_r};
866 delete $self->{filter_w};
867}
868
869sub DESTROY {
870 my $self = shift;
871
872 $self->stoptls;
873}
874
875=item AnyEvent::Handle::TLS_CTX
876
877This function creates and returns the Net::SSLeay::CTX object used by
878default for TLS mode.
879
880The context is created like this:
881
882 Net::SSLeay::load_error_strings;
883 Net::SSLeay::SSLeay_add_ssl_algorithms;
884 Net::SSLeay::randomize;
885
886 my $CTX = Net::SSLeay::CTX_new;
887
888 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
889
890=cut
891
892our $TLS_CTX;
893
894sub TLS_CTX() {
895 $TLS_CTX || do {
896 require Net::SSLeay;
897
898 Net::SSLeay::load_error_strings ();
899 Net::SSLeay::SSLeay_add_ssl_algorithms ();
900 Net::SSLeay::randomize ();
901
902 $TLS_CTX = Net::SSLeay::CTX_new ();
903
904 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
905
906 $TLS_CTX
907 }
908}
909
601=back 910=back
602 911
603=head1 AUTHOR 912=head1 AUTHOR
604 913
605Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 914Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.

Diff Legend

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