]>
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 | ||
137 | my $label = $opts{label} // 'CERTIFICATE'; | |
138 | my $multiple = $opts{multiple}; | |
139 | my $noerr = $opts{noerr}; | |
140 | ||
141 | $content = strip_leading_text($content); | |
142 | ||
143 | my $re = $pem_re->($label); | |
144 | ||
145 | $re = qr/($re\n+)*$re/ if $multiple; | |
146 | ||
147 | if ($content =~ /^$re$/) { | |
148 | return $content; | |
149 | } else { | |
150 | return undef if $noerr; | |
151 | die "not a valid PEM-formatted string.\n"; | |
152 | } | |
153 | } | |
154 | ||
155 | sub pem_to_der { | |
156 | my ($content) = @_; | |
157 | ||
158 | my $header = $header_re->(qr/.*?/); | |
159 | my $footer = $footer_re->(qr/.*?/); | |
160 | ||
161 | $content = strip_leading_text($content); | |
162 | ||
163 | # only take first PEM entry | |
164 | $content =~ s/^$header$//mg; | |
165 | $content =~ s/$footer.*//sg; | |
166 | ||
167 | $content = decode_base64($content); | |
168 | ||
169 | return $content; | |
170 | } | |
171 | ||
172 | sub der_to_pem { | |
173 | my ($content, %opts) = @_; | |
174 | ||
175 | my $label = $opts{label} // 'CERTIFICATE'; | |
176 | ||
177 | my $b64 = encode_base64($content, ''); | |
178 | $b64 = join("\n", ($b64 =~ /.{1,64}/sg)); | |
179 | return "-----BEGIN $label-----\n$b64\n-----END $label-----\n"; | |
180 | } | |
181 | ||
74bb32ad | 182 | my sub ssl_die { |
4e0952c9 | 183 | my ($msg) = @_; |
e8a515e6 | 184 | Net::SSLeay::die_now("$msg\n"); |
4e0952c9 FG |
185 | }; |
186 | ||
4e0952c9 FG |
187 | my $read_certificate = sub { |
188 | my ($cert_path) = @_; | |
189 | ||
190 | die "'$cert_path' does not exist!\n" if ! -e $cert_path; | |
191 | ||
192 | my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r') | |
e8a515e6 | 193 | or ssl_die("unable to read '$cert_path' - $!"); |
4e0952c9 FG |
194 | |
195 | my $cert = Net::SSLeay::PEM_read_bio_X509($bio); | |
eb6262a6 SI |
196 | Net::SSLeay::BIO_free($bio); |
197 | die "unable to read certificate from '$cert_path'\n" if !$cert; | |
4e0952c9 FG |
198 | |
199 | return $cert; | |
200 | }; | |
201 | ||
202 | sub convert_asn1_to_epoch { | |
203 | my ($asn1_time) = @_; | |
204 | ||
e8a515e6 | 205 | ssl_die("invalid ASN1 time object") if !$asn1_time; |
4e0952c9 | 206 | my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time); |
e8a515e6 | 207 | ssl_die("unable to parse ASN1 time") if $iso_time eq ''; |
4e0952c9 FG |
208 | return Date::Parse::str2time($iso_time); |
209 | } | |
210 | ||
4e91db0a FG |
211 | sub get_certificate_fingerprint { |
212 | my ($cert_path) = @_; | |
213 | ||
214 | my $cert = $read_certificate->($cert_path); | |
215 | ||
216 | my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256'); | |
217 | Net::SSLeay::X509_free($cert); | |
218 | ||
219 | die "unable to get fingerprint for '$cert_path' - got empty value\n" | |
220 | if !defined($fp) || $fp eq ''; | |
221 | ||
222 | return $fp; | |
223 | } | |
224 | ||
60a05ecd | 225 | sub check_certificate_matches_key { |
a3baf767 MC |
226 | my ($cert_path, $key_path) = @_; |
227 | ||
228 | die "No certificate path given!\n" if !$cert_path; | |
229 | die "No certificate key path given!\n" if !$key_path; | |
230 | ||
231 | die "Certificate at '$cert_path' does not exist!\n" if ! -e $cert_path; | |
232 | die "Certificate key '$key_path' does not exist!\n" if ! -e $key_path; | |
233 | ||
234 | my $ctx = Net::SSLeay::CTX_new() | |
74bb32ad | 235 | or ssl_die("Failed to create SSL context in order to verify private key"); |
a3baf767 MC |
236 | |
237 | eval { | |
238 | my $filetype = &Net::SSLeay::FILETYPE_PEM; | |
239 | ||
240 | Net::SSLeay::CTX_use_PrivateKey_file($ctx, $key_path, $filetype) | |
74bb32ad | 241 | or ssl_die("Failed to load private key from '$key_path' into SSL context"); |
a3baf767 MC |
242 | |
243 | Net::SSLeay::CTX_use_certificate_file($ctx, $cert_path, $filetype) | |
74bb32ad | 244 | or ssl_die("Failed to load certificate from '$cert_path' into SSL context"); |
a3baf767 MC |
245 | |
246 | Net::SSLeay::CTX_check_private_key($ctx) | |
74bb32ad | 247 | or ssl_die("Failed to validate private key and certificate"); |
a3baf767 MC |
248 | }; |
249 | my $err = $@; | |
250 | ||
251 | Net::SSLeay::CTX_free($ctx); | |
252 | ||
253 | die $err if $err; | |
254 | ||
255 | return 1; | |
256 | } | |
257 | ||
4e0952c9 FG |
258 | sub get_certificate_info { |
259 | my ($cert_path) = @_; | |
260 | ||
261 | my $cert = $read_certificate->($cert_path); | |
262 | ||
263 | my $parse_san = sub { | |
264 | my $res = []; | |
265 | while (my ($type, $value) = splice(@_, 0, 2)) { | |
266 | if ($type != 2 && $type != 7) { | |
267 | warn "unexpected SAN type encountered: $type\n"; | |
268 | next; | |
269 | } | |
270 | ||
271 | if ($type == 7) { | |
272 | my $hex = unpack("H*", $value); | |
273 | if (length($hex) == 8) { | |
274 | # IPv4 | |
275 | $value = join(".", unpack("C4C4C4C4", $value)); | |
276 | } elsif (length($hex) == 32) { | |
277 | # IPv6 | |
278 | $value = join(":", unpack("H4H4H4H4H4H4H4H4", $value)); | |
279 | } else { | |
280 | warn "cannot parse SAN IP entry '0x${hex}'\n"; | |
281 | next; | |
282 | } | |
283 | } | |
284 | ||
285 | push @$res, $value; | |
286 | } | |
287 | return $res; | |
288 | }; | |
289 | ||
290 | my $info = {}; | |
291 | ||
292 | $info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256'); | |
293 | ||
294 | my $subject = Net::SSLeay::X509_get_subject_name($cert); | |
295 | if ($subject) { | |
296 | $info->{subject} = Net::SSLeay::X509_NAME_oneline($subject); | |
297 | } | |
298 | ||
299 | my $issuer = Net::SSLeay::X509_get_issuer_name($cert); | |
300 | if ($issuer) { | |
301 | $info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer); | |
302 | } | |
303 | ||
304 | eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) }; | |
305 | warn $@ if $@; | |
306 | eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) }; | |
307 | warn $@ if $@; | |
308 | ||
309 | $info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert)); | |
310 | $info->{pem} = Net::SSLeay::PEM_get_string_X509($cert); | |
311 | ||
afa3f369 FG |
312 | my $pub_key = eval { Net::SSLeay::X509_get_pubkey($cert) }; |
313 | warn $@ if $@; | |
314 | if ($pub_key) { | |
315 | $info->{'public-key-type'} = Net::SSLeay::OBJ_nid2sn(Net::SSLeay::EVP_PKEY_id($pub_key)); | |
316 | $info->{'public-key-bits'} = Net::SSLeay::EVP_PKEY_bits($pub_key); | |
317 | Net::SSLeay::EVP_PKEY_free($pub_key); | |
318 | } | |
319 | ||
4e0952c9 FG |
320 | Net::SSLeay::X509_free($cert); |
321 | ||
322 | $cert_path =~ s!^.*/!!g; | |
323 | $info->{filename} = $cert_path; | |
324 | ||
325 | return $info; | |
326 | }; | |
327 | ||
328 | # Checks whether certificate expires before $timestamp (UNIX epoch) | |
329 | sub check_expiry { | |
330 | my ($cert_path, $timestamp) = @_; | |
331 | ||
332 | $timestamp //= time(); | |
333 | ||
334 | my $cert = $read_certificate->($cert_path); | |
335 | my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) }; | |
336 | my $err = $@; | |
337 | ||
338 | Net::SSLeay::X509_free($cert); | |
339 | ||
340 | die $err if $err; | |
341 | ||
342 | return ($not_after < $timestamp) ? 1 : 0; | |
343 | }; | |
344 | ||
345 | # Create a CSR and certificate key for a given order | |
346 | # returns path to CSR file or path to CSR and key files | |
347 | sub generate_csr { | |
348 | my (%attr) = @_; | |
349 | ||
350 | # optional | |
351 | my $bits = delete($attr{bits}) // 4096; | |
352 | my $dig_alg = delete($attr{digest}) // 'sha256'; | |
353 | my $pem_key = delete($attr{private_key}); | |
354 | ||
355 | # required | |
356 | my $identifiers = delete($attr{identifiers}); | |
357 | ||
358 | die "Identifiers are required to generate a CSR.\n" | |
359 | if !defined($identifiers); | |
360 | ||
361 | my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ]; | |
362 | die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san; | |
363 | ||
0e4d81ad TL |
364 | # optional |
365 | my $common_name = delete($attr{common_name}) // $san->[0]; | |
366 | ||
4e0952c9 FG |
367 | my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) }; |
368 | die "Invalid digest algorithm '$dig_alg'\n" if !$md; | |
369 | ||
370 | my ($bio, $pk, $req); | |
371 | ||
372 | my $cleanup = sub { | |
45a75161 TL |
373 | my ($die_msg, $no_warn) = @_; |
374 | Net::SSLeay::print_errs() if !$no_warn; | |
4e0952c9 FG |
375 | |
376 | Net::SSLeay::X509_REQ_free($req) if $req; | |
377 | Net::SSLeay::EVP_PKEY_free($pk) if $pk; | |
378 | Net::SSLeay::BIO_free($bio) if $bio; | |
379 | ||
380 | die $die_msg if $die_msg; | |
381 | }; | |
382 | ||
383 | # this unfortunately causes a small memory leak, since there is no | |
384 | # X509_NAME_free() (yet) | |
385 | my $name = Net::SSLeay::X509_NAME_new(); | |
e8a515e6 | 386 | ssl_die("Failed to allocate X509_NAME object") if !$name; |
4e0952c9 FG |
387 | my $add_name_entry = sub { |
388 | my ($k, $v) = @_; | |
d602284c MC |
389 | |
390 | my $res = Net::SSLeay::X509_NAME_add_entry_by_txt( | |
45a75161 | 391 | $name, $k, &Net::SSLeay::MBSTRING_UTF8, encode('utf-8', $v)); |
d602284c | 392 | |
45a75161 | 393 | $cleanup->("Failed to add '$k'='$v' to DN\n") if !$res; |
4e0952c9 FG |
394 | }; |
395 | ||
0e4d81ad | 396 | $add_name_entry->('CN', $common_name); |
4e0952c9 | 397 | for (qw(C ST L O OU)) { |
d602284c | 398 | if (defined(my $v = $attr{$_})) { |
4e0952c9 | 399 | $add_name_entry->($_, $v); |
d602284c | 400 | } |
4e0952c9 FG |
401 | } |
402 | ||
403 | if (defined($pem_key)) { | |
404 | my $bio_s_mem = Net::SSLeay::BIO_s_mem(); | |
45a75161 | 405 | $cleanup->("Failed to allocate BIO_s_mem for private key\n") if !$bio_s_mem; |
4e0952c9 FG |
406 | |
407 | $bio = Net::SSLeay::BIO_new($bio_s_mem); | |
45a75161 | 408 | $cleanup->("Failed to allocate BIO for private key\n") if !$bio; |
4e0952c9 | 409 | |
45a75161 | 410 | $cleanup->("Failed to write PEM-encoded key to BIO\n") |
4e0952c9 FG |
411 | if Net::SSLeay::BIO_write($bio, $pem_key) <= 0; |
412 | ||
413 | $pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio); | |
45a75161 | 414 | $cleanup->("Failed to read private key into EVP_PKEY\n") if !$pk; |
4e0952c9 FG |
415 | } else { |
416 | $pk = Net::SSLeay::EVP_PKEY_new(); | |
45a75161 | 417 | $cleanup->("Failed to allocate EVP_PKEY for private key\n") if !$pk; |
4e0952c9 FG |
418 | |
419 | my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537); | |
45a75161 | 420 | $cleanup->("Failed to generate RSA key pair\n") if !$rsa; |
4e0952c9 | 421 | |
45a75161 | 422 | $cleanup->("Failed to assign RSA key to EVP_PKEY\n") |
4e0952c9 FG |
423 | if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa); |
424 | } | |
425 | ||
426 | $req = Net::SSLeay::X509_REQ_new(); | |
45a75161 | 427 | $cleanup->("Failed to allocate X509_REQ\n") if !$req; |
4e0952c9 | 428 | |
45a75161 | 429 | $cleanup->("Failed to set subject name\n") |
4e0952c9 FG |
430 | if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name)); |
431 | ||
d602284c MC |
432 | Net::SSLeay::P_X509_REQ_add_extensions( |
433 | $req, | |
434 | &Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment', | |
435 | &Net::SSLeay::NID_basic_constraints => 'CA:FALSE', | |
436 | &Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth', | |
437 | &Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san), | |
45a75161 | 438 | ) or $cleanup->("Failed to add extensions to CSR\n"); |
4e0952c9 | 439 | |
45a75161 | 440 | $cleanup->("Failed to set public key\n") if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk); |
4e0952c9 | 441 | |
45a75161 | 442 | $cleanup->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 2); |
4e0952c9 | 443 | |
45a75161 | 444 | $cleanup->("Failed to sign CSR\n") if !Net::SSLeay::X509_REQ_sign($req, $pk, $md); |
4e0952c9 FG |
445 | |
446 | my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk); | |
447 | my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req); | |
448 | ||
45a75161 | 449 | $cleanup->(undef, 1); |
4e0952c9 FG |
450 | |
451 | return wantarray ? ($req_pem, $pk_pem) : $req_pem; | |
452 | } | |
453 | ||
454 | 1; |