]>
Commit | Line | Data |
---|---|---|
4e0952c9 FG |
1 | package PVE::Certificate; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use Date::Parse; | |
7 | use Encode qw(decode encode); | |
8 | use MIME::Base64 qw(decode_base64 encode_base64); | |
9 | use Net::SSLeay; | |
10 | ||
11 | use PVE::JSONSchema qw(get_standard_option); | |
12 | ||
13 | Net::SSLeay::load_error_strings(); | |
14 | Net::SSLeay::randomize(); | |
15 | ||
16 | PVE::JSONSchema::register_format('pem-certificate', sub { | |
17 | my ($content, $noerr) = @_; | |
18 | ||
19 | return check_pem($content, noerr => $noerr); | |
20 | }); | |
21 | ||
22 | PVE::JSONSchema::register_format('pem-certificate-chain', sub { | |
23 | my ($content, $noerr) = @_; | |
24 | ||
25 | return check_pem($content, noerr => $noerr, multiple => 1); | |
26 | }); | |
27 | ||
28 | PVE::JSONSchema::register_format('pem-string', sub { | |
29 | my ($content, $noerr) = @_; | |
30 | ||
31 | return check_pem($content, noerr => $noerr, label => qr/.*?/); | |
32 | }); | |
33 | ||
34 | PVE::JSONSchema::register_standard_option('pve-certificate-info', { | |
35 | type => 'object', | |
36 | properties => { | |
37 | filename => { | |
38 | type => 'string', | |
39 | optional => 1, | |
40 | }, | |
41 | fingerprint => get_standard_option('fingerprint-sha256', { | |
42 | optional => 1, | |
43 | }), | |
44 | subject => { | |
45 | type => 'string', | |
46 | description => 'Certificate subject name.', | |
47 | optional => 1, | |
48 | }, | |
49 | issuer => { | |
50 | type => 'string', | |
51 | description => 'Certificate issuer name.', | |
52 | optional => 1, | |
53 | }, | |
54 | notbefore => { | |
55 | type => 'integer', | |
56 | description => 'Certificate\'s notBefore timestamp (UNIX epoch).', | |
b99c04ad | 57 | renderer => 'timestamp', |
4e0952c9 FG |
58 | optional => 1, |
59 | }, | |
60 | notafter => { | |
61 | type => 'integer', | |
62 | description => 'Certificate\'s notAfter timestamp (UNIX epoch).', | |
b99c04ad | 63 | renderer => 'timestamp', |
4e0952c9 FG |
64 | optional => 1, |
65 | }, | |
66 | san => { | |
67 | type => 'array', | |
68 | description => 'List of Certificate\'s SubjectAlternativeName entries.', | |
69 | optional => 1, | |
b99c04ad | 70 | renderer => 'yaml', |
4e0952c9 FG |
71 | items => { |
72 | type => 'string', | |
73 | }, | |
74 | }, | |
75 | pem => { | |
76 | type => 'string', | |
77 | description => 'Certificate in PEM format', | |
78 | format => 'pem-certificate', | |
79 | optional => 1, | |
80 | }, | |
96ab1135 AA |
81 | 'public-key-type' => { |
82 | type => 'string', | |
83 | description => 'Certificate\'s public key algorithm', | |
84 | optional => 1, | |
85 | }, | |
86 | 'public-key-bits' => { | |
87 | type => 'integer', | |
88 | description => 'Certificate\'s public key size', | |
89 | optional => 1, | |
90 | }, | |
4e0952c9 FG |
91 | }, |
92 | }); | |
93 | ||
94 | # see RFC 7468 | |
95 | my $b64_char_re = qr![0-9A-Za-z\+/]!; | |
96 | my $header_re = sub { | |
97 | my ($label) = @_; | |
98 | return qr!-----BEGIN\ $label-----(?:\s|\n)*!; | |
99 | }; | |
100 | my $footer_re = sub { | |
101 | my ($label) = @_; | |
102 | return qr!-----END\ $label-----(?:\s|\n)*!; | |
103 | }; | |
104 | my $pem_re = sub { | |
105 | my ($label) = @_; | |
106 | ||
107 | my $header = $header_re->($label); | |
108 | my $footer = $footer_re->($label); | |
109 | ||
110 | return qr{ | |
111 | $header | |
112 | (?:(?:$b64_char_re)+\s*\n)* | |
113 | (?:$b64_char_re)*(?:=\s*\n=|={0,2})?\s*\n | |
114 | $footer | |
115 | }x; | |
116 | }; | |
117 | ||
118 | sub strip_leading_text { | |
119 | my ($content) = @_; | |
120 | ||
121 | my $header = $header_re->(qr/.*?/); | |
122 | $content =~ s/^.*?(?=$header)//s; | |
123 | return $content; | |
124 | }; | |
125 | ||
126 | sub split_pem { | |
127 | my ($content, %opts) = @_; | |
128 | my $label = $opts{label} // 'CERTIFICATE'; | |
129 | ||
130 | my $header = $header_re->($label); | |
131 | return split(/(?=$header)/,$content); | |
132 | } | |
133 | ||
134 | sub check_pem { | |
135 | my ($content, %opts) = @_; | |
136 | ||
4e0952c9 FG |
137 | $content = strip_leading_text($content); |
138 | ||
6baa9131 TL |
139 | my $re = $pem_re->($opts{label} // 'CERTIFICATE'); |
140 | $re = qr/($re\n+)*$re/ if $opts{multiple}; | |
4e0952c9 | 141 | |
6baa9131 | 142 | return $content if $content =~ /^$re$/; # OK |
4e0952c9 | 143 | |
6baa9131 TL |
144 | return undef if $opts{noerr}; |
145 | die "not a valid PEM-formatted string.\n"; | |
4e0952c9 FG |
146 | } |
147 | ||
148 | sub pem_to_der { | |
149 | my ($content) = @_; | |
150 | ||
151 | my $header = $header_re->(qr/.*?/); | |
152 | my $footer = $footer_re->(qr/.*?/); | |
153 | ||
154 | $content = strip_leading_text($content); | |
155 | ||
156 | # only take first PEM entry | |
157 | $content =~ s/^$header$//mg; | |
158 | $content =~ s/$footer.*//sg; | |
159 | ||
160 | $content = decode_base64($content); | |
161 | ||
162 | return $content; | |
163 | } | |
164 | ||
165 | sub der_to_pem { | |
166 | my ($content, %opts) = @_; | |
167 | ||
168 | my $label = $opts{label} // 'CERTIFICATE'; | |
169 | ||
170 | my $b64 = encode_base64($content, ''); | |
171 | $b64 = join("\n", ($b64 =~ /.{1,64}/sg)); | |
172 | return "-----BEGIN $label-----\n$b64\n-----END $label-----\n"; | |
173 | } | |
174 | ||
74bb32ad | 175 | my sub ssl_die { |
4e0952c9 | 176 | my ($msg) = @_; |
e8a515e6 | 177 | Net::SSLeay::die_now("$msg\n"); |
4e0952c9 FG |
178 | }; |
179 | ||
4e0952c9 FG |
180 | my $read_certificate = sub { |
181 | my ($cert_path) = @_; | |
182 | ||
183 | die "'$cert_path' does not exist!\n" if ! -e $cert_path; | |
184 | ||
185 | my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r') | |
e8a515e6 | 186 | or ssl_die("unable to read '$cert_path' - $!"); |
4e0952c9 FG |
187 | |
188 | my $cert = Net::SSLeay::PEM_read_bio_X509($bio); | |
eb6262a6 SI |
189 | Net::SSLeay::BIO_free($bio); |
190 | die "unable to read certificate from '$cert_path'\n" if !$cert; | |
4e0952c9 FG |
191 | |
192 | return $cert; | |
193 | }; | |
194 | ||
195 | sub convert_asn1_to_epoch { | |
196 | my ($asn1_time) = @_; | |
197 | ||
e8a515e6 | 198 | ssl_die("invalid ASN1 time object") if !$asn1_time; |
4e0952c9 | 199 | my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time); |
e8a515e6 | 200 | ssl_die("unable to parse ASN1 time") if $iso_time eq ''; |
4e0952c9 FG |
201 | return Date::Parse::str2time($iso_time); |
202 | } | |
203 | ||
4e91db0a FG |
204 | sub get_certificate_fingerprint { |
205 | my ($cert_path) = @_; | |
206 | ||
207 | my $cert = $read_certificate->($cert_path); | |
208 | ||
209 | my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256'); | |
210 | Net::SSLeay::X509_free($cert); | |
211 | ||
212 | die "unable to get fingerprint for '$cert_path' - got empty value\n" | |
213 | if !defined($fp) || $fp eq ''; | |
214 | ||
215 | return $fp; | |
216 | } | |
217 | ||
060a437f | 218 | sub assert_certificate_matches_key { |
a3baf767 MC |
219 | my ($cert_path, $key_path) = @_; |
220 | ||
221 | die "No certificate path given!\n" if !$cert_path; | |
222 | die "No certificate key path given!\n" if !$key_path; | |
223 | ||
224 | die "Certificate at '$cert_path' does not exist!\n" if ! -e $cert_path; | |
225 | die "Certificate key '$key_path' does not exist!\n" if ! -e $key_path; | |
226 | ||
227 | my $ctx = Net::SSLeay::CTX_new() | |
74bb32ad | 228 | or ssl_die("Failed to create SSL context in order to verify private key"); |
a3baf767 MC |
229 | |
230 | eval { | |
231 | my $filetype = &Net::SSLeay::FILETYPE_PEM; | |
232 | ||
233 | Net::SSLeay::CTX_use_PrivateKey_file($ctx, $key_path, $filetype) | |
74bb32ad | 234 | or ssl_die("Failed to load private key from '$key_path' into SSL context"); |
a3baf767 MC |
235 | |
236 | Net::SSLeay::CTX_use_certificate_file($ctx, $cert_path, $filetype) | |
74bb32ad | 237 | or ssl_die("Failed to load certificate from '$cert_path' into SSL context"); |
a3baf767 MC |
238 | |
239 | Net::SSLeay::CTX_check_private_key($ctx) | |
74bb32ad | 240 | or ssl_die("Failed to validate private key and certificate"); |
a3baf767 MC |
241 | }; |
242 | my $err = $@; | |
243 | ||
244 | Net::SSLeay::CTX_free($ctx); | |
245 | ||
246 | die $err if $err; | |
247 | ||
248 | return 1; | |
249 | } | |
250 | ||
4e0952c9 FG |
251 | sub get_certificate_info { |
252 | my ($cert_path) = @_; | |
253 | ||
254 | my $cert = $read_certificate->($cert_path); | |
255 | ||
256 | my $parse_san = sub { | |
257 | my $res = []; | |
258 | while (my ($type, $value) = splice(@_, 0, 2)) { | |
259 | if ($type != 2 && $type != 7) { | |
260 | warn "unexpected SAN type encountered: $type\n"; | |
261 | next; | |
262 | } | |
263 | ||
264 | if ($type == 7) { | |
265 | my $hex = unpack("H*", $value); | |
266 | if (length($hex) == 8) { | |
267 | # IPv4 | |
268 | $value = join(".", unpack("C4C4C4C4", $value)); | |
269 | } elsif (length($hex) == 32) { | |
270 | # IPv6 | |
271 | $value = join(":", unpack("H4H4H4H4H4H4H4H4", $value)); | |
272 | } else { | |
273 | warn "cannot parse SAN IP entry '0x${hex}'\n"; | |
274 | next; | |
275 | } | |
276 | } | |
277 | ||
278 | push @$res, $value; | |
279 | } | |
280 | return $res; | |
281 | }; | |
282 | ||
283 | my $info = {}; | |
284 | ||
285 | $info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256'); | |
286 | ||
060a437f | 287 | if (my $subject = Net::SSLeay::X509_get_subject_name($cert)) { |
4e0952c9 FG |
288 | $info->{subject} = Net::SSLeay::X509_NAME_oneline($subject); |
289 | } | |
290 | ||
060a437f | 291 | if (my $issuer = Net::SSLeay::X509_get_issuer_name($cert)) { |
4e0952c9 FG |
292 | $info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer); |
293 | } | |
294 | ||
295 | eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) }; | |
296 | warn $@ if $@; | |
297 | eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) }; | |
298 | warn $@ if $@; | |
299 | ||
300 | $info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert)); | |
301 | $info->{pem} = Net::SSLeay::PEM_get_string_X509($cert); | |
302 | ||
afa3f369 FG |
303 | my $pub_key = eval { Net::SSLeay::X509_get_pubkey($cert) }; |
304 | warn $@ if $@; | |
305 | if ($pub_key) { | |
306 | $info->{'public-key-type'} = Net::SSLeay::OBJ_nid2sn(Net::SSLeay::EVP_PKEY_id($pub_key)); | |
307 | $info->{'public-key-bits'} = Net::SSLeay::EVP_PKEY_bits($pub_key); | |
308 | Net::SSLeay::EVP_PKEY_free($pub_key); | |
309 | } | |
310 | ||
4e0952c9 FG |
311 | Net::SSLeay::X509_free($cert); |
312 | ||
313 | $cert_path =~ s!^.*/!!g; | |
314 | $info->{filename} = $cert_path; | |
315 | ||
316 | return $info; | |
317 | }; | |
318 | ||
319 | # Checks whether certificate expires before $timestamp (UNIX epoch) | |
320 | sub check_expiry { | |
321 | my ($cert_path, $timestamp) = @_; | |
322 | ||
323 | $timestamp //= time(); | |
324 | ||
325 | my $cert = $read_certificate->($cert_path); | |
326 | my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) }; | |
327 | my $err = $@; | |
328 | ||
329 | Net::SSLeay::X509_free($cert); | |
330 | ||
331 | die $err if $err; | |
332 | ||
333 | return ($not_after < $timestamp) ? 1 : 0; | |
334 | }; | |
335 | ||
336 | # Create a CSR and certificate key for a given order | |
337 | # returns path to CSR file or path to CSR and key files | |
338 | sub generate_csr { | |
339 | my (%attr) = @_; | |
340 | ||
341 | # optional | |
342 | my $bits = delete($attr{bits}) // 4096; | |
343 | my $dig_alg = delete($attr{digest}) // 'sha256'; | |
344 | my $pem_key = delete($attr{private_key}); | |
345 | ||
346 | # required | |
347 | my $identifiers = delete($attr{identifiers}); | |
348 | ||
349 | die "Identifiers are required to generate a CSR.\n" | |
350 | if !defined($identifiers); | |
351 | ||
352 | my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ]; | |
353 | die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san; | |
354 | ||
0e4d81ad TL |
355 | # optional |
356 | my $common_name = delete($attr{common_name}) // $san->[0]; | |
357 | ||
4e0952c9 FG |
358 | my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) }; |
359 | die "Invalid digest algorithm '$dig_alg'\n" if !$md; | |
360 | ||
361 | my ($bio, $pk, $req); | |
362 | ||
363 | my $cleanup = sub { | |
45a75161 TL |
364 | my ($die_msg, $no_warn) = @_; |
365 | Net::SSLeay::print_errs() if !$no_warn; | |
4e0952c9 FG |
366 | |
367 | Net::SSLeay::X509_REQ_free($req) if $req; | |
368 | Net::SSLeay::EVP_PKEY_free($pk) if $pk; | |
369 | Net::SSLeay::BIO_free($bio) if $bio; | |
370 | ||
371 | die $die_msg if $die_msg; | |
372 | }; | |
373 | ||
374 | # this unfortunately causes a small memory leak, since there is no | |
375 | # X509_NAME_free() (yet) | |
376 | my $name = Net::SSLeay::X509_NAME_new(); | |
e8a515e6 | 377 | ssl_die("Failed to allocate X509_NAME object") if !$name; |
4e0952c9 FG |
378 | my $add_name_entry = sub { |
379 | my ($k, $v) = @_; | |
d602284c MC |
380 | |
381 | my $res = Net::SSLeay::X509_NAME_add_entry_by_txt( | |
45a75161 | 382 | $name, $k, &Net::SSLeay::MBSTRING_UTF8, encode('utf-8', $v)); |
d602284c | 383 | |
45a75161 | 384 | $cleanup->("Failed to add '$k'='$v' to DN\n") if !$res; |
4e0952c9 FG |
385 | }; |
386 | ||
0e4d81ad | 387 | $add_name_entry->('CN', $common_name); |
4e0952c9 | 388 | for (qw(C ST L O OU)) { |
d602284c | 389 | if (defined(my $v = $attr{$_})) { |
4e0952c9 | 390 | $add_name_entry->($_, $v); |
d602284c | 391 | } |
4e0952c9 FG |
392 | } |
393 | ||
394 | if (defined($pem_key)) { | |
395 | my $bio_s_mem = Net::SSLeay::BIO_s_mem(); | |
45a75161 | 396 | $cleanup->("Failed to allocate BIO_s_mem for private key\n") if !$bio_s_mem; |
4e0952c9 FG |
397 | |
398 | $bio = Net::SSLeay::BIO_new($bio_s_mem); | |
45a75161 | 399 | $cleanup->("Failed to allocate BIO for private key\n") if !$bio; |
4e0952c9 | 400 | |
45a75161 | 401 | $cleanup->("Failed to write PEM-encoded key to BIO\n") |
4e0952c9 FG |
402 | if Net::SSLeay::BIO_write($bio, $pem_key) <= 0; |
403 | ||
404 | $pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio); | |
45a75161 | 405 | $cleanup->("Failed to read private key into EVP_PKEY\n") if !$pk; |
4e0952c9 FG |
406 | } else { |
407 | $pk = Net::SSLeay::EVP_PKEY_new(); | |
45a75161 | 408 | $cleanup->("Failed to allocate EVP_PKEY for private key\n") if !$pk; |
4e0952c9 FG |
409 | |
410 | my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537); | |
45a75161 | 411 | $cleanup->("Failed to generate RSA key pair\n") if !$rsa; |
4e0952c9 | 412 | |
45a75161 | 413 | $cleanup->("Failed to assign RSA key to EVP_PKEY\n") |
4e0952c9 FG |
414 | if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa); |
415 | } | |
416 | ||
417 | $req = Net::SSLeay::X509_REQ_new(); | |
45a75161 | 418 | $cleanup->("Failed to allocate X509_REQ\n") if !$req; |
4e0952c9 | 419 | |
45a75161 | 420 | $cleanup->("Failed to set subject name\n") |
4e0952c9 FG |
421 | if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name)); |
422 | ||
d602284c MC |
423 | Net::SSLeay::P_X509_REQ_add_extensions( |
424 | $req, | |
425 | &Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment', | |
426 | &Net::SSLeay::NID_basic_constraints => 'CA:FALSE', | |
427 | &Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth', | |
428 | &Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san), | |
45a75161 | 429 | ) or $cleanup->("Failed to add extensions to CSR\n"); |
4e0952c9 | 430 | |
45a75161 | 431 | $cleanup->("Failed to set public key\n") if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk); |
4e0952c9 | 432 | |
45a75161 | 433 | $cleanup->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 2); |
4e0952c9 | 434 | |
45a75161 | 435 | $cleanup->("Failed to sign CSR\n") if !Net::SSLeay::X509_REQ_sign($req, $pk, $md); |
4e0952c9 FG |
436 | |
437 | my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk); | |
438 | my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req); | |
439 | ||
45a75161 | 440 | $cleanup->(undef, 1); |
4e0952c9 FG |
441 | |
442 | return wantarray ? ($req_pem, $pk_pem) : $req_pem; | |
443 | } | |
444 | ||
445 | 1; |