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.15 by root, Sat May 17 21:34:15 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
17This module is experimental. 17This module is experimental.
18 18
19=cut 19=cut
20 20
… …
72The filehandle this L<AnyEvent::Handle> object will operate on. 72The filehandle this L<AnyEvent::Handle> object will operate on.
73 73
74NOTE: The filehandle will be set to non-blocking (using 74NOTE: The filehandle will be set to non-blocking (using
75AnyEvent::Util::fh_nonblocking). 75AnyEvent::Util::fh_nonblocking).
76 76
77=item on_eof => $cb->($self) [MANDATORY] 77=item on_eof => $cb->($self)
78 78
79Set the callback to be called on EOF. 79Set the callback to be called on EOF.
80 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
81=item on_error => $cb->($self) 85=item on_error => $cb->($self)
82 86
83This 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
84ocurs, 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
85or a read error. 89or a read error.
86 90
87The 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
88called. 92called.
89 93
90On callback entrance, the value of C<$!> contains the operating system 94On callback entrance, the value of C<$!> contains the operating system
91error (or C<ENOSPC> or C<EPIPE>). 95error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).
92 96
93While 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
94you will not be notified of errors otherwise. The default simply calls 98you will not be notified of errors otherwise. The default simply calls
95die. 99die.
96 100
… …
98 102
99This sets the default read callback, which is called when data arrives 103This sets the default read callback, which is called when data arrives
100and no read request is in the queue. 104and no read request is in the queue.
101 105
102To 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 >>
103method or acces sthe C<$self->{rbuf}> member directly. 107method or access the C<$self->{rbuf}> member directly.
104 108
105When 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
106feed 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
107calling 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
108error will be raised (with C<$!> set to C<EPIPE>). 112error will be raised (with C<$!> set to C<EPIPE>).
… …
135 139
136Sets 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
137buffer: 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
138considered empty. 142considered empty.
139 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
140=back 169=back
141 170
142=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}
143 182
144sub new { 183sub new {
145 my $class = shift; 184 my $class = shift;
146 185
147 my $self = bless { @_ }, $class; 186 my $self = bless { @_ }, $class;
148 187
149 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 188 $self->{fh} or Carp::croak "mandatory argument fh is missing";
150 189
151 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 190 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
152 191
153 $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 }
154 196
197 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
155 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 198 $self->on_error (delete $self->{on_error}) if $self->{on_error};
156 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 199 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
157 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 200 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
158 201
159 $self->start_read; 202 $self->start_read;
… …
178 } 221 }
179 222
180 if ($self->{on_error}) { 223 if ($self->{on_error}) {
181 $self->{on_error}($self); 224 $self->{on_error}($self);
182 } else { 225 } else {
183 die "AnyEvent::Handle uncaught fatal error: $!"; 226 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
184 } 227 }
185} 228}
186 229
187=item $fh = $handle->fh 230=item $fh = $handle->fh
188 231
189This method returns the filehandle of the L<AnyEvent::Handle> object. 232This method returns the file handle of the L<AnyEvent::Handle> object.
190 233
191=cut 234=cut
192 235
193sub fh { $_[0]->{fh} } 236sub fh { $_[0]->{fh} }
194 237
… …
222for reading. 265for reading.
223 266
224The 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
225AnyEvent::Handle will automatically try to get rid of it for you. 268AnyEvent::Handle will automatically try to get rid of it for you.
226 269
227When 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
228water mark, the C<on_drain> callback will be invoked. 271water mark, the C<on_drain> callback will be invoked.
229 272
230=over 4 273=over 4
231 274
232=item $handle->on_drain ($cb) 275=item $handle->on_drain ($cb)
… …
251want (only limited by the available memory), as C<AnyEvent::Handle> 294want (only limited by the available memory), as C<AnyEvent::Handle>
252buffers it independently of the kernel. 295buffers it independently of the kernel.
253 296
254=cut 297=cut
255 298
256sub push_write { 299sub _drain_wbuf {
257 my ($self, $data) = @_; 300 my ($self) = @_;
258 301
259 $self->{wbuf} .= $data; 302 if (!$self->{ww} && length $self->{wbuf}) {
260
261 unless ($self->{ww}) {
262 Scalar::Util::weaken $self; 303 Scalar::Util::weaken $self;
263 my $cb = sub { 304 my $cb = sub {
264 my $len = syswrite $self->{fh}, $self->{wbuf}; 305 my $len = syswrite $self->{fh}, $self->{wbuf};
265 306
266 if ($len > 0) { 307 if ($len >= 0) {
267 substr $self->{wbuf}, 0, $len, ""; 308 substr $self->{wbuf}, 0, $len, "";
268
269 309
270 $self->{on_drain}($self) 310 $self->{on_drain}($self)
271 if $self->{low_water_mark} >= length $self->{wbuf} 311 if $self->{low_water_mark} >= length $self->{wbuf}
272 && $self->{on_drain}; 312 && $self->{on_drain};
273 313
… …
280 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb); 320 $self->{ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb);
281 321
282 $cb->($self); 322 $cb->($self);
283 }; 323 };
284} 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
285 373
286############################################################################# 374#############################################################################
287 375
288=back 376=back
289 377
… …
364=cut 452=cut
365 453
366sub _drain_rbuf { 454sub _drain_rbuf {
367 my ($self) = @_; 455 my ($self) = @_;
368 456
457 if (
458 defined $self->{rbuf_max}
459 && $self->{rbuf_max} < length $self->{rbuf}
460 ) {
461 $! = &Errno::ENOSPC; return $self->error;
462 }
463
369 return if $self->{in_drain}; 464 return if $self->{in_drain};
370 local $self->{in_drain} = 1; 465 local $self->{in_drain} = 1;
371 466
372 while (my $len = length $self->{rbuf}) { 467 while (my $len = length $self->{rbuf}) {
373 no strict 'refs'; 468 no strict 'refs';
374 if (my $cb = shift @{ $self->{queue} }) { 469 if (my $cb = shift @{ $self->{queue} }) {
375 if (!$cb->($self)) { 470 unless ($cb->($self)) {
376 if ($self->{eof}) { 471 if ($self->{eof}) {
377 # 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)
378 $! = &Errno::EPIPE; return $self->error; 473 $! = &Errno::EPIPE; return $self->error;
379 } 474 }
380 475
… …
400 } 495 }
401 } 496 }
402 497
403 if ($self->{eof}) { 498 if ($self->{eof}) {
404 $self->_shutdown; 499 $self->_shutdown;
405 $self->{on_eof}($self); 500 $self->{on_eof}($self)
501 if $self->{on_eof};
406 } 502 }
407} 503}
408 504
409=item $handle->on_read ($cb) 505=item $handle->on_read ($cb)
410 506
… …
444Append 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
445prepend it (C<unshift_read>). 541prepend it (C<unshift_read>).
446 542
447The callback is called each time some additional read data arrives. 543The callback is called each time some additional read data arrives.
448 544
449It must check wether enough data is in the read buffer already. 545It must check whether enough data is in the read buffer already.
450 546
451If 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
452value, 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
453available (or an error condition is detected). 549available (or an error condition is detected).
454 550
… …
457true, it will be removed from the queue. 553true, it will be removed from the queue.
458 554
459=cut 555=cut
460 556
461sub push_read { 557sub push_read {
462 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 }
463 567
464 push @{ $self->{queue} }, $cb; 568 push @{ $self->{queue} }, $cb;
465 $self->_drain_rbuf; 569 $self->_drain_rbuf;
466} 570}
467 571
468sub unshift_read { 572sub unshift_read {
469 my ($self, $cb) = @_; 573 my $self = shift;
574 my $cb = pop;
470 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
471 push @{ $self->{queue} }, $cb; 584 unshift @{ $self->{queue} }, $cb;
472 $self->_drain_rbuf; 585 $self->_drain_rbuf;
473} 586}
474 587
475=item $handle->push_read_chunk ($len, $cb->($self, $data)) 588=item $handle->push_read (type => @args, $cb)
476 589
477=item $handle->unshift_read_chunk ($len, $cb->($self, $data)) 590=item $handle->unshift_read (type => @args, $cb)
478 591
479Append 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
480prepend it (C<unshift_read_chunk>). 593between a number of predefined parsing formats, for chunks of data, lines
594etc.
481 595
482The callback will be called only once C<$len> bytes have been read, and 596The types currently supported are:
483these C<$len> bytes will be passed to the callback.
484 597
485=cut 598=over 4
486 599
487sub _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 {
488 my ($self, $len, $cb) = @_; 615 my ($self, $cb, $len) = @_;
489 616
490 sub { 617 sub {
491 $len <= length $_[0]{rbuf} or return; 618 $len <= length $_[0]{rbuf} or return;
492 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 619 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
493 1 620 1
494 } 621 }
495} 622};
496 623
624# compatibility with older API
497sub push_read_chunk { 625sub push_read_chunk {
498 $_[0]->push_read (&_read_chunk); 626 $_[0]->push_read (chunk => $_[1], $_[2]);
499} 627}
500
501 628
502sub unshift_read_chunk { 629sub unshift_read_chunk {
503 $_[0]->unshift_read (&_read_chunk); 630 $_[0]->unshift_read (chunk => $_[1], $_[2]);
504} 631}
505 632
506=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol)) 633=item line => [$eol, ]$cb->($self, $line, $eol)
507
508=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol))
509
510Append the given callback to the end of the queue (C<push_read_line>) or
511prepend it (C<unshift_read_line>).
512 634
513The 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
514line 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
515marker) 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
516the end of line marker as the third argument (C<$eol>). 638the end of line marker as the third argument (C<$eol>).
… …
527Partial 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
528not marked by the end of line marker. 650not marked by the end of line marker.
529 651
530=cut 652=cut
531 653
532sub _read_line($$) { 654register_read_type line => sub {
533 my $self = shift; 655 my ($self, $cb, $eol) = @_;
534 my $cb = pop;
535 my $eol = @_ ? shift : qr|(\015?\012)|;
536 my $pos;
537 656
657 $eol = qr|(\015?\012)| if @_ < 3;
538 $eol = quotemeta $eol unless ref $eol; 658 $eol = quotemeta $eol unless ref $eol;
539 $eol = qr|^(.*?)($eol)|s; 659 $eol = qr|^(.*?)($eol)|s;
540 660
541 sub { 661 sub {
542 $_[0]{rbuf} =~ s/$eol// or return; 662 $_[0]{rbuf} =~ s/$eol// or return;
543 663
544 $cb->($_[0], $1, $2); 664 $cb->($_[0], $1, $2);
545 1 665 1
546 } 666 }
547} 667};
548 668
669# compatibility with older API
549sub push_read_line { 670sub push_read_line {
550 $_[0]->push_read (&_read_line); 671 my $self = shift;
672 $self->push_read (line => @_);
551} 673}
552 674
553sub unshift_read_line { 675sub unshift_read_line {
554 $_[0]->unshift_read (&_read_line); 676 my $self = shift;
677 $self->unshift_read (line => @_);
555} 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
556 719
557=item $handle->stop_read 720=item $handle->stop_read
558 721
559=item $handle->start_read 722=item $handle->start_read
560 723
561In 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
562socket. 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
563any queued callbacks will be executed then. To start readign again, call 726any queued callbacks will be executed then. To start reading again, call
564C<start_read>. 727C<start_read>.
565 728
566=cut 729=cut
567 730
568sub stop_read { 731sub stop_read {
… …
576 739
577 unless ($self->{rw} || $self->{eof}) { 740 unless ($self->{rw} || $self->{eof}) {
578 Scalar::Util::weaken $self; 741 Scalar::Util::weaken $self;
579 742
580 $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};
581 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;
582 746
583 if ($len > 0) { 747 if ($len > 0) {
584 if (defined $self->{rbuf_max}) { 748 $self->{filter_r}
585 if ($self->{rbuf_max} < length $self->{rbuf}) { 749 ? $self->{filter_r}->($self, $rbuf)
586 $! = &Errno::ENOSPC; return $self->error; 750 : $self->_drain_rbuf;
587 }
588 }
589 751
590 } elsif (defined $len) { 752 } elsif (defined $len) {
753 delete $self->{rw};
591 $self->{eof} = 1; 754 $self->{eof} = 1;
592 delete $self->{rw}; 755 $self->_drain_rbuf;
593 756
594 } elsif ($! != EAGAIN && $! != EINTR) { 757 } elsif ($! != EAGAIN && $! != EINTR) {
595 return $self->error; 758 return $self->error;
596 } 759 }
597
598 $self->_drain_rbuf;
599 }); 760 });
600 } 761 }
601} 762}
602 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
603=back 910=back
604 911
605=head1 AUTHOR 912=head1 AUTHOR
606 913
607Robin 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