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.17 by root, Sat May 24 04:17:45 2008 UTC vs.
Revision 1.30 by root, Sat May 24 23:56:26 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
… …
83waiting for data. 83waiting for data.
84 84
85=item on_error => $cb->($self) 85=item on_error => $cb->($self)
86 86
87This 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
88ocurs, 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
89or a read error. 89or a read error.
90 90
91The 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
92called. 92called.
93 93
94On callback entrance, the value of C<$!> contains the operating system 94On callback entrance, the value of C<$!> contains the operating system
95error (or C<ENOSPC> or C<EPIPE>). 95error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).
96 96
97While 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
98you will not be notified of errors otherwise. The default simply calls 98you will not be notified of errors otherwise. The default simply calls
99die. 99die.
100 100
… …
102 102
103This sets the default read callback, which is called when data arrives 103This sets the default read callback, which is called when data arrives
104and no read request is in the queue. 104and no read request is in the queue.
105 105
106To 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 >>
107method or acces sthe C<$self->{rbuf}> member directly. 107method or access the C<$self->{rbuf}> member directly.
108 108
109When 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
110feed 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
111calling 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
112error will be raised (with C<$!> set to C<EPIPE>). 112error will be raised (with C<$!> set to C<EPIPE>).
… …
139 139
140Sets 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
141buffer: 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
142considered empty. 142considered empty.
143 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
144=back 169=back
145 170
146=cut 171=cut
147 172
148sub new { 173sub new {
… …
151 my $self = bless { @_ }, $class; 176 my $self = bless { @_ }, $class;
152 177
153 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 178 $self->{fh} or Carp::croak "mandatory argument fh is missing";
154 179
155 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 180 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
181
182 if ($self->{tls}) {
183 require Net::SSLeay;
184 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
185 }
156 186
157 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 187 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof};
158 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 188 $self->on_error (delete $self->{on_error}) if $self->{on_error};
159 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 189 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
160 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 190 $self->on_read (delete $self->{on_read} ) if $self->{on_read};
… …
181 } 211 }
182 212
183 if ($self->{on_error}) { 213 if ($self->{on_error}) {
184 $self->{on_error}($self); 214 $self->{on_error}($self);
185 } else { 215 } else {
186 die "AnyEvent::Handle uncaught fatal error: $!"; 216 Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
187 } 217 }
188} 218}
189 219
190=item $fh = $handle->fh 220=item $fh = $handle->fh
191 221
192This method returns the filehandle of the L<AnyEvent::Handle> object. 222This method returns the file handle of the L<AnyEvent::Handle> object.
193 223
194=cut 224=cut
195 225
196sub fh { $_[0]->{fh} } 226sub fh { $_[0]->{fh} }
197 227
… …
225for reading. 255for reading.
226 256
227The write queue is very simple: you can add data to its end, and 257The write queue is very simple: you can add data to its end, and
228AnyEvent::Handle will automatically try to get rid of it for you. 258AnyEvent::Handle will automatically try to get rid of it for you.
229 259
230When data could be writtena nd the write buffer is shorter then the low 260When data could be written and the write buffer is shorter then the low
231water mark, the C<on_drain> callback will be invoked. 261water mark, the C<on_drain> callback will be invoked.
232 262
233=over 4 263=over 4
234 264
235=item $handle->on_drain ($cb) 265=item $handle->on_drain ($cb)
… …
257=cut 287=cut
258 288
259sub _drain_wbuf { 289sub _drain_wbuf {
260 my ($self) = @_; 290 my ($self) = @_;
261 291
262 unless ($self->{ww}) { 292 if (!$self->{ww} && length $self->{wbuf}) {
263 Scalar::Util::weaken $self; 293 Scalar::Util::weaken $self;
264 my $cb = sub { 294 my $cb = sub {
265 my $len = syswrite $self->{fh}, $self->{wbuf}; 295 my $len = syswrite $self->{fh}, $self->{wbuf};
266 296
267 if ($len > 0) { 297 if ($len >= 0) {
268 substr $self->{wbuf}, 0, $len, ""; 298 substr $self->{wbuf}, 0, $len, "";
269 299
270 $self->{on_drain}($self) 300 $self->{on_drain}($self)
271 if $self->{low_water_mark} >= length $self->{wbuf} 301 if $self->{low_water_mark} >= length $self->{wbuf}
272 && $self->{on_drain}; 302 && $self->{on_drain};
… …
281 311
282 $cb->($self); 312 $cb->($self);
283 }; 313 };
284} 314}
285 315
316our %WH;
317
318sub register_write_type($$) {
319 $WH{$_[0]} = $_[1];
320}
321
286sub push_write { 322sub push_write {
287 my $self = shift; 323 my $self = shift;
288 324
325 if (@_ > 1) {
326 my $type = shift;
327
328 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
329 ->($self, @_);
330 }
331
289 if ($self->{filter_w}) { 332 if ($self->{filter_w}) {
290 $self->{filter_w}->(\$_[0]); 333 $self->{filter_w}->($self, \$_[0]);
291 } else { 334 } else {
292 $self->{wbuf} .= $_[0]; 335 $self->{wbuf} .= $_[0];
293 $self->_drain_wbuf; 336 $self->_drain_wbuf;
294 } 337 }
295} 338}
339
340=item $handle->push_write (type => @args)
341
342=item $handle->unshift_write (type => @args)
343
344Instead of formatting your data yourself, you can also let this module do
345the job by specifying a type and type-specific arguments.
346
347Predefined types are (if you have ideas for additional types, feel free to
348drop by and tell us):
349
350=over 4
351
352=item netstring => $string
353
354Formats the given value as netstring
355(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
356
357=back
358
359=cut
360
361register_write_type netstring => sub {
362 my ($self, $string) = @_;
363
364 sprintf "%d:%s,", (length $string), $string
365};
366
367=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args)
368
369This function (not method) lets you add your own types to C<push_write>.
370Whenever the given C<type> is used, C<push_write> will invoke the code
371reference with the handle object and the remaining arguments.
372
373The code reference is supposed to return a single octet string that will
374be appended to the write buffer.
375
376Note that this is a function, and all types registered this way will be
377global, so try to use unique names.
378
379=cut
296 380
297############################################################################# 381#############################################################################
298 382
299=back 383=back
300 384
… …
388 local $self->{in_drain} = 1; 472 local $self->{in_drain} = 1;
389 473
390 while (my $len = length $self->{rbuf}) { 474 while (my $len = length $self->{rbuf}) {
391 no strict 'refs'; 475 no strict 'refs';
392 if (my $cb = shift @{ $self->{queue} }) { 476 if (my $cb = shift @{ $self->{queue} }) {
393 if (!$cb->($self)) { 477 unless ($cb->($self)) {
394 if ($self->{eof}) { 478 if ($self->{eof}) {
395 # no progress can be made (not enough data and no data forthcoming) 479 # no progress can be made (not enough data and no data forthcoming)
396 $! = &Errno::EPIPE; return $self->error; 480 $! = &Errno::EPIPE; return $self->error;
397 } 481 }
398 482
… …
463Append the given callback to the end of the queue (C<push_read>) or 547Append the given callback to the end of the queue (C<push_read>) or
464prepend it (C<unshift_read>). 548prepend it (C<unshift_read>).
465 549
466The callback is called each time some additional read data arrives. 550The callback is called each time some additional read data arrives.
467 551
468It must check wether enough data is in the read buffer already. 552It must check whether enough data is in the read buffer already.
469 553
470If not enough data is available, it must return the empty list or a false 554If not enough data is available, it must return the empty list or a false
471value, in which case it will be called repeatedly until enough data is 555value, in which case it will be called repeatedly until enough data is
472available (or an error condition is detected). 556available (or an error condition is detected).
473 557
… …
475interested in (which can be none at all) and return a true value. After returning 559interested in (which can be none at all) and return a true value. After returning
476true, it will be removed from the queue. 560true, it will be removed from the queue.
477 561
478=cut 562=cut
479 563
564our %RH;
565
566sub register_read_type($$) {
567 $RH{$_[0]} = $_[1];
568}
569
480sub push_read { 570sub push_read {
481 my ($self, $cb) = @_; 571 my $self = shift;
572 my $cb = pop;
573
574 if (@_) {
575 my $type = shift;
576
577 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
578 ->($self, $cb, @_);
579 }
482 580
483 push @{ $self->{queue} }, $cb; 581 push @{ $self->{queue} }, $cb;
484 $self->_drain_rbuf; 582 $self->_drain_rbuf;
485} 583}
486 584
487sub unshift_read { 585sub unshift_read {
488 my ($self, $cb) = @_; 586 my $self = shift;
587 my $cb = pop;
489 588
589 if (@_) {
590 my $type = shift;
591
592 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
593 ->($self, $cb, @_);
594 }
595
596
490 push @{ $self->{queue} }, $cb; 597 unshift @{ $self->{queue} }, $cb;
491 $self->_drain_rbuf; 598 $self->_drain_rbuf;
492} 599}
493 600
494=item $handle->push_read_chunk ($len, $cb->($self, $data)) 601=item $handle->push_read (type => @args, $cb)
495 602
496=item $handle->unshift_read_chunk ($len, $cb->($self, $data)) 603=item $handle->unshift_read (type => @args, $cb)
497 604
498Append the given callback to the end of the queue (C<push_read_chunk>) or 605Instead of providing a callback that parses the data itself you can chose
499prepend it (C<unshift_read_chunk>). 606between a number of predefined parsing formats, for chunks of data, lines
607etc.
500 608
501The callback will be called only once C<$len> bytes have been read, and 609Predefined types are (if you have ideas for additional types, feel free to
502these C<$len> bytes will be passed to the callback. 610drop by and tell us):
503 611
504=cut 612=over 4
505 613
506sub _read_chunk($$) { 614=item chunk => $octets, $cb->($self, $data)
615
616Invoke the callback only once C<$octets> bytes have been read. Pass the
617data read to the callback. The callback will never be called with less
618data.
619
620Example: read 2 bytes.
621
622 $handle->push_read (chunk => 2, sub {
623 warn "yay ", unpack "H*", $_[1];
624 });
625
626=cut
627
628register_read_type chunk => sub {
507 my ($self, $len, $cb) = @_; 629 my ($self, $cb, $len) = @_;
508 630
509 sub { 631 sub {
510 $len <= length $_[0]{rbuf} or return; 632 $len <= length $_[0]{rbuf} or return;
511 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 633 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
512 1 634 1
513 } 635 }
514} 636};
515 637
638# compatibility with older API
516sub push_read_chunk { 639sub push_read_chunk {
517 $_[0]->push_read (&_read_chunk); 640 $_[0]->push_read (chunk => $_[1], $_[2]);
518} 641}
519
520 642
521sub unshift_read_chunk { 643sub unshift_read_chunk {
522 $_[0]->unshift_read (&_read_chunk); 644 $_[0]->unshift_read (chunk => $_[1], $_[2]);
523} 645}
524 646
525=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol)) 647=item line => [$eol, ]$cb->($self, $line, $eol)
526
527=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol))
528
529Append the given callback to the end of the queue (C<push_read_line>) or
530prepend it (C<unshift_read_line>).
531 648
532The callback will be called only once a full line (including the end of 649The callback will be called only once a full line (including the end of
533line marker, C<$eol>) has been read. This line (excluding the end of line 650line marker, C<$eol>) has been read. This line (excluding the end of line
534marker) will be passed to the callback as second argument (C<$line>), and 651marker) will be passed to the callback as second argument (C<$line>), and
535the end of line marker as the third argument (C<$eol>). 652the end of line marker as the third argument (C<$eol>).
… …
546Partial lines at the end of the stream will never be returned, as they are 663Partial lines at the end of the stream will never be returned, as they are
547not marked by the end of line marker. 664not marked by the end of line marker.
548 665
549=cut 666=cut
550 667
551sub _read_line($$) { 668register_read_type line => sub {
552 my $self = shift; 669 my ($self, $cb, $eol) = @_;
553 my $cb = pop;
554 my $eol = @_ ? shift : qr|(\015?\012)|;
555 my $pos;
556 670
671 $eol = qr|(\015?\012)| if @_ < 3;
557 $eol = quotemeta $eol unless ref $eol; 672 $eol = quotemeta $eol unless ref $eol;
558 $eol = qr|^(.*?)($eol)|s; 673 $eol = qr|^(.*?)($eol)|s;
559 674
560 sub { 675 sub {
561 $_[0]{rbuf} =~ s/$eol// or return; 676 $_[0]{rbuf} =~ s/$eol// or return;
562 677
563 $cb->($_[0], $1, $2); 678 $cb->($_[0], $1, $2);
564 1 679 1
565 } 680 }
566} 681};
567 682
683# compatibility with older API
568sub push_read_line { 684sub push_read_line {
569 $_[0]->push_read (&_read_line); 685 my $self = shift;
686 $self->push_read (line => @_);
570} 687}
571 688
572sub unshift_read_line { 689sub unshift_read_line {
573 $_[0]->unshift_read (&_read_line); 690 my $self = shift;
691 $self->unshift_read (line => @_);
574} 692}
693
694=item netstring => $cb->($string)
695
696A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
697
698Throws an error with C<$!> set to EBADMSG on format violations.
699
700=cut
701
702register_read_type netstring => sub {
703 my ($self, $cb) = @_;
704
705 sub {
706 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
707 if ($_[0]{rbuf} =~ /[^0-9]/) {
708 $! = &Errno::EBADMSG;
709 $self->error;
710 }
711 return;
712 }
713
714 my $len = $1;
715
716 $self->unshift_read (chunk => $len, sub {
717 my $string = $_[1];
718 $_[0]->unshift_read (chunk => 1, sub {
719 if ($_[1] eq ",") {
720 $cb->($_[0], $string);
721 } else {
722 $! = &Errno::EBADMSG;
723 $self->error;
724 }
725 });
726 });
727
728 1
729 }
730};
731
732=back
733
734=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args)
735
736This function (not method) lets you add your own types to C<push_read>.
737
738Whenever the given C<type> is used, C<push_read> will invoke the code
739reference with the handle object, the callback and the remaining
740arguments.
741
742The code reference is supposed to return a callback (usually a closure)
743that works as a plain read callback (see C<< ->push_read ($cb) >>).
744
745It should invoke the passed callback when it is done reading (remember to
746pass C<$self> as first argument as all other callbacks do that).
747
748Note that this is a function, and all types registered this way will be
749global, so try to use unique names.
750
751For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
752search for C<register_read_type>)).
575 753
576=item $handle->stop_read 754=item $handle->stop_read
577 755
578=item $handle->start_read 756=item $handle->start_read
579 757
580In rare cases you actually do not want to read anything form the 758In rare cases you actually do not want to read anything from the
581socket. In this case you can call C<stop_read>. Neither C<on_read> no 759socket. In this case you can call C<stop_read>. Neither C<on_read> no
582any queued callbacks will be executed then. To start readign again, call 760any queued callbacks will be executed then. To start reading again, call
583C<start_read>. 761C<start_read>.
584 762
585=cut 763=cut
586 764
587sub stop_read { 765sub stop_read {
… …
600 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 778 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
601 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 779 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
602 780
603 if ($len > 0) { 781 if ($len > 0) {
604 $self->{filter_r} 782 $self->{filter_r}
605 ? $self->{filter_r}->($rbuf) 783 ? $self->{filter_r}->($self, $rbuf)
606 : $self->_drain_rbuf; 784 : $self->_drain_rbuf;
607 785
608 } elsif (defined $len) { 786 } elsif (defined $len) {
609 delete $self->{rw}; 787 delete $self->{rw};
610 $self->{eof} = 1; 788 $self->{eof} = 1;
… …
615 } 793 }
616 }); 794 });
617 } 795 }
618} 796}
619 797
798sub _dotls {
799 my ($self) = @_;
800
801 if (length $self->{tls_wbuf}) {
802 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {
803 substr $self->{tls_wbuf}, 0, $len, "";
804 }
805 }
806
807 if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
808 $self->{wbuf} .= $buf;
809 $self->_drain_wbuf;
810 }
811
812 while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
813 $self->{rbuf} .= $buf;
814 $self->_drain_rbuf;
815 }
816
817 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
818
819 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
820 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
821 $self->error;
822 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
823 $! = &Errno::EIO;
824 $self->error;
825 }
826
827 # all others are fine for our purposes
828 }
829}
830
831=item $handle->starttls ($tls[, $tls_ctx])
832
833Instead of starting TLS negotiation immediately when the AnyEvent::Handle
834object is created, you can also do that at a later time by calling
835C<starttls>.
836
837The first argument is the same as the C<tls> constructor argument (either
838C<"connect">, C<"accept"> or an existing Net::SSLeay object).
839
840The second argument is the optional C<Net::SSLeay::CTX> object that is
841used when AnyEvent::Handle has to create its own TLS connection object.
842
843=cut
844
845# TODO: maybe document...
846sub starttls {
847 my ($self, $ssl, $ctx) = @_;
848
849 $self->stoptls;
850
851 if ($ssl eq "accept") {
852 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
853 Net::SSLeay::set_accept_state ($ssl);
854 } elsif ($ssl eq "connect") {
855 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
856 Net::SSLeay::set_connect_state ($ssl);
857 }
858
859 $self->{tls} = $ssl;
860
861 # basically, this is deep magic (because SSL_read should have the same issues)
862 # but the openssl maintainers basically said: "trust us, it just works".
863 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
864 # and mismaintained ssleay-module doesn't even offer them).
865 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
866 Net::SSLeay::CTX_set_mode ($self->{tls},
867 (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
868 | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
869
870 $self->{tls_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
871 $self->{tls_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
872
873 Net::SSLeay::set_bio ($ssl, $self->{tls_rbio}, $self->{tls_wbio});
874
875 $self->{filter_w} = sub {
876 $_[0]{tls_wbuf} .= ${$_[1]};
877 &_dotls;
878 };
879 $self->{filter_r} = sub {
880 Net::SSLeay::BIO_write ($_[0]{tls_rbio}, ${$_[1]});
881 &_dotls;
882 };
883}
884
885=item $handle->stoptls
886
887Destroys the SSL connection, if any. Partial read or write data will be
888lost.
889
890=cut
891
892sub stoptls {
893 my ($self) = @_;
894
895 Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
896 delete $self->{tls_rbio};
897 delete $self->{tls_wbio};
898 delete $self->{tls_wbuf};
899 delete $self->{filter_r};
900 delete $self->{filter_w};
901}
902
903sub DESTROY {
904 my $self = shift;
905
906 $self->stoptls;
907}
908
909=item AnyEvent::Handle::TLS_CTX
910
911This function creates and returns the Net::SSLeay::CTX object used by
912default for TLS mode.
913
914The context is created like this:
915
916 Net::SSLeay::load_error_strings;
917 Net::SSLeay::SSLeay_add_ssl_algorithms;
918 Net::SSLeay::randomize;
919
920 my $CTX = Net::SSLeay::CTX_new;
921
922 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
923
924=cut
925
926our $TLS_CTX;
927
928sub TLS_CTX() {
929 $TLS_CTX || do {
930 require Net::SSLeay;
931
932 Net::SSLeay::load_error_strings ();
933 Net::SSLeay::SSLeay_add_ssl_algorithms ();
934 Net::SSLeay::randomize ();
935
936 $TLS_CTX = Net::SSLeay::CTX_new ();
937
938 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
939
940 $TLS_CTX
941 }
942}
943
620=back 944=back
621 945
622=head1 AUTHOR 946=head1 AUTHOR
623 947
624Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>. 948Robin Redeker C<< <elmex at ta-sa.org> >>, Marc Lehmann <schmorp@schmorp.de>.

Diff Legend

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