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