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