1 |
package AnyEvent::TLS; |
2 |
|
3 |
use Carp qw(croak); |
4 |
use Scalar::Util (); |
5 |
|
6 |
use AnyEvent (); BEGIN { AnyEvent::common_sense } |
7 |
use AnyEvent::Util (); |
8 |
|
9 |
use Net::SSLeay; |
10 |
|
11 |
=head1 NAME |
12 |
|
13 |
AnyEvent::TLS - SSLv2/SSLv3/TLSv1 contexts for use in AnyEvent::Handle |
14 |
|
15 |
=cut |
16 |
|
17 |
our $VERSION = $AnyEvent::VERSION; |
18 |
|
19 |
=head1 SYNOPSIS |
20 |
|
21 |
# via AnyEvent::Handle |
22 |
|
23 |
use AnyEvent; |
24 |
use AnyEvent::Handle; |
25 |
use AnyEvent::Socket; |
26 |
|
27 |
# simple https-client |
28 |
my $handle = new AnyEvent::Handle |
29 |
connect => [$host, $port], |
30 |
tls => "connect", |
31 |
tls_ctx => { verify => 1, verify_peername => "https" }, |
32 |
... |
33 |
|
34 |
# simple ssl-server |
35 |
tcp_server undef, $port, sub { |
36 |
my ($fh) = @_; |
37 |
|
38 |
my $handle = new AnyEvent::Handle |
39 |
fh => $fh, |
40 |
tls => "accept", |
41 |
tls_ctx => { cert_file => "my-server-keycert.pem" }, |
42 |
... |
43 |
|
44 |
# directly |
45 |
|
46 |
my $tls = new AnyEvent::TLS |
47 |
verify => 1, |
48 |
verify_peername => "ldaps", |
49 |
ca_file => "/etc/cacertificates.pem"; |
50 |
|
51 |
=head1 DESCRIPTION |
52 |
|
53 |
This module is a helper module that implements TLS/SSL (Transport Layer |
54 |
Security/Secure Sockets Layer) contexts. A TLS context is a common set of |
55 |
configuration values for use in establishing TLS connections. |
56 |
|
57 |
For some quick facts about SSL/TLS, see the section of the same name near |
58 |
the end of the document. |
59 |
|
60 |
A single TLS context can be used for any number of TLS connections that |
61 |
wish to use the same certificates, policies etc. |
62 |
|
63 |
Note that this module is inherently tied to L<Net::SSLeay>, as this |
64 |
library is used to implement it. Since that perl module is rather ugly, |
65 |
and OpenSSL has a rather ugly license, AnyEvent might switch TLS providers |
66 |
at some future point, at which this API will change dramatically, at least |
67 |
in the Net::SSLeay-specific parts (most constructor arguments should still |
68 |
work, though). |
69 |
|
70 |
Although this module does not require a specific version of Net::SSLeay, |
71 |
many features will gradually stop working, or bugs will be introduced with |
72 |
old versions (verification might succeed when it shouldn't - this is a |
73 |
real security issue). Version 1.35 is recommended, 1.33 should work, 1.32 |
74 |
might, and older versions are yours to keep. |
75 |
|
76 |
=head1 USAGE EXAMPLES |
77 |
|
78 |
See the L<AnyEvent::Handle> manpage, NONFREQUENTLY ASKED QUESTIONS, for |
79 |
some actual usage examples. |
80 |
|
81 |
=head1 PUBLIC METHODS AND FUNCTIONS |
82 |
|
83 |
=over 4 |
84 |
|
85 |
=cut |
86 |
|
87 |
our $REF_IDX; # our session ex_data id |
88 |
|
89 |
# create temp file, populate it, and returna guard and filename |
90 |
sub _tmpfile($) { |
91 |
require File::Temp; |
92 |
my ($fh, $path) = File::Temp::mkstemp ("aetlspemXXXXXX"); |
93 |
my $guard = AnyEvent::Util::guard { unlink $path }; |
94 |
|
95 |
syswrite $fh, $_[0]; |
96 |
close $fh; |
97 |
|
98 |
($path, $guard) |
99 |
} |
100 |
|
101 |
our %DH_PARAMS = ( |
102 |
# These are the DH parameters from "Assigned Number for SKIP Protocols" |
103 |
# (http://www.skip-vpn.org/spec/numbers.html). |
104 |
# (or http://web.archive.org/web/20011212141438/http://www.skip-vpn.org/spec/numbers.html#params) |
105 |
# See there for how they were generated. |
106 |
# Note that g might not be a generator, |
107 |
# but this is not a problem since p is a safe prime. |
108 |
skip512 => "MEYCQQD1Kv884bEpQBgRjXyEpwpy1obEAxnIByl6ypUM2Zafq9AKUJsCRtMIPWak|XUGfnHy9iUsiGSa6q6Jew1XpKgVfAgEC", |
109 |
skip1024 => "MIGHAoGBAPSI/VhOSdvNILSd5JEHNmszbDgNRR0PfIizHHxbLY7288kjwEPwpVsY|jY67VYy4XTjTNP18F1dDox0YbN4zISy1Kv884bEpQBgRjXyEpwpy1obEAxnIByl6|ypUM2Zafq9AKUJsCRtMIPWakXUGfnHy9iUsiGSa6q6Jew1XpL3jHAgEC", |
110 |
skip2048 => "MIIBCAKCAQEA9kJXtwh/CBdyorrWqULzBej5UxE5T7bxbrlLOCDaAadWoxTpj0BV|89AHxstDqZSt90xkhkn4DIO9ZekX1KHTUPj1WV/cdlJPPT2N286Z4VeSWc39uK50|T8X8dryDxUcwYc58yWb/Ffm7/ZFexwGq01uejaClcjrUGvC/RgBYK+X0iP1YTknb|zSC0neSRBzZrM2w4DUUdD3yIsxx8Wy2O9vPJI8BD8KVbGI2Ou1WMuF040zT9fBdX|Q6MdGGzeMyEstSr/POGxKUAYEY18hKcKctaGxAMZyAcpesqVDNmWn6vQClCbAkbT|CD1mpF1Bn5x8vYlLIhkmuquiXsNV6TILOwIBAg==", |
111 |
skip4096 => "MIICCAKCAgEA+hRyUsFN4VpJ1O8JLcCo/VWr19k3BCgJ4uk+d+KhehjdRqNDNyOQ|l/MOyQNQfWXPeGKmOmIig6Ev/nm6Nf9Z2B1h3R4hExf+zTiHnvVPeRBhjdQi81rt|Xeoh6TNrSBIKIHfUJWBh3va0TxxjQIs6IZOLeVNRLMqzeylWqMf49HsIXqbcokUS|Vt1BkvLdW48j8PPv5DsKRN3tloTxqDJGo9tKvj1Fuk74A+Xda1kNhB7KFlqMyN98|VETEJ6c7KpfOo30mnK30wqw3S8OtaIR/maYX72tGOno2ehFDkq3pnPtEbD2CScxc|alJC+EL7RPk5c/tgeTvCngvc1KZn92Y//EI7G9tPZtylj2b56sHtMftIoYJ9+ODM|sccD5Piz/rejE3Ome8EOOceUSCYAhXn8b3qvxVI1ddd1pED6FHRhFvLrZxFvBEM9|ERRMp5QqOaHJkM+Dxv8Cj6MqrCbfC4u+ZErxodzuusgDgvZiLF22uxMZbobFWyte|OvOzKGtwcTqO/1wV5gKkzu1ZVswVUQd5Gg8lJicwqRWyyNRczDDoG9jVDxmogKTH|AaqLulO7R8Ifa1SwF2DteSGVtgWEN8gDpN3RBmmPTDngyF2DHb5qmpnznwtFKdTL|KWbuHn491xNO25CQWMtem80uKw+pTnisBRF/454n1Jnhub144YRBoN8CAQI=", |
112 |
|
113 |
# generated on a linux desktop with openssl using /dev/urandom - entropy_avail was >= 3600 each time |
114 |
# the 8192 bit key took 25 hours to generate :/ |
115 |
schmorp1024 => "MIGHAoGBAN+GjqAhNxLesSuGfDzYe6HdexXtHuxe85umshfPHfnmLSkGWl/FE27+|v+50mwY5XaNnCmo1VvGju4iTKxWoZTGgslUSc8KX197XWAXIpab8ESyg442if9Kr|vSOuu0fopwvvTOgHK8mkEWI4joU5G4/MQy+pnC5NIEVBP4HtGiTrAgEC", |
116 |
schmorp1539 => "MIHHAoHBByJzpVGUsXysX8w/+uuXRUCL9exhAixoHkaJU5lf4noJUtp9F0yr/5rb|hF8M9mSZJ+RlPyB+Zt37GPp1WQDO1+/2yZJX9kHE3+h5JCRoR8PKc2G+ts9jhM7r|CnTQ0z0b6s12Pusf+UhQPwLust4JAYE/LPuTK8yFiVx5L2a+aZhGMVlYN/12SEtY|jRl3lGXdZj9g8E2PzTQbA9CGy5dGIvz/ENTzTVleKuQ+80bzpVEPjZL9tv43Zc+l|MFLzxuE5uwIBAg==", |
117 |
schmorp2048 => "MIIBCAKCAQEAhR5Fn9h3Tgnc+q4o3CMkZtre3lLUyDT+1bf3aiVOt22JdDQndZLc|FeKz8AqliB3UIgNExc6oDtuG4znKPgklfOnHv/a9tl1AYQbV+QFM/E0jYl6oG8tF|Epgxezt1GCivvtu64ql0s213wr64QffNMt3hva8lNqK1PXfqp13PzzLzAVsfghrv|fMAX7/bYm1T5fAJdcah6FeZkKof+mqbs8HtRjfvrUF2npEM2WdupFu190vcwABnN|TTJheXCWv2BF2f9EEr61q3OUhSNWIThtZP+NKe2bACm1PebT0drAcaxKoMz9LjKr|y5onGs0TOuQ7JmhtZL45Zr4LwBcyTucLUwIBAg==", |
118 |
schmorp4096 => "MIICCAKCAgEA5WwA5lQg09YRYqc/JILCd2AfBmYBkF19wmCEJB8G3JhTxv8EGvYk|xyP2ecKVUvHTG8Xw/qpW8nRqzPIyV8QRf6YFYSf33Qnx2xYhcnqOumU3nfC0SNOL|/w2q1BA9BbHtW4574P+6hOQx9ftRtbtZ2HPKBMRcAKGjpYZiKopv0+UAM4NpEC2p|bfajp7pyVLeb/Aqm/oWP3L63wPlY1SDp+XRzrOAKB+/uLGqEwV0bBaxxGL29BpOp|O2z1ALGXiDCcLs9WTn9WqUhWDzUN6fahm53rd7zxwpFCb6K2YhaK0peG95jzSUJ8|aoL0KgWuC6v5+gPJHRu0HrQIdfAdN4VchqYOKE46uNNkQl8VJGu4RjYB7lFBpRwO|g2HCsGMo2X7BRmA1st66fh+JOd1smXMZG/2ozTOooL+ixcx4spNneg4aQerWl5cb|nWXKtPCp8yPzt/zoNzL3Fon2Ses3sNgMos0M/ZbnigScDxz84Ms6V/X8Z0L4m/qX|mL42dP40tgvmgqi6BdsBzcIWeHlEcIhmGcsEBxxKEg7gjb0OjjvatpUCJhmRrGjJ|LtMkBR68qr42OBMN/PBB4KPOWNUqTauXZajfCwYdbpvV24ZhtkcRdw1zisyARBSh|aTKW/GV8iLsUzlYN27LgVEwMwnWQaoecW6eOTNKGUURC3In6XZSvVzsCAQI=", |
119 |
schmorp8192 => "MIIECAKCBAEA/SAEbRSSLenVxoInHiltm/ztSwehGOhOiUKfzDcKlRBZHlCC9jBl|S/aeklM6Ucg8E6J2bnfoh6CAdnE/glQOn6CifhZr8X/rnlL9/eP+r9m+aiAw4l0D|MBd8BondbEqwTZthMmLtx0SslnevsFAZ1Cj8WgmUNaSPOukvJ1N7aQ98U+E99Pw3|VG8ANBydXqLqW2sogS8FtZoMbVywcQuaGmC7M6i3Akxe3CCSIpR/JkEZIytREBSC|CH+x3oW/w+wHzq3w8DGB9hqz1iMXqDMiPIMSdXC0DaIPokLnd7X8u6N14yCAco2h|P0gspD3J8pS2FpUY8ZTVjzbVCjhNNmTryBZAxHSWBuX4xYcCHUtfGlUe/IGLSVE1|xIdFpZUfvlvAJjVq0/TtDMg3r2JSXrhQVlr8MPJwSApDVr5kOBHT/uABio4z+5yR|PAvundznfyo9GGAWhIA36GQqsxSQfoRTjWssFoR/cu+9aomRwwOLkvObu8nCVVLH|nLdKDk5cIR0TvNs9HZ6ZmkzL7ah7cPzEKl7U6eE6yZLVYMNecnPLS6PSAIG4gxcq|CVQrrZjQLfTDrJn0OGgpShX85RaDsuiRtp2bpDZ23YDqdwr4wRjvIargjqc2zcF+|jIb7dUS6ci7bVG/CGOQUuiMWAiXZ3a1f343SMf9A05/sf1xwnMeco6STBLZ3X+PA|4urU+grtpWaFtS/fPD2ILn8nrJ3WuSKKUeSnVM46mmJQsOkyn7z8l3jNLB17GYKo|qc+0UuU/2PM9qtZdZElSM/ACLV2vdCuaibop4B9UIP9z3F8kfZ72+zKxpGiE+Bo1|x8SfG8FQw90mYIx+qZzJ8MCvc2wh+l4wDX5KxrhwvcouE2tHQlwfDgv/DiIXp173|hAmUCV0+bPRW8IIJvBODdAWtJe9hNwxj1FFYmPA7l4wa3gXV4I6tb+iO1MbwVjZ/|116tD5MdCo3JuSisgPYCHfkQccwEO0FHEuBbmfN+fQimQ8H0dePP8XctwbkplsB+|aLT5hYKmva/j9smEswgyHglPwc3WvZ+2DgKk7A7DHi7a2gDwCRQlHaXtNWx3992R|dfNgkSeB1CvGSQoo95WpC9ZoqGmcSlVqdetDU8iglPmfYTKO8aIPA6TuTQ/lQ0IW|90LQmqP23FwnNFiyqX8+rztLq4KVkTyeHIQwig6vFxgD8N+SbZCW2PPiB72TVF2U|WePU8MRTv1OIGBUBajF49k28HnZPSGlILHtFEkYkbPvomcE5ENnoejwzjktOTS5d|/R3SIOvCauOzadtzwTYOXT78ORaR1KI1cm8DzkkwJTd/Rrk07Q5vnvnSJQMwFUeH|PwJIgWBQf/GZ/OsDHmkbYR2ZWDClbKw2mwIBAg==", |
120 |
); |
121 |
|
122 |
=item $tls = new AnyEvent::TLS key => value... |
123 |
|
124 |
The constructor supports these arguments (all as key => value pairs). |
125 |
|
126 |
=over 4 |
127 |
|
128 |
=item method => "SSLv2" | "SSLv3" | "TLSv1" | "any" |
129 |
|
130 |
The protocol parser to use. C<SSLv2>, C<SSLv3> and C<TLSv1> will use |
131 |
a parser for those protocols only (so will I<not> accept or create |
132 |
connections with/to other protocol versions), while C<any> (the |
133 |
default) uses a parser capable of all three protocols. |
134 |
|
135 |
The default is to use C<"any"> but disable SSLv2. This has the effect of |
136 |
sending a SSLv2 hello, indicating the support for SSLv3 and TLSv1, but not |
137 |
actually negotiating an (insecure) SSLv2 connection. |
138 |
|
139 |
Specifying a specific version is almost always wrong to use for a server |
140 |
speaking to a wide variety of clients (e.g. web browsers), and often wrong |
141 |
for a client. If you only want to allow a specific protocol version, use |
142 |
the C<sslv2>, C<sslv3> or C<tlsv1> arguments instead. |
143 |
|
144 |
For new services it is usually a good idea to enforce a C<TLSv1> method |
145 |
from the beginning. |
146 |
|
147 |
=item sslv2 => $enabled |
148 |
|
149 |
Enable or disable SSLv2 (normally I<disabled>). |
150 |
|
151 |
=item sslv3 => $enabled |
152 |
|
153 |
Enable or disable SSLv3 (normally I<enabled>). |
154 |
|
155 |
=item tlsv1 => $enabled |
156 |
|
157 |
Enable or disable TLSv1 (normally I<enabled>). |
158 |
|
159 |
=item verify => $enable |
160 |
|
161 |
Enable or disable peer certificate checking (default is I<disabled>, which |
162 |
is I<not recommended>). |
163 |
|
164 |
This is the "master switch" for all verify-related parameters and |
165 |
functions. |
166 |
|
167 |
If it is disabled, then no peer certificate verification will be done |
168 |
- the connection will be encrypted, but the peer certificate won't be |
169 |
verified against any known CAs, or whether it is still valid or not. No |
170 |
peername verification or custom verification will be done either. |
171 |
|
172 |
If enabled, then the peer certificate (required in client mode, optional |
173 |
in server mode, see C<verify_require_client_cert>) will be checked against |
174 |
its CA certificate chain - that means there must be a signing chain from |
175 |
the peer certificate to any of the CA certificates you trust locally, as |
176 |
specified by the C<ca_file> and/or C<ca_path> and/or C<ca_cert> parameters |
177 |
(or the system default CA repository, if all of those parameters are |
178 |
missing - see also the L<AnyEvent> manpage for the description of |
179 |
PERL_ANYEVENT_CA_FILE). |
180 |
|
181 |
Other basic checks, such as checking the validity period, will also be |
182 |
done, as well as optional peername/hostname/common name verification |
183 |
C<verify_peername>. |
184 |
|
185 |
An optional C<verify_cb> callback can also be set, which will be invoked |
186 |
with the verification results, and which can override the decision. |
187 |
|
188 |
=item verify_require_client_cert => $enable |
189 |
|
190 |
Enable or disable mandatory client certificates (default is |
191 |
I<disabled>). When this mode is enabled, then a client certificate will be |
192 |
required in server mode (a server certificate is mandatory, so in client |
193 |
mode, this switch has no effect). |
194 |
|
195 |
=item verify_peername => $scheme | $callback->($tls, $cert, $peername) |
196 |
|
197 |
TLS only protects the data that is sent - it cannot automatically verify |
198 |
that you are really talking to the right peer. The reason is that |
199 |
certificates contain a "common name" (and a set of possible alternative |
200 |
"names") that need to be checked against the peername (usually, but not |
201 |
always, the DNS name of the server) in a protocol-dependent way. |
202 |
|
203 |
This can be implemented by specifying a callback that has to verify that |
204 |
the actual C<$peername> matches the given certificate in C<$cert>. |
205 |
|
206 |
Since this can be rather hard to implement, AnyEvent::TLS offers a variety |
207 |
of predefined "schemes" (lifted from L<IO::Socket::SSL>) that are named |
208 |
like the protocols that use them: |
209 |
|
210 |
=over 4 |
211 |
|
212 |
=item ldap (rfc4513), pop3,imap,acap (rfc2995), nntp (rfc4642) |
213 |
|
214 |
Simple wildcards in subjectAltNames are possible, e.g. *.example.org |
215 |
matches www.example.org but not lala.www.example.org. If nothing from |
216 |
subjectAltNames matches, it checks against the common name, but there are |
217 |
no wildcards allowed. |
218 |
|
219 |
=item http (rfc2818) |
220 |
|
221 |
Extended wildcards in subjectAltNames are possible, e.g. *.example.org or |
222 |
even www*.example.org. Wildcards in the common name are not allowed. The |
223 |
common name will be only checked if no host names are given in |
224 |
subjectAltNames. |
225 |
|
226 |
=item smtp (rfc3207) |
227 |
|
228 |
This RFC isn't very useful in determining how to do verification so it |
229 |
just assumes that subjectAltNames are possible, but no wildcards are |
230 |
possible anywhere. |
231 |
|
232 |
=item [$check_cn, $wildcards_in_alt, $wildcards_in_cn] |
233 |
|
234 |
You can also specify a scheme yourself by using an array reference with |
235 |
three integers. |
236 |
|
237 |
C<$check_cn> specifies if and how the common name field is used: C<0> |
238 |
means it will be completely ignored, C<1> means it will only be used if |
239 |
no host names have been found in the subjectAltNames, and C<2> means the |
240 |
common name will always be checked against the peername. |
241 |
|
242 |
C<$wildcards_in_alt> and C<$wildcards_in_cn> specify whether and where |
243 |
wildcards (C<*>) are allowed in subjectAltNames and the common name, |
244 |
respectively. C<0> means no wildcards are allowed, C<1> means they |
245 |
are allowed only as the first component (C<*.example.org>), and C<2> |
246 |
means they can be used anywhere (C<www*.example.org>), except that very |
247 |
dangerous matches will not be allowed (C<*.org> or C<*>). |
248 |
|
249 |
=back |
250 |
|
251 |
You can specify either the name of the parent protocol (recommended, |
252 |
e.g. C<http>, C<ldap>), the protocol name as usually used in URIs |
253 |
(e.g. C<https>, C<ldaps>) or the RFC (not recommended, e.g. C<rfc2995>, |
254 |
C<rfc3920>). |
255 |
|
256 |
This verification will only be done when verification is enabled (C<< |
257 |
verify => 1 >>). |
258 |
|
259 |
=item verify_cb => $callback->($tls, $ref, $cn, $depth, $preverify_ok, $x509_store_ctx, $cert) |
260 |
|
261 |
Provide a custom peer verification callback used by TLS sessions, |
262 |
which is called with the result of any other verification (C<verify>, |
263 |
C<verify_peername>). |
264 |
|
265 |
This callback will only be called when verification is enabled (C<< verify |
266 |
=> 1 >>). |
267 |
|
268 |
C<$tls> is the C<AnyEvent::TLS> object associated with the session, |
269 |
while C<$ref> is whatever the user associated with the session (usually |
270 |
an L<AnyEvent::Handle> object when used by AnyEvent::Handle). |
271 |
|
272 |
C<$depth> is the current verification depth - C<$depth = 0> means the |
273 |
certificate to verify is the peer certificate, higher levels are its CA |
274 |
certificate and so on. In most cases, you can just return C<$preverify_ok> |
275 |
if the C<$depth> is non-zero: |
276 |
|
277 |
verify_cb => sub { |
278 |
my ($tls, $ref, $cn, $depth, $preverify_ok, $x509_store_ctx, $cert) = @_; |
279 |
|
280 |
return $preverify_ok |
281 |
if $depth; |
282 |
|
283 |
# more verification |
284 |
}, |
285 |
|
286 |
C<$preverify_ok> is true iff the basic verification of the certificates |
287 |
was successful (a valid CA chain must exist, the certificate has passed |
288 |
basic validity checks, peername verification succeeded). |
289 |
|
290 |
C<$x509_store_ctx> is the Net::SSLeay::X509_CTX> object. |
291 |
|
292 |
C<$cert> is the C<Net::SSLeay::X509> object representing the |
293 |
peer certificate, or zero if there was an error. You can call |
294 |
C<AnyEvent::TLS::certname $cert> to get a nice user-readable string to |
295 |
identify the certificate. |
296 |
|
297 |
The callback must return either C<0> to indicate failure, or C<1> to |
298 |
indicate success. |
299 |
|
300 |
=item verify_client_once => $enable |
301 |
|
302 |
Enable or disable skipping the client certificate verification on |
303 |
renegotiations (default is I<disabled>, the certificate will always be |
304 |
checked). Only makes sense in server mode. |
305 |
|
306 |
=item ca_file => $path |
307 |
|
308 |
If this parameter is specified and non-empty, it will be the path to a |
309 |
file with (server) CA certificates in PEM format that will be loaded. Each |
310 |
certificate will look like: |
311 |
|
312 |
-----BEGIN CERTIFICATE----- |
313 |
... (CA certificate in base64 encoding) ... |
314 |
-----END CERTIFICATE----- |
315 |
|
316 |
You have to enable verify mode (C<< verify => 1 >>) for this parameter to |
317 |
have any effect. |
318 |
|
319 |
=item ca_path => $path |
320 |
|
321 |
If this parameter is specified and non-empty, it will be |
322 |
the path to a directory with hashed CA certificate files in |
323 |
PEM format. When the ca certificate is being verified, the |
324 |
certificate will be hashed and looked up in that directory (see |
325 |
L<http://www.openssl.org/docs/ssl/SSL_CTX_load_verify_locations.html> for |
326 |
details) |
327 |
|
328 |
The certificates specified via C<ca_file> take precedence over the ones |
329 |
found in C<ca_path>. |
330 |
|
331 |
You have to enable verify mode (C<< verify => 1 >>) for this parameter to |
332 |
have any effect. |
333 |
|
334 |
=item ca_cert => $string |
335 |
|
336 |
In addition or instead of using C<ca_file> and/or C<ca_path>, you can |
337 |
also use C<ca_cert> to directly specify the CA certificates (there can be |
338 |
multiple) in PEM format, in a string. |
339 |
|
340 |
=item check_crl => $enable |
341 |
|
342 |
Enable or disable certificate revocation list checking. If enabled, then |
343 |
peer certificates will be checked against a list of revoked certificates |
344 |
issued by the CA. The revocation lists will be expected in the C<ca_path> |
345 |
directory. |
346 |
|
347 |
certificate verification will fail if this is enabled but no revocation |
348 |
list was found. |
349 |
|
350 |
This requires OpenSSL >= 0.9.7b. Check the OpenSSL documentation for more |
351 |
details. |
352 |
|
353 |
=item key_file => $path |
354 |
|
355 |
Path to the local private key file in PEM format (might be a combined |
356 |
certificate/private key file). |
357 |
|
358 |
The local certificate is used to authenticate against the peer - servers |
359 |
mandatorily need a certificate and key, clients can use a certificate and |
360 |
key optionally to authenticate, e.g. for log-in purposes. |
361 |
|
362 |
The key in the file should look similar this: |
363 |
|
364 |
-----BEGIN RSA PRIVATE KEY----- |
365 |
...header data |
366 |
... (key data in base64 encoding) ... |
367 |
-----END RSA PRIVATE KEY----- |
368 |
|
369 |
=item key => $string |
370 |
|
371 |
The private key string in PEM format (see C<key_file>, only one of |
372 |
C<key_file> or C<key> can be specified). |
373 |
|
374 |
The idea behind being able to specify a string is to avoid blocking in |
375 |
I/O. Unfortunately, Net::SSLeay fails to implement any interface to the |
376 |
needed OpenSSL functionality, this is currently implemented by writing to |
377 |
a temporary file. |
378 |
|
379 |
=item cert_file => $path |
380 |
|
381 |
The path to the local certificate file in PEM format (might be a combined |
382 |
certificate/private key file, including chained certificates). |
383 |
|
384 |
The local certificate (and key) are used to authenticate against the |
385 |
peer - servers mandatorily need a certificate and key, clients can use |
386 |
certificate and key optionally to authenticate, e.g. for log-in purposes. |
387 |
|
388 |
The certificate in the file should look like this: |
389 |
|
390 |
-----BEGIN CERTIFICATE----- |
391 |
... (certificate in base64 encoding) ... |
392 |
-----END CERTIFICATE----- |
393 |
|
394 |
If the certificate file or string contain both the certificate and |
395 |
private key, then there is no need to specify a separate C<key_file> or |
396 |
C<key>. |
397 |
|
398 |
Additional signing certifiates to send to the peer (in SSLv3 and newer) |
399 |
can be specified by appending them to the certificate proper: the order |
400 |
must be from issuer certificate over any intermediate CA certificates to |
401 |
the root CA. |
402 |
|
403 |
So the recommended ordering for a combined key/cert/chain file, specified |
404 |
via C<cert_file> or C<cert> looks like this: |
405 |
|
406 |
certificate private key |
407 |
client/server certificate |
408 |
ca 1, signing client/server certficate |
409 |
ca 2, signing ca 1 |
410 |
... |
411 |
|
412 |
=item cert => $string |
413 |
|
414 |
The local certificate in PEM format (might be a combined |
415 |
certificate/private key file). See C<cert_file>. |
416 |
|
417 |
The idea behind being able to specify a string is to avoid blocking in |
418 |
I/O. Unfortunately, Net::SSLeay fails to implement any interface to the |
419 |
needed OpenSSL functionality, this is currently implemented by writing to |
420 |
a temporary file. |
421 |
|
422 |
=item cert_password => $string | $callback->($tls) |
423 |
|
424 |
The certificate password - if the certificate is password-protected, then |
425 |
you can specify its password here. |
426 |
|
427 |
Instead of providing a password directly (which is not so recommended), |
428 |
you can also provide a password-query callback. The callback will be |
429 |
called whenever a password is required to decode a local certificate, and |
430 |
is supposed to return the password. |
431 |
|
432 |
=item dh_file => $path |
433 |
|
434 |
Path to a file containing Diffie-Hellman parameters in PEM format, for |
435 |
use in servers. See also C<dh> on how to specify them directly, or use a |
436 |
pre-generated set. |
437 |
|
438 |
Diffie-Hellman key exchange generates temporary encryption keys that |
439 |
are not transferred over the connection, which means that even if the |
440 |
certificate key(s) are made public at a later time and a full dump of the |
441 |
connection exists, the key still cannot be deduced. |
442 |
|
443 |
These ciphers are only available with SSLv3 and later (which is the |
444 |
default with AnyEvent::TLS), and are only used in server/accept |
445 |
mode. Anonymous DH protocols are usually disabled by default, and usually |
446 |
not even compiled into the underlying library, as they provide no direct |
447 |
protection against man-in-the-middle attacks. The same is true for the |
448 |
common practise of self-signed certificates that you have to accept first, |
449 |
of course. |
450 |
|
451 |
=item dh => $string |
452 |
|
453 |
Specify the Diffie-Hellman parameters in PEM format directly as a string |
454 |
(see C<dh_file>), the default is C<schmorp1539> unless C<dh_file> was |
455 |
specified. |
456 |
|
457 |
AnyEvent::TLS supports supports a number of precomputed DH parameters, |
458 |
since computing them is expensive. They are: |
459 |
|
460 |
# from "Assigned Number for SKIP Protocols" |
461 |
skip512, skip1024, skip2048, skip4096 |
462 |
|
463 |
# from schmorp |
464 |
schmorp1024, schmorp1539, schmorp2048, schmorp4096, schmorp8192 |
465 |
|
466 |
The default was chosen as a trade-off between security and speed, and |
467 |
should be secure for a few years. It is said that 2048 bit DH parameters |
468 |
are safe till 2030, and DH parameters shorter than 900 bits are totally |
469 |
insecure. |
470 |
|
471 |
To disable DH protocols completely, specify C<undef> as C<dh> parameter. |
472 |
|
473 |
=item dh_single_use => $enable |
474 |
|
475 |
Enables or disables "use only once" mode when using Diffie-Hellman key |
476 |
exchange. When enabled (default), each time a new key is exchanged a new |
477 |
Diffie-Hellman key is generated, which improves security as each key is |
478 |
only used once. When disabled, the key will be created as soon as the |
479 |
AnyEvent::TLS object is created and will be reused. |
480 |
|
481 |
All the DH parameters supplied with AnyEvent::TLS should be safe with |
482 |
C<dh_single_use> switched off, but YMMV. |
483 |
|
484 |
=item cipher_list => $string |
485 |
|
486 |
The list of ciphers to use, as a string (example: |
487 |
C<AES:ALL:!aNULL:!eNULL:+RC4:@STRENGTH>). The format |
488 |
of this string and its default value is documented at |
489 |
L<http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS>. |
490 |
|
491 |
=item session_ticket => $enable |
492 |
|
493 |
Enables or disables RC5077 support (Session Resumption without Server-Side |
494 |
State). The default is disabled for clients, as many (buggy) TLS/SSL |
495 |
servers choke on it, but enabled for servers. |
496 |
|
497 |
When enabled and supported by the server, a session ticket will be |
498 |
provided to the client, which allows fast resuming of connections. |
499 |
|
500 |
=item prepare => $coderef->($tls) |
501 |
|
502 |
If this argument is present, then it will be called with the new |
503 |
AnyEvent::TLS object after any other initialisation has bee done, in case |
504 |
you wish to fine-tune something... |
505 |
|
506 |
=cut |
507 |
|
508 |
#=item trust => $trust |
509 |
# |
510 |
#Sets the expected (root) certificate use on this context, i.e. what |
511 |
#certificates to trust. The default is C<compat>, and the following strings |
512 |
#are supported: |
513 |
# |
514 |
# compat any certifictae will do |
515 |
# ssl_client only trust client certificates |
516 |
# ssl_server only trust server certificates |
517 |
# email only trust e-mail certificates |
518 |
# object_sign only trust signing (CA) certificates |
519 |
# ocsp_sign only trust ocsp signing certs |
520 |
# ocsp_request only trust ocsp request certs |
521 |
|
522 |
# purpose? |
523 |
|
524 |
#TODO |
525 |
# verify_depth? |
526 |
# reuse_ctx |
527 |
# session_cache_size |
528 |
# session_cache |
529 |
|
530 |
#=item debug => $level |
531 |
# |
532 |
#Enable or disable sending debugging output to STDERR. This is, as |
533 |
#the name says, mostly for debugging. The default is taken from the |
534 |
#C<PERL_ANYEVENT_TLS_DEBUG> environment variable. |
535 |
# |
536 |
#=cut |
537 |
|
538 |
=back |
539 |
|
540 |
=cut |
541 |
|
542 |
sub init (); |
543 |
|
544 |
#our %X509_TRUST = ( |
545 |
# compat => 1, |
546 |
# ssl_client => 2, |
547 |
# ssl_server => 3, |
548 |
# email => 4, |
549 |
# object_sign => 5, |
550 |
# ocsp_sign => 6, |
551 |
# ocsp_request => 7, |
552 |
#); |
553 |
|
554 |
sub new { |
555 |
my ($class, %arg) = @_; |
556 |
|
557 |
init unless $REF_IDX; |
558 |
|
559 |
my $method = lc $arg{method} || "any"; |
560 |
|
561 |
my $ctx = $method eq "any" ? Net::SSLeay::CTX_new () |
562 |
: $method eq "sslv23" ? Net::SSLeay::CTX_new () # deliberately undocumented |
563 |
: $method eq "sslv2" ? Net::SSLeay::CTX_v2_new () |
564 |
: $method eq "sslv3" ? Net::SSLeay::CTX_v3_new () |
565 |
: $method eq "tlsv1" ? Net::SSLeay::CTX_tlsv1_new () |
566 |
: croak "'$method' is not a valid AnyEvent::TLS method (must be one of SSLv2, SSLv3, TLSv1 or any)"; |
567 |
|
568 |
my $self = bless { ctx => $ctx }, $class; # to make sure it's destroyed if we croak |
569 |
|
570 |
my $op = Net::SSLeay::OP_ALL (); |
571 |
|
572 |
$op |= Net::SSLeay::OP_NO_SSLv2 () unless $arg{sslv2}; |
573 |
$op |= Net::SSLeay::OP_NO_SSLv3 () if exists $arg{sslv3} && !$arg{sslv3}; |
574 |
$op |= Net::SSLeay::OP_NO_TLSv1 () if exists $arg{tlsv1} && !$arg{tlsv1}; |
575 |
$op |= Net::SSLeay::OP_SINGLE_DH_USE () if !exists $arg{dh_single_use} || $arg{dh_single_use}; |
576 |
|
577 |
Net::SSLeay::CTX_set_options ($ctx, $op); |
578 |
|
579 |
Net::SSLeay::CTX_set_cipher_list ($ctx, $arg{cipher_list}) |
580 |
or croak "'$arg{cipher_list}' was not accepted as a valid cipher list by AnyEvent::TLS" |
581 |
if exists $arg{cipher_list}; |
582 |
|
583 |
my ($dh_bio, $dh_file); |
584 |
|
585 |
if (exists $arg{dh_file}) { |
586 |
croak |
587 |
|
588 |
$dh_file = $arg{dh_file}; |
589 |
|
590 |
$dh_bio = Net::SSLeay::BIO_new_file ($dh_file, "r") |
591 |
or croak "$dh_file: failed to open DH parameter file: $!"; |
592 |
} else { |
593 |
$arg{dh} = "schmorp1539" unless exists $arg{dh}; |
594 |
|
595 |
if (defined $arg{dh}) { |
596 |
$dh_file = "dh string"; |
597 |
|
598 |
if ($arg{dh} =~ /^\w+$/) { |
599 |
$dh_file = "dh params $arg{dh}"; |
600 |
$arg{dh} = "-----BEGIN DH PARAMETERS-----\n" |
601 |
. $DH_PARAMS{$arg{dh}} . "\n" |
602 |
. "-----END DH PARAMETERS-----"; |
603 |
$arg{dh} =~ s/\|/\n/g; |
604 |
} |
605 |
|
606 |
$dh_bio = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); |
607 |
Net::SSLeay::BIO_write ($dh_bio, $arg{dh}); |
608 |
} |
609 |
} |
610 |
|
611 |
if ($dh_bio) { |
612 |
my $dh = Net::SSLeay::PEM_read_bio_DHparams ($dh_bio); |
613 |
Net::SSLeay::BIO_free ($dh_bio); |
614 |
$dh or croak "$dh_file: failed to parse DH parameters - not PEM format?"; |
615 |
my $rv = Net::SSLeay::CTX_set_tmp_dh ($ctx, $dh); |
616 |
Net::SSLeay::DH_free ($dh); |
617 |
$rv or croak "$dh_file: failed to set DH parameters"; |
618 |
} |
619 |
|
620 |
if ($arg{verify}) { |
621 |
$self->{verify_mode} = Net::SSLeay::VERIFY_PEER (); |
622 |
|
623 |
$self->{verify_mode} |= Net::SSLeay::VERIFY_FAIL_IF_NO_PEER_CERT () |
624 |
if $arg{verify_require_client_cert}; |
625 |
|
626 |
$self->{verify_mode} |= Net::SSLeay::VERIFY_CLIENT_ONCE () |
627 |
if $arg{verify_client_once}; |
628 |
|
629 |
} else { |
630 |
$self->{verify_mode} = Net::SSLeay::VERIFY_NONE (); |
631 |
} |
632 |
|
633 |
$self->{verify_peername} = $arg{verify_peername} |
634 |
if exists $arg{verify_peername}; |
635 |
|
636 |
$self->{verify_cb} = $arg{verify_cb} |
637 |
if exists $arg{verify_cb}; |
638 |
|
639 |
$self->{session_ticket} = $arg{session_ticket} |
640 |
if exists $arg{session_ticket}; |
641 |
|
642 |
$self->{debug} = $ENV{PERL_ANYEVENT_TLS_DEBUG} |
643 |
if exists $ENV{PERL_ANYEVENT_TLS_DEBUG}; |
644 |
|
645 |
$self->{debug} = $arg{debug} |
646 |
if exists $arg{debug}; |
647 |
|
648 |
my $pw = $arg{cert_password}; |
649 |
Net::SSLeay::CTX_set_default_passwd_cb ($ctx, ref $pw ? $pw : sub { $pw }); |
650 |
|
651 |
if ($self->{verify_mode}) { |
652 |
if (exists $arg{ca_file} or exists $arg{ca_path} or exists $arg{ca_cert}) { |
653 |
# either specified: use them |
654 |
if (exists $arg{ca_cert}) { |
655 |
my ($ca_file, $g1) = _tmpfile delete $arg{ca_cert}; |
656 |
Net::SSLeay::CTX_load_verify_locations ($ctx, $ca_file, undef); |
657 |
} |
658 |
if (exists $arg{ca_file} or exists $arg{ca_path}) { |
659 |
Net::SSLeay::CTX_load_verify_locations ($ctx, $arg{ca_file}, $arg{ca_path}); |
660 |
} |
661 |
} elsif (exists $ENV{PERL_ANYEVENT_CA_FILE} or exists $ENV{PERL_ANYEVENT_CA_PATH}) { |
662 |
Net::SSLeay::CTX_load_verify_locations ( |
663 |
$ctx, |
664 |
$ENV{PERL_ANYEVENT_CA_FILE}, |
665 |
$ENV{PERL_ANYEVENT_CA_PATH}, |
666 |
); |
667 |
} else { |
668 |
# else fall back to defaults |
669 |
Net::SSLeay::CTX_set_default_verify_paths ($ctx); |
670 |
} |
671 |
} |
672 |
|
673 |
if (exists $arg{cert} or exists $arg{cert_file}) { |
674 |
my ($g1, $g2); |
675 |
|
676 |
if (exists $arg{cert}) { |
677 |
croak "specifying both cert_file and cert is not allowed" |
678 |
if exists $arg{cert_file}; |
679 |
|
680 |
($arg{cert_file}, $g1) = _tmpfile delete $arg{cert}; |
681 |
} |
682 |
|
683 |
if (exists $arg{key} or exists $arg{key_file}) { |
684 |
if (exists $arg{key}) { |
685 |
croak "specifying both key_file and key is not allowed" |
686 |
if exists $arg{cert_file}; |
687 |
($arg{key_file}, $g2) = _tmpfile delete $arg{key}; |
688 |
} |
689 |
} else { |
690 |
$arg{key_file} = $arg{cert_file}; |
691 |
} |
692 |
|
693 |
Net::SSLeay::CTX_use_PrivateKey_file |
694 |
($ctx, $arg{key_file}, Net::SSLeay::FILETYPE_PEM ()) |
695 |
or croak "$arg{key_file}: failed to load local private key (key_file or key)"; |
696 |
|
697 |
Net::SSLeay::CTX_use_certificate_chain_file ($ctx, $arg{cert_file}) |
698 |
or croak "$arg{cert_file}: failed to use local certificate chain (cert_file or cert)"; |
699 |
} |
700 |
|
701 |
if ($arg{check_crl}) { |
702 |
Net::SSLeay::OPENSSL_VERSION_NUMBER () >= 0x00090702f |
703 |
or croak "check_crl requires openssl v0.9.7b or higher"; |
704 |
|
705 |
Net::SSLeay::X509_STORE_set_flags ( |
706 |
Net::SSLeay::CTX_get_cert_store ($ctx), |
707 |
Net::SSLeay::X509_V_FLAG_CRL_CHECK ()); |
708 |
} |
709 |
|
710 |
Net::SSLeay::CTX_set_read_ahead ($ctx, 1); |
711 |
|
712 |
$arg{prepare}->($self) |
713 |
if $arg{prepare}; |
714 |
|
715 |
$self |
716 |
} |
717 |
|
718 |
=item $tls = new_from_ssleay AnyEvent::TLS $ctx |
719 |
|
720 |
This constructor takes an existing L<Net::SSLeay> SSL_CTX object |
721 |
(which is just an integer) and converts it into an C<AnyEvent::TLS> |
722 |
object. This only works because AnyEvent::TLS is currently implemented |
723 |
using Net::SSLeay. As this is such a horrible perl module and OpenSSL has |
724 |
such an annoying license, this might change in the future, in which case |
725 |
this method might vanish. |
726 |
|
727 |
=cut |
728 |
|
729 |
sub new_from_ssleay { |
730 |
my ($class, $ctx) = @_; |
731 |
|
732 |
bless { ctx => $ctx }, $class |
733 |
} |
734 |
|
735 |
=item $ctx = $tls->ctx |
736 |
|
737 |
Returns the actual L<Net::SSLeay::CTX> object (just an integer). |
738 |
|
739 |
=cut |
740 |
|
741 |
sub ctx { |
742 |
$_[0]{ctx} |
743 |
} |
744 |
|
745 |
sub verify_hostname($$$); |
746 |
|
747 |
sub _verify_hostname { |
748 |
my ($self, $cn, $cert) = @_; |
749 |
|
750 |
return 1 |
751 |
unless defined $cn; |
752 |
|
753 |
return 1 |
754 |
unless exists $self->{verify_peername} && "none" ne lc $self->{verify_peername}; |
755 |
|
756 |
return $self->{verify_peername}->($self, $cn, $cert) |
757 |
if ref $self->{verify_peername} && "ARRAY" ne ref $self->{verify_peername}; |
758 |
|
759 |
verify_hostname $cn, $cert, $self->{verify_peername} |
760 |
} |
761 |
|
762 |
sub verify { |
763 |
my ($self, $session, $ref, $cn, $preverify_ok, $x509_store_ctx) = @_; |
764 |
|
765 |
my $cert = $x509_store_ctx |
766 |
? Net::SSLeay::X509_STORE_CTX_get_current_cert ($x509_store_ctx) |
767 |
: undef; |
768 |
my $depth = Net::SSLeay::X509_STORE_CTX_get_error_depth ($x509_store_ctx); |
769 |
|
770 |
$preverify_ok &&= $self->_verify_hostname ($cn, $cert) |
771 |
unless $depth; |
772 |
|
773 |
$preverify_ok = $self->{verify_cb}->($self, $ref, $cn, $depth, $preverify_ok, $x509_store_ctx, $cert) |
774 |
if $self->{verify_cb}; |
775 |
|
776 |
$preverify_ok |
777 |
} |
778 |
|
779 |
#=item $ssl = $tls->_get_session ($mode[, $ref]) |
780 |
# |
781 |
#Creates a new Net::SSLeay::SSL session object, puts it into C<$mode> |
782 |
#(C<accept> or C<connect>) and optionally associates it with the given |
783 |
#C<$ref>. If C<$mode> is already a C<Net::SSLeay::SSL> object, then just |
784 |
#associate data with it. |
785 |
# |
786 |
#=cut |
787 |
|
788 |
#our %REF_MAP; |
789 |
|
790 |
sub _get_session($$;$$) { |
791 |
my ($self, $mode, $ref, $cn) = @_; |
792 |
|
793 |
my $session; |
794 |
|
795 |
if ($mode eq "accept") { |
796 |
$session = Net::SSLeay::new ($self->{ctx}); |
797 |
Net::SSLeay::set_accept_state ($session); |
798 |
|
799 |
Net::SSLeay::set_options ($session, eval { Net::SSLeay::OP_NO_TICKET () }) |
800 |
unless $self->{session_ticket} || !exists $self->{session_ticket}; |
801 |
|
802 |
} elsif ($mode eq "connect") { |
803 |
$session = Net::SSLeay::new ($self->{ctx}); |
804 |
Net::SSLeay::set_connect_state ($session); |
805 |
|
806 |
Net::SSLeay::set_options ($session, eval { Net::SSLeay::OP_NO_TICKET () }) |
807 |
unless $self->{session_ticket}; |
808 |
} else { |
809 |
croak "'$mode': unsupported TLS mode (must be either 'connect' or 'accept')" |
810 |
} |
811 |
|
812 |
# # associate data |
813 |
# Net::SSLeay::set_ex_data ($session, $REF_IDX, $ref+0); |
814 |
# Scalar::Util::weaken ($REF_MAP{$ref+0} = $ref) |
815 |
# if ref $ref; |
816 |
|
817 |
if ($self->{debug}) { |
818 |
#d# Net::SSLeay::set_info_callback ($session, 50000); |
819 |
} |
820 |
|
821 |
if ($self->{verify_mode}) { |
822 |
Scalar::Util::weaken $self; |
823 |
Scalar::Util::weaken $ref; |
824 |
|
825 |
# we have to provide a dummy callbacks as at least Net::SSLeay <= 1.35 |
826 |
# try to call it even if specified as 0 or undef. |
827 |
Net::SSLeay::set_verify |
828 |
$session, |
829 |
$self->{verify_mode}, |
830 |
sub { $self->verify ($session, $ref, $cn, @_) }; |
831 |
} |
832 |
|
833 |
$session |
834 |
} |
835 |
|
836 |
sub _put_session($$) { |
837 |
my ($self, $session) = @_; |
838 |
|
839 |
# clear callback, if any |
840 |
# this leaks memoryin Net::SSLeay up to at least 1.35, but there |
841 |
# apparently is no other way. |
842 |
Net::SSLeay::set_verify $session, 0, undef; |
843 |
|
844 |
# # disassociate data |
845 |
# delete $REF_MAP{Net::SSLeay::get_ex_data ($session, $REF_IDX)}; |
846 |
|
847 |
Net::SSLeay::free ($session); |
848 |
} |
849 |
|
850 |
#sub _ref($) { |
851 |
# $REF_MAP{Net::SSLeay::get_ex_data ($_[0], $REF_IDX)} |
852 |
#} |
853 |
|
854 |
sub DESTROY { |
855 |
my ($self) = @_; |
856 |
|
857 |
# better be safe than sorry with net-ssleay |
858 |
Net::SSLeay::CTX_set_default_passwd_cb ($self->{ctx}); |
859 |
|
860 |
Net::SSLeay::CTX_free ($self->{ctx}); |
861 |
} |
862 |
|
863 |
=item AnyEvent::TLS::init |
864 |
|
865 |
AnyEvent::TLS does on-demand initialisation, and normally there is no need to call an initialise |
866 |
function. |
867 |
|
868 |
As initialisation might take some time (to read e.g. C</dev/urandom>), this |
869 |
could be annoying in some highly interactive programs. In that case, you can |
870 |
call C<AnyEvent::TLS::init> to make sure there will be no costly initialisation |
871 |
later. It is harmless to call C<AnyEvent::TLS::init> multiple times. |
872 |
|
873 |
=cut |
874 |
|
875 |
sub init() { |
876 |
return if $REF_IDX; |
877 |
|
878 |
warn "AnyEvent::TLS: Net::SSLeay versions older than 1.33 might malfunction.\n" |
879 |
if $AnyEvent::VERBOSE && $Net::SSLeay::VERSION < 1.33; |
880 |
|
881 |
Net::SSLeay::load_error_strings (); |
882 |
Net::SSLeay::SSLeay_add_ssl_algorithms (); |
883 |
Net::SSLeay::randomize (); |
884 |
|
885 |
$REF_IDX = Net::SSLeay::get_ex_new_index (0, 0, 0, 0, 0) |
886 |
until $REF_IDX; # Net::SSLeay uses id #0 for it's own stuff without allocating it |
887 |
} |
888 |
|
889 |
=item $certname = AnyEvent::TLS::certname $x509 |
890 |
|
891 |
Utility function that returns a user-readable string identifying the X509 |
892 |
certificate object. |
893 |
|
894 |
=cut |
895 |
|
896 |
sub certname { |
897 |
$_[0] |
898 |
? Net::SSLeay::X509_NAME_oneline (Net::SSLeay::X509_get_issuer_name ($_[0])) |
899 |
. Net::SSLeay::X509_NAME_oneline (Net::SSLeay::X509_get_subject_name ($_[0])) |
900 |
: undef |
901 |
} |
902 |
|
903 |
our %CN_SCHEME = ( |
904 |
# each tuple is [$cn_wildcards, $alt_wildcards, $check_cn] |
905 |
# where *_wildcards is 0 for none allowed, 1 for allowed at beginning and 2 for allowed everywhere |
906 |
# and check_cn is 0 for do not check, 1 for check when no alternate dns names and 2 always |
907 |
# all of this is from IO::Socket::SSL |
908 |
|
909 |
rfc4513 => [0, 1, 2], |
910 |
rfc2818 => [0, 2, 1], |
911 |
rfc3207 => [0, 0, 2], # see IO::Socket::SSL, rfc seems unclear |
912 |
none => [], # do not check |
913 |
|
914 |
ldap => "rfc4513", ldaps => "ldap", |
915 |
http => "rfc2818", https => "http", |
916 |
smtp => "rfc3207", smtps => "smtp", |
917 |
|
918 |
xmpp => "rfc3920", rfc3920 => "http", |
919 |
pop3 => "rfc2595", rfc2595 => "ldap", pop3s => "pop3", |
920 |
imap => "rfc2595", rfc2595 => "ldap", imaps => "imap", |
921 |
acap => "rfc2595", rfc2595 => "ldap", |
922 |
nntp => "rfc4642", rfc4642 => "ldap", nntps => "nntp", |
923 |
ftp => "rfc4217", rfc4217 => "http", ftps => "ftp" , |
924 |
); |
925 |
|
926 |
sub match_cn($$$) { |
927 |
my ($name, $cn, $type) = @_; |
928 |
|
929 |
# remove leading and trailing garbage |
930 |
for ($name, $cn) { |
931 |
s/[\x00-\x1f]+$//; |
932 |
s/^[\x00-\x1f]+//; |
933 |
} |
934 |
|
935 |
my $pattern; |
936 |
|
937 |
### IMPORTANT! |
938 |
# we accept only a single wildcard and only for a single part of the FQDN |
939 |
# e.g *.example.org does match www.example.org but not bla.www.example.org |
940 |
# The RFCs are in this regard unspecific but we don't want to have to |
941 |
# deal with certificates like *.com, *.co.uk or even * |
942 |
# see also http://nils.toedtmann.net/pub/subjectAltName.txt |
943 |
if ($type == 2 and $name =~m{^([^.]*)\*(.+)} ) { |
944 |
$pattern = qr{^\Q$1\E[^.]*\Q$2\E$}i; |
945 |
} elsif ($type == 1 and $name =~m{^\*(\..+)$} ) { |
946 |
$pattern = qr{^[^.]*\Q$1\E$}i; |
947 |
} else { |
948 |
$pattern = qr{^\Q$name\E$}i; |
949 |
} |
950 |
|
951 |
$cn =~ $pattern |
952 |
} |
953 |
|
954 |
# taken verbatim from IO::Socket::SSL, then changed to take advantage of |
955 |
# AnyEvent utilities. |
956 |
sub verify_hostname($$$) { |
957 |
my ($cn, $cert, $scheme) = @_; |
958 |
|
959 |
while (!ref $scheme) { |
960 |
$scheme = $CN_SCHEME{$scheme} |
961 |
or return 1; |
962 |
} |
963 |
|
964 |
my $cert_cn = |
965 |
Net::SSLeay::X509_NAME_get_text_by_NID ( |
966 |
Net::SSLeay::X509_get_subject_name ($cert), Net::SSLeay::NID_commonName ()); |
967 |
|
968 |
my @cert_alt = Net::SSLeay::X509_get_subjectAltNames ($cert); |
969 |
|
970 |
# rfc2460 - convert to network byte order |
971 |
my $ip = AnyEvent::Socket::parse_address $cn; |
972 |
|
973 |
my $alt_dns_count; |
974 |
|
975 |
while (my ($type, $name) = splice @cert_alt, 0, 2) { |
976 |
if ($type == Net::SSLeay::GEN_IPADD ()) { |
977 |
# $name is already packed format (inet_xton) |
978 |
return 1 if $ip eq $name; |
979 |
} elsif ($type == Net::SSLeay::GEN_DNS ()) { |
980 |
$alt_dns_count++; |
981 |
|
982 |
return 1 if match_cn $name, $cn, $scheme->[1]; |
983 |
} |
984 |
} |
985 |
|
986 |
if ($scheme->[2] == 2 |
987 |
|| ($scheme->[2] == 1 && !$alt_dns_count)) { |
988 |
return 1 if match_cn $cert_cn, $cn, $scheme->[0]; |
989 |
} |
990 |
|
991 |
0 |
992 |
} |
993 |
|
994 |
=back |
995 |
|
996 |
=head1 SSL/TLS QUICK FACTS |
997 |
|
998 |
Here are some quick facts about TLS/SSL that might help you: |
999 |
|
1000 |
=over 4 |
1001 |
|
1002 |
=item * A certificate is the public key part, a key is the private key part. |
1003 |
|
1004 |
While not strictly true, certificates are the things you can hand around |
1005 |
publicly as a kind of identity, while keys should really be kept private, |
1006 |
as proving that you have the private key is usually interpreted as being |
1007 |
the entity behind the certificate. |
1008 |
|
1009 |
=item * A certificate is signed by a CA (Certificate Authority). |
1010 |
|
1011 |
By signing, the CA basically claims that the certificate it signs |
1012 |
really belongs to the identity named in it, verified according to the |
1013 |
CA policies. For e.g. HTTPS, the CA usually makes some checks that the |
1014 |
hostname mentioned in the certificate really belongs to the company/person |
1015 |
that requested the signing and owns the domain. |
1016 |
|
1017 |
=item * CAs can be certified by other CAs. |
1018 |
|
1019 |
Or by themselves - a certificate that is signed by a CA that is itself |
1020 |
is called a self-signed certificate, a trust chain of length zero. When |
1021 |
you find a certificate signed by another CA, which is in turn signed by |
1022 |
another CA you trust, you have a trust chain of depth two. |
1023 |
|
1024 |
=item * "Trusting" a CA means trusting all certificates it has signed. |
1025 |
|
1026 |
If you "trust" a CA certificate, then all certificates signed by it are |
1027 |
automatically considered trusted as well. |
1028 |
|
1029 |
=item * A successfully verified certificate means that you can be |
1030 |
reasonably sure that whoever you are talking with really is who he claims |
1031 |
he is. |
1032 |
|
1033 |
By verifying certificates against a number of CAs that you trust (meaning |
1034 |
it is signed directly or indirectly by such a CA), you can find out that |
1035 |
the other side really is whoever he claims, according to the CA policies, |
1036 |
and your belief in the integrity of the CA. |
1037 |
|
1038 |
=item * Verifying the certificate signature is not everything. |
1039 |
|
1040 |
Even when the certificate is correct, it might belong to somebody else: if |
1041 |
www.attacker.com can make your computer believe that it is really called |
1042 |
www.mybank.com (by making your DNS server believe this for example), |
1043 |
then it could send you the certificate for www.attacker.com that your |
1044 |
software trusts because it is signed by a CA you trust, and intercept |
1045 |
all your traffic that you think goes to www.mybank.com. This works |
1046 |
because your software sees that the certificate is correctly signed (for |
1047 |
www.attacker.com) and you think you are talking to your bank. |
1048 |
|
1049 |
To thwart this attack vector, peername verification should be used, which |
1050 |
basically checks that the certificate (for www.attacker.com) really |
1051 |
belongs to the host you are trying to talk to (www.mybank.com), which in |
1052 |
this example is not the case, as www.attacker.com (from the certificate) |
1053 |
doesn't match www.mybank.com (the hostname used to create the connection). |
1054 |
|
1055 |
So peername verification is almost as important as checking the CA |
1056 |
signing. Unfortunately, every protocol implements this differently, if at |
1057 |
all... |
1058 |
|
1059 |
=item * Switching off verification is sometimes reasonable. |
1060 |
|
1061 |
You can switch off verification. You still get an encrypted connection |
1062 |
that is protected against eavesdropping and injection - you just lose |
1063 |
protection against man in the middle attacks, i.e. somebody else with |
1064 |
enough abilities to to intercept all traffic can masquerade herself as the |
1065 |
other side. |
1066 |
|
1067 |
For many applications, switching off verification is entirely |
1068 |
reasonable. Downloading random stuff from websites using HTTPS for no |
1069 |
reason is such an application. Talking to your bank and entering TANs is |
1070 |
not such an application. |
1071 |
|
1072 |
=item * A SSL/TLS server always needs a certificate/key pair to operate, |
1073 |
for clients this is optional. |
1074 |
|
1075 |
Apart from (usually disabled) anonymous cipher suites, a server always |
1076 |
needs a certificate/key pair to operate. |
1077 |
|
1078 |
Clients almost never use certificates, but if they do, they can be used |
1079 |
to authenticate the client, just as server certificates can be used to |
1080 |
authenticate the server. |
1081 |
|
1082 |
=item * SSL version 2 is very insecure. |
1083 |
|
1084 |
SSL version 2 is old and not only has it some security issues, SSLv2-only |
1085 |
implementations are usually buggy, too, due to their age. |
1086 |
|
1087 |
=item * Sometimes, even losing your "private" key might not expose all your |
1088 |
data. |
1089 |
|
1090 |
With Diffie-Hellman ephemeral key exchange, you can lose the DH parameters |
1091 |
(the "keys"), but all your connections are still protected. Diffie-Hellman |
1092 |
needs special set-up (done by default by AnyEvent::TLS). |
1093 |
|
1094 |
=back |
1095 |
|
1096 |
=head1 BUGS |
1097 |
|
1098 |
To to the abysmal code quality of Net::SSLeay, this module will leak small |
1099 |
amounts of memory per TLS connection (currently at least one perl scalar). |
1100 |
|
1101 |
=head1 AUTHORS |
1102 |
|
1103 |
Marc Lehmann <schmorp@schmorp.de>. |
1104 |
|
1105 |
Some of the API, documentation and implementation (verify_hostname), |
1106 |
and a lot of ideas/workarounds/knowledge have been taken from the |
1107 |
L<IO::Socket::SSL> module. Care has been taken to keep the API similar to |
1108 |
that and other modules, to the extent possible while providing a sensible |
1109 |
API for AnyEvent. |
1110 |
|
1111 |
=cut |
1112 |
|
1113 |
1 |
1114 |
|