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