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.142 by root, Mon Jul 6 20:24:47 2009 UTC vs.
Revision 1.151 by root, Thu Jul 16 04:20:23 2009 UTC

14 14
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17=cut
18 18
19our $VERSION = 4.452; 19our $VERSION = 4.82;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
25 25
26 my $cv = AnyEvent->condvar; 26 my $cv = AnyEvent->condvar;
27 27
28 my $handle = 28 my $hdl; $hdl = new AnyEvent::Handle
29 AnyEvent::Handle->new (
30 fh => \*STDIN, 29 fh => \*STDIN,
31 on_eof => sub { 30 on_error => sub {
31 my ($hdl, $fatal, $msg) = @_;
32 warn "got error $msg\n";
33 $hdl->destroy;
32 $cv->send; 34 $cv->send;
33 },
34 ); 35 );
35 36
36 # send some request line 37 # send some request line
37 $handle->push_write ("getinfo\015\012"); 38 $hdl->push_write ("getinfo\015\012");
38 39
39 # read the response line 40 # read the response line
40 $handle->push_read (line => sub { 41 $hdl->push_read (line => sub {
41 my ($handle, $line) = @_; 42 my ($hdl, $line) = @_;
42 warn "read line <$line>\n"; 43 warn "got line <$line>\n";
43 $cv->send; 44 $cv->send;
44 }); 45 });
45 46
46 $cv->recv; 47 $cv->recv;
47 48
81 82
82=item on_eof => $cb->($handle) 83=item on_eof => $cb->($handle)
83 84
84Set the callback to be called when an end-of-file condition is detected, 85Set the callback to be called when an end-of-file condition is detected,
85i.e. in the case of a socket, when the other side has closed the 86i.e. in the case of a socket, when the other side has closed the
86connection cleanly. 87connection cleanly, and there are no outstanding read requests in the
88queue (if there are read requests, then an EOF counts as an unexpected
89connection close and will be flagged as an error).
87 90
88For sockets, this just means that the other side has stopped sending data, 91For sockets, this just means that the other side has stopped sending data,
89you can still try to write data, and, in fact, one can return from the EOF 92you can still try to write data, and, in fact, one can return from the EOF
90callback and continue writing data, as only the read part has been shut 93callback and continue writing data, as only the read part has been shut
91down. 94down.
92 95
93While not mandatory, it is I<highly> recommended to set an EOF callback,
94otherwise you might end up with a closed socket while you are still
95waiting for data.
96
97If an EOF condition has been detected but no C<on_eof> callback has been 96If an EOF condition has been detected but no C<on_eof> callback has been
98set, then a fatal error will be raised with C<$!> set to <0>. 97set, then a fatal error will be raised with C<$!> set to <0>.
99 98
100=item on_error => $cb->($handle, $fatal, $message) 99=item on_error => $cb->($handle, $fatal, $message)
101 100
102This is the error callback, which is called when, well, some error 101This is the error callback, which is called when, well, some error
103occured, such as not being able to resolve the hostname, failure to 102occured, such as not being able to resolve the hostname, failure to
104connect or a read error. 103connect or a read error.
105 104
106Some errors are fatal (which is indicated by C<$fatal> being true). On 105Some errors are fatal (which is indicated by C<$fatal> being true). On
107fatal errors the handle object will be shut down and will not be usable 106fatal errors the handle object will be destroyed (by a call to C<< ->
108(but you are free to look at the current C<< ->rbuf >>). Examples of fatal 107destroy >>) after invoking the error callback (which means you are free to
109errors are an EOF condition with active (but unsatisifable) read watchers 108examine the handle object). Examples of fatal errors are an EOF condition
110(C<EPIPE>) or I/O errors. 109with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors.
111 110
112AnyEvent::Handle tries to find an appropriate error code for you to check 111AnyEvent::Handle tries to find an appropriate error code for you to check
113against, but in some cases (TLS errors), this does not work well. It is 112against, but in some cases (TLS errors), this does not work well. It is
114recommended to always output the C<$message> argument in human-readable 113recommended to always output the C<$message> argument in human-readable
115error messages (it's usually the same as C<"$!">). 114error messages (it's usually the same as C<"$!">).
141 140
142When an EOF condition is detected then AnyEvent::Handle will first try to 141When an EOF condition is detected then AnyEvent::Handle will first try to
143feed all the remaining data to the queued callbacks and C<on_read> before 142feed all the remaining data to the queued callbacks and C<on_read> before
144calling the C<on_eof> callback. If no progress can be made, then a fatal 143calling the C<on_eof> callback. If no progress can be made, then a fatal
145error will be raised (with C<$!> set to C<EPIPE>). 144error will be raised (with C<$!> set to C<EPIPE>).
145
146Note that, unlike requests in the read queue, an C<on_read> callback
147doesn't mean you I<require> some data: if there is an EOF and there
148are outstanding read requests then an error will be flagged. With an
149C<on_read> callback, the C<on_eof> callback will be invoked.
146 150
147=item on_drain => $cb->($handle) 151=item on_drain => $cb->($handle)
148 152
149This sets the callback that is called when the write buffer becomes empty 153This sets the callback that is called when the write buffer becomes empty
150(or when the callback is set and the buffer is empty already). 154(or when the callback is set and the buffer is empty already).
249 253
250A string used to identify the remote site - usually the DNS hostname 254A string used to identify the remote site - usually the DNS hostname
251(I<not> IDN!) used to create the connection, rarely the IP address. 255(I<not> IDN!) used to create the connection, rarely the IP address.
252 256
253Apart from being useful in error messages, this string is also used in TLS 257Apart from being useful in error messages, this string is also used in TLS
254peername verification (see C<verify_peername> in L<AnyEvent::TLS>). 258peername verification (see C<verify_peername> in L<AnyEvent::TLS>). This
259verification will be skipped when C<peername> is not specified or
260C<undef>.
255 261
256=item tls => "accept" | "connect" | Net::SSLeay::SSL object 262=item tls => "accept" | "connect" | Net::SSLeay::SSL object
257 263
258When this parameter is given, it enables TLS (SSL) mode, that means 264When this parameter is given, it enables TLS (SSL) mode, that means
259AnyEvent will start a TLS handshake as soon as the conenction has been 265AnyEvent will start a TLS handshake as soon as the conenction has been
296 302
297Instead of an object, you can also specify a hash reference with C<< key 303Instead of an object, you can also specify a hash reference with C<< key
298=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a 304=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a
299new TLS context object. 305new TLS context object.
300 306
301=item on_starttls => $cb->($handle, $success) 307=item on_starttls => $cb->($handle, $success[, $error_message])
302 308
303This callback will be invoked when the TLS/SSL handshake has finished. If 309This callback will be invoked when the TLS/SSL handshake has finished. If
304C<$success> is true, then the TLS handshake succeeded, otherwise it failed 310C<$success> is true, then the TLS handshake succeeded, otherwise it failed
305(C<on_stoptls> will not be called in this case). 311(C<on_stoptls> will not be called in this case).
306 312
307The session in C<< $handle->{tls} >> can still be examined in this 313The session in C<< $handle->{tls} >> can still be examined in this
308callback, even when the handshake was not successful. 314callback, even when the handshake was not successful.
315
316TLS handshake failures will not cause C<on_error> to be invoked when this
317callback is in effect, instead, the error message will be passed to C<on_starttls>.
318
319Without this callback, handshake failures lead to C<on_error> being
320called, as normal.
321
322Note that you cannot call C<starttls> right again in this callback. If you
323need to do that, start an zero-second timer instead whose callback can
324then call C<< ->starttls >> again.
309 325
310=item on_stoptls => $cb->($handle) 326=item on_stoptls => $cb->($handle)
311 327
312When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is 328When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is
313set, then it will be invoked after freeing the TLS session. If it is not, 329set, then it will be invoked after freeing the TLS session. If it is not,
349 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay}; 365 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
350 366
351 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 367 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
352 if $self->{tls}; 368 if $self->{tls};
353 369
354 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain}; 370 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
355 371
356 $self->start_read 372 $self->start_read
357 if $self->{on_read}; 373 if $self->{on_read};
358 374
359 $self->{fh} && $self 375 $self->{fh} && $self
360} 376}
361 377
362sub _shutdown { 378#sub _shutdown {
363 my ($self) = @_; 379# my ($self) = @_;
364 380#
365 delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)}; 381# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
366 $self->{_eof} = 1; # tell starttls et. al to stop trying 382# $self->{_eof} = 1; # tell starttls et. al to stop trying
367 383#
368 &_freetls; 384# &_freetls;
369} 385#}
370 386
371sub _error { 387sub _error {
372 my ($self, $errno, $fatal, $message) = @_; 388 my ($self, $errno, $fatal, $message) = @_;
373 389
374 $self->_shutdown
375 if $fatal;
376
377 $! = $errno; 390 $! = $errno;
378 $message ||= "$!"; 391 $message ||= "$!";
379 392
380 if ($self->{on_error}) { 393 if ($self->{on_error}) {
381 $self->{on_error}($self, $fatal, $message); 394 $self->{on_error}($self, $fatal, $message);
395 $self->destroy if $fatal;
382 } elsif ($self->{fh}) { 396 } elsif ($self->{fh}) {
397 $self->destroy;
383 Carp::croak "AnyEvent::Handle uncaught error: $message"; 398 Carp::croak "AnyEvent::Handle uncaught error: $message";
384 } 399 }
385} 400}
386 401
387=item $fh = $handle->fh 402=item $fh = $handle->fh
502 $self->{_activity} = $NOW; 517 $self->{_activity} = $NOW;
503 518
504 if ($self->{on_timeout}) { 519 if ($self->{on_timeout}) {
505 $self->{on_timeout}($self); 520 $self->{on_timeout}($self);
506 } else { 521 } else {
507 $self->_error (&Errno::ETIMEDOUT); 522 $self->_error (Errno::ETIMEDOUT);
508 } 523 }
509 524
510 # callback could have changed timeout value, optimise 525 # callback could have changed timeout value, optimise
511 return unless $self->{timeout}; 526 return unless $self->{timeout};
512 527
575 Scalar::Util::weaken $self; 590 Scalar::Util::weaken $self;
576 591
577 my $cb = sub { 592 my $cb = sub {
578 my $len = syswrite $self->{fh}, $self->{wbuf}; 593 my $len = syswrite $self->{fh}, $self->{wbuf};
579 594
580 if ($len >= 0) { 595 if (defined $len) {
581 substr $self->{wbuf}, 0, $len, ""; 596 substr $self->{wbuf}, 0, $len, "";
582 597
583 $self->{_activity} = AnyEvent->now; 598 $self->{_activity} = AnyEvent->now;
584 599
585 $self->{on_drain}($self) 600 $self->{on_drain}($self)
854 869
855 if ( 870 if (
856 defined $self->{rbuf_max} 871 defined $self->{rbuf_max}
857 && $self->{rbuf_max} < length $self->{rbuf} 872 && $self->{rbuf_max} < length $self->{rbuf}
858 ) { 873 ) {
859 $self->_error (&Errno::ENOSPC, 1), return; 874 $self->_error (Errno::ENOSPC, 1), return;
860 } 875 }
861 876
862 while () { 877 while () {
863 # we need to use a separate tls read buffer, as we must not receive data while 878 # we need to use a separate tls read buffer, as we must not receive data while
864 # we are draining the buffer, and this can only happen with TLS. 879 # we are draining the buffer, and this can only happen with TLS.
868 883
869 if (my $cb = shift @{ $self->{_queue} }) { 884 if (my $cb = shift @{ $self->{_queue} }) {
870 unless ($cb->($self)) { 885 unless ($cb->($self)) {
871 if ($self->{_eof}) { 886 if ($self->{_eof}) {
872 # no progress can be made (not enough data and no data forthcoming) 887 # no progress can be made (not enough data and no data forthcoming)
873 $self->_error (&Errno::EPIPE, 1), return; 888 $self->_error (Errno::EPIPE, 1), return;
874 } 889 }
875 890
876 unshift @{ $self->{_queue} }, $cb; 891 unshift @{ $self->{_queue} }, $cb;
877 last; 892 last;
878 } 893 }
886 && !@{ $self->{_queue} } # and the queue is still empty 901 && !@{ $self->{_queue} } # and the queue is still empty
887 && $self->{on_read} # but we still have on_read 902 && $self->{on_read} # but we still have on_read
888 ) { 903 ) {
889 # no further data will arrive 904 # no further data will arrive
890 # so no progress can be made 905 # so no progress can be made
891 $self->_error (&Errno::EPIPE, 1), return 906 $self->_error (Errno::EPIPE, 1), return
892 if $self->{_eof}; 907 if $self->{_eof};
893 908
894 last; # more data might arrive 909 last; # more data might arrive
895 } 910 }
896 } else { 911 } else {
1146 return 1; 1161 return 1;
1147 } 1162 }
1148 1163
1149 # reject 1164 # reject
1150 if ($reject && $$rbuf =~ $reject) { 1165 if ($reject && $$rbuf =~ $reject) {
1151 $self->_error (&Errno::EBADMSG); 1166 $self->_error (Errno::EBADMSG);
1152 } 1167 }
1153 1168
1154 # skip 1169 # skip
1155 if ($skip && $$rbuf =~ $skip) { 1170 if ($skip && $$rbuf =~ $skip) {
1156 $data .= substr $$rbuf, 0, $+[0], ""; 1171 $data .= substr $$rbuf, 0, $+[0], "";
1172 my ($self, $cb) = @_; 1187 my ($self, $cb) = @_;
1173 1188
1174 sub { 1189 sub {
1175 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 1190 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
1176 if ($_[0]{rbuf} =~ /[^0-9]/) { 1191 if ($_[0]{rbuf} =~ /[^0-9]/) {
1177 $self->_error (&Errno::EBADMSG); 1192 $self->_error (Errno::EBADMSG);
1178 } 1193 }
1179 return; 1194 return;
1180 } 1195 }
1181 1196
1182 my $len = $1; 1197 my $len = $1;
1185 my $string = $_[1]; 1200 my $string = $_[1];
1186 $_[0]->unshift_read (chunk => 1, sub { 1201 $_[0]->unshift_read (chunk => 1, sub {
1187 if ($_[1] eq ",") { 1202 if ($_[1] eq ",") {
1188 $cb->($_[0], $string); 1203 $cb->($_[0], $string);
1189 } else { 1204 } else {
1190 $self->_error (&Errno::EBADMSG); 1205 $self->_error (Errno::EBADMSG);
1191 } 1206 }
1192 }); 1207 });
1193 }); 1208 });
1194 1209
1195 1 1210 1
1285 $json->incr_skip; 1300 $json->incr_skip;
1286 1301
1287 $self->{rbuf} = $json->incr_text; 1302 $self->{rbuf} = $json->incr_text;
1288 $json->incr_text = ""; 1303 $json->incr_text = "";
1289 1304
1290 $self->_error (&Errno::EBADMSG); 1305 $self->_error (Errno::EBADMSG);
1291 1306
1292 () 1307 ()
1293 } else { 1308 } else {
1294 $self->{rbuf} = ""; 1309 $self->{rbuf} = "";
1295 1310
1332 # read remaining chunk 1347 # read remaining chunk
1333 $_[0]->unshift_read (chunk => $len, sub { 1348 $_[0]->unshift_read (chunk => $len, sub {
1334 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1349 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1335 $cb->($_[0], $ref); 1350 $cb->($_[0], $ref);
1336 } else { 1351 } else {
1337 $self->_error (&Errno::EBADMSG); 1352 $self->_error (Errno::EBADMSG);
1338 } 1353 }
1339 }); 1354 });
1340 } 1355 }
1341 1356
1342 1 1357 1
1435 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()); 1450 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
1436 1451
1437 # reduce error string to look less scary 1452 # reduce error string to look less scary
1438 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /; 1453 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
1439 1454
1455 if ($self->{_on_starttls}) {
1456 (delete $self->{_on_starttls})->($self, undef, $err);
1457 &_freetls;
1458 } else {
1459 &_freetls;
1440 $self->_error (&Errno::EPROTO, 1, $err); 1460 $self->_error (Errno::EPROTO, 1, $err);
1461 }
1441} 1462}
1442 1463
1443# poll the write BIO and send the data if applicable 1464# poll the write BIO and send the data if applicable
1444# also decode read data if possible 1465# also decode read data if possible
1445# this is basiclaly our TLS state machine 1466# this is basiclaly our TLS state machine
1461 && ($tmp != $ERROR_SYSCALL || $!); 1482 && ($tmp != $ERROR_SYSCALL || $!);
1462 } 1483 }
1463 1484
1464 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { 1485 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
1465 unless (length $tmp) { 1486 unless (length $tmp) {
1487 $self->{_on_starttls}
1488 and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ???
1466 &_freetls; 1489 &_freetls;
1490
1467 if ($self->{on_stoptls}) { 1491 if ($self->{on_stoptls}) {
1468 $self->{on_stoptls}($self); 1492 $self->{on_stoptls}($self);
1469 return; 1493 return;
1470 } else { 1494 } else {
1471 # let's treat SSL-eof as we treat normal EOF 1495 # let's treat SSL-eof as we treat normal EOF
1489 $self->_drain_wbuf; 1513 $self->_drain_wbuf;
1490 } 1514 }
1491 1515
1492 $self->{_on_starttls} 1516 $self->{_on_starttls}
1493 and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK () 1517 and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK ()
1494 and (delete $self->{_on_starttls})->($self, 1); 1518 and (delete $self->{_on_starttls})->($self, 1, "TLS/SSL connection established");
1495} 1519}
1496 1520
1497=item $handle->starttls ($tls[, $tls_ctx]) 1521=item $handle->starttls ($tls[, $tls_ctx])
1498 1522
1499Instead of starting TLS negotiation immediately when the AnyEvent::Handle 1523Instead of starting TLS negotiation immediately when the AnyEvent::Handle
1570 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1594 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1571 1595
1572 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1596 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1573 1597
1574 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } 1598 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1575 if exists $self->{on_starttls}; 1599 if $self->{on_starttls};
1576 1600
1577 &_dotls; # need to trigger the initial handshake 1601 &_dotls; # need to trigger the initial handshake
1578 $self->start_read; # make sure we actually do read 1602 $self->start_read; # make sure we actually do read
1579} 1603}
1580 1604
1604sub _freetls { 1628sub _freetls {
1605 my ($self) = @_; 1629 my ($self) = @_;
1606 1630
1607 return unless $self->{tls}; 1631 return unless $self->{tls};
1608 1632
1609 $self->{_on_starttls}
1610 and (delete $self->{_on_starttls})->($self, undef);
1611
1612 $self->{tls_ctx}->_put_session (delete $self->{tls}); 1633 $self->{tls_ctx}->_put_session (delete $self->{tls});
1613 1634
1614 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1635 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1615} 1636}
1616 1637
1617sub DESTROY { 1638sub DESTROY {
1618 my ($self) = @_; 1639 my ($self) = @_;
1619 1640
1653callbacks, as well as code outside. It does I<NOT> work in a read or write 1674callbacks, as well as code outside. It does I<NOT> work in a read or write
1654callback, so when you want to destroy the AnyEvent::Handle object from 1675callback, so when you want to destroy the AnyEvent::Handle object from
1655within such an callback. You I<MUST> call C<< ->destroy >> explicitly in 1676within such an callback. You I<MUST> call C<< ->destroy >> explicitly in
1656that case. 1677that case.
1657 1678
1679Destroying the handle object in this way has the advantage that callbacks
1680will be removed as well, so if those are the only reference holders (as
1681is common), then one doesn't need to do anything special to break any
1682reference cycles.
1683
1658The handle might still linger in the background and write out remaining 1684The handle might still linger in the background and write out remaining
1659data, as specified by the C<linger> option, however. 1685data, as specified by the C<linger> option, however.
1660 1686
1661=cut 1687=cut
1662 1688
1729 1755
1730 $handle->on_read (sub { }); 1756 $handle->on_read (sub { });
1731 $handle->on_eof (undef); 1757 $handle->on_eof (undef);
1732 $handle->on_error (sub { 1758 $handle->on_error (sub {
1733 my $data = delete $_[0]{rbuf}; 1759 my $data = delete $_[0]{rbuf};
1734 undef $handle;
1735 }); 1760 });
1736 1761
1737The reason to use C<on_error> is that TCP connections, due to latencies 1762The reason to use C<on_error> is that TCP connections, due to latencies
1738and packets loss, might get closed quite violently with an error, when in 1763and packets loss, might get closed quite violently with an error, when in
1739fact, all data has been received. 1764fact, all data has been received.
1755 $handle->on_drain (sub { 1780 $handle->on_drain (sub {
1756 warn "all data submitted to the kernel\n"; 1781 warn "all data submitted to the kernel\n";
1757 undef $handle; 1782 undef $handle;
1758 }); 1783 });
1759 1784
1785If you just want to queue some data and then signal EOF to the other side,
1786consider using C<< ->push_shutdown >> instead.
1787
1788=item I want to contact a TLS/SSL server, I don't care about security.
1789
1790If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS,
1791simply connect to it and then create the AnyEvent::Handle with the C<tls>
1792parameter:
1793
1794 tcp_connect $host, $port, sub {
1795 my ($fh) = @_;
1796
1797 my $handle = new AnyEvent::Handle
1798 fh => $fh,
1799 tls => "connect",
1800 on_error => sub { ... };
1801
1802 $handle->push_write (...);
1803 };
1804
1805=item I want to contact a TLS/SSL server, I do care about security.
1806
1807Then you should additionally enable certificate verification, including
1808peername verification, if the protocol you use supports it (see
1809L<AnyEvent::TLS>, C<verify_peername>).
1810
1811E.g. for HTTPS:
1812
1813 tcp_connect $host, $port, sub {
1814 my ($fh) = @_;
1815
1816 my $handle = new AnyEvent::Handle
1817 fh => $fh,
1818 peername => $host,
1819 tls => "connect",
1820 tls_ctx => { verify => 1, verify_peername => "https" },
1821 ...
1822
1823Note that you must specify the hostname you connected to (or whatever
1824"peername" the protocol needs) as the C<peername> argument, otherwise no
1825peername verification will be done.
1826
1827The above will use the system-dependent default set of trusted CA
1828certificates. If you want to check against a specific CA, add the
1829C<ca_file> (or C<ca_cert>) arguments to C<tls_ctx>:
1830
1831 tls_ctx => {
1832 verify => 1,
1833 verify_peername => "https",
1834 ca_file => "my-ca-cert.pem",
1835 },
1836
1837=item I want to create a TLS/SSL server, how do I do that?
1838
1839Well, you first need to get a server certificate and key. You have
1840three options: a) ask a CA (buy one, use cacert.org etc.) b) create a
1841self-signed certificate (cheap. check the search engine of your choice,
1842there are many tutorials on the net) or c) make your own CA (tinyca2 is a
1843nice program for that purpose).
1844
1845Then create a file with your private key (in PEM format, see
1846L<AnyEvent::TLS>), followed by the certificate (also in PEM format). The
1847file should then look like this:
1848
1849 -----BEGIN RSA PRIVATE KEY-----
1850 ...header data
1851 ... lots of base64'y-stuff
1852 -----END RSA PRIVATE KEY-----
1853
1854 -----BEGIN CERTIFICATE-----
1855 ... lots of base64'y-stuff
1856 -----END CERTIFICATE-----
1857
1858The important bits are the "PRIVATE KEY" and "CERTIFICATE" parts. Then
1859specify this file as C<cert_file>:
1860
1861 tcp_server undef, $port, sub {
1862 my ($fh) = @_;
1863
1864 my $handle = new AnyEvent::Handle
1865 fh => $fh,
1866 tls => "accept",
1867 tls_ctx => { cert_file => "my-server-keycert.pem" },
1868 ...
1869
1870When you have intermediate CA certificates that your clients might not
1871know about, just append them to the C<cert_file>.
1872
1760=back 1873=back
1761 1874
1762 1875
1763=head1 SUBCLASSING AnyEvent::Handle 1876=head1 SUBCLASSING AnyEvent::Handle
1764 1877

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines