ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/TLS.pm
Revision: 1.65
Committed: Mon Feb 10 08:31:32 2020 UTC (4 years, 9 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.64: +18 -10 lines
Log Message: 
*** empty log message ***

File Contents

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