fix #1819: fork_worker: ensure sync'ed workers control terminal
[pve-common.git] / src / PVE / Certificate.pm
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).',
57 optional => 1,
58 },
59 notafter => {
60 type => 'integer',
61 description => 'Certificate\'s notAfter timestamp (UNIX epoch).',
62 optional => 1,
63 },
64 san => {
65 type => 'array',
66 description => 'List of Certificate\'s SubjectAlternativeName entries.',
67 optional => 1,
68 items => {
69 type => 'string',
70 },
71 },
72 pem => {
73 type => 'string',
74 description => 'Certificate in PEM format',
75 format => 'pem-certificate',
76 optional => 1,
77 },
78 },
79 });
80
81 # see RFC 7468
82 my $b64_char_re = qr![0-9A-Za-z\+/]!;
83 my $header_re = sub {
84 my ($label) = @_;
85 return qr!-----BEGIN\ $label-----(?:\s|\n)*!;
86 };
87 my $footer_re = sub {
88 my ($label) = @_;
89 return qr!-----END\ $label-----(?:\s|\n)*!;
90 };
91 my $pem_re = sub {
92 my ($label) = @_;
93
94 my $header = $header_re->($label);
95 my $footer = $footer_re->($label);
96
97 return qr{
98 $header
99 (?:(?:$b64_char_re)+\s*\n)*
100 (?:$b64_char_re)*(?:=\s*\n=|={0,2})?\s*\n
101 $footer
102 }x;
103 };
104
105 sub strip_leading_text {
106 my ($content) = @_;
107
108 my $header = $header_re->(qr/.*?/);
109 $content =~ s/^.*?(?=$header)//s;
110 return $content;
111 };
112
113 sub split_pem {
114 my ($content, %opts) = @_;
115 my $label = $opts{label} // 'CERTIFICATE';
116
117 my $header = $header_re->($label);
118 return split(/(?=$header)/,$content);
119 }
120
121 sub check_pem {
122 my ($content, %opts) = @_;
123
124 my $label = $opts{label} // 'CERTIFICATE';
125 my $multiple = $opts{multiple};
126 my $noerr = $opts{noerr};
127
128 $content = strip_leading_text($content);
129
130 my $re = $pem_re->($label);
131
132 $re = qr/($re\n+)*$re/ if $multiple;
133
134 if ($content =~ /^$re$/) {
135 return $content;
136 } else {
137 return undef if $noerr;
138 die "not a valid PEM-formatted string.\n";
139 }
140 }
141
142 sub pem_to_der {
143 my ($content) = @_;
144
145 my $header = $header_re->(qr/.*?/);
146 my $footer = $footer_re->(qr/.*?/);
147
148 $content = strip_leading_text($content);
149
150 # only take first PEM entry
151 $content =~ s/^$header$//mg;
152 $content =~ s/$footer.*//sg;
153
154 $content = decode_base64($content);
155
156 return $content;
157 }
158
159 sub der_to_pem {
160 my ($content, %opts) = @_;
161
162 my $label = $opts{label} // 'CERTIFICATE';
163
164 my $b64 = encode_base64($content, '');
165 $b64 = join("\n", ($b64 =~ /.{1,64}/sg));
166 return "-----BEGIN $label-----\n$b64\n-----END $label-----\n";
167 }
168
169 my $ssl_die = sub {
170 my ($msg) = @_;
171 Net::SSLeay::die_now($msg);
172 };
173
174 my $ssl_warn = sub {
175 my ($msg) = @_;
176 Net::SSLeay::print_errs();
177 warn $msg if $msg;
178 };
179
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')
186 or $ssl_die->("unable to read '$cert_path' - $!\n");
187
188 my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
189 if (!$cert) {
190 Net::SSLeay::BIO_free($bio);
191 die "unable to read certificate from '$cert_path'\n";
192 }
193
194 return $cert;
195 };
196
197 sub convert_asn1_to_epoch {
198 my ($asn1_time) = @_;
199
200 $ssl_die->("invalid ASN1 time object\n") if !$asn1_time;
201 my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
202 $ssl_die->("unable to parse ASN1 time\n") if $iso_time eq '';
203 return Date::Parse::str2time($iso_time);
204 }
205
206 sub get_certificate_info {
207 my ($cert_path) = @_;
208
209 my $cert = $read_certificate->($cert_path);
210
211 my $parse_san = sub {
212 my $res = [];
213 while (my ($type, $value) = splice(@_, 0, 2)) {
214 if ($type != 2 && $type != 7) {
215 warn "unexpected SAN type encountered: $type\n";
216 next;
217 }
218
219 if ($type == 7) {
220 my $hex = unpack("H*", $value);
221 if (length($hex) == 8) {
222 # IPv4
223 $value = join(".", unpack("C4C4C4C4", $value));
224 } elsif (length($hex) == 32) {
225 # IPv6
226 $value = join(":", unpack("H4H4H4H4H4H4H4H4", $value));
227 } else {
228 warn "cannot parse SAN IP entry '0x${hex}'\n";
229 next;
230 }
231 }
232
233 push @$res, $value;
234 }
235 return $res;
236 };
237
238 my $info = {};
239
240 $info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
241
242 my $subject = Net::SSLeay::X509_get_subject_name($cert);
243 if ($subject) {
244 $info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
245 }
246
247 my $issuer = Net::SSLeay::X509_get_issuer_name($cert);
248 if ($issuer) {
249 $info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer);
250 }
251
252 eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) };
253 warn $@ if $@;
254 eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
255 warn $@ if $@;
256
257 $info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert));
258 $info->{pem} = Net::SSLeay::PEM_get_string_X509($cert);
259
260 Net::SSLeay::X509_free($cert);
261
262 $cert_path =~ s!^.*/!!g;
263 $info->{filename} = $cert_path;
264
265 return $info;
266 };
267
268 # Checks whether certificate expires before $timestamp (UNIX epoch)
269 sub check_expiry {
270 my ($cert_path, $timestamp) = @_;
271
272 $timestamp //= time();
273
274 my $cert = $read_certificate->($cert_path);
275 my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
276 my $err = $@;
277
278 Net::SSLeay::X509_free($cert);
279
280 die $err if $err;
281
282 return ($not_after < $timestamp) ? 1 : 0;
283 };
284
285 # Create a CSR and certificate key for a given order
286 # returns path to CSR file or path to CSR and key files
287 sub generate_csr {
288 my (%attr) = @_;
289
290 # optional
291 my $bits = delete($attr{bits}) // 4096;
292 my $dig_alg = delete($attr{digest}) // 'sha256';
293 my $pem_key = delete($attr{private_key});
294
295 # required
296 my $identifiers = delete($attr{identifiers});
297
298 die "Identifiers are required to generate a CSR.\n"
299 if !defined($identifiers);
300
301 my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ];
302 die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san;
303
304 my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) };
305 die "Invalid digest algorithm '$dig_alg'\n" if !$md;
306
307 my ($bio, $pk, $req);
308
309 my $cleanup = sub {
310 my ($warn, $die_msg) = @_;
311 $ssl_warn->() if $warn;
312
313 Net::SSLeay::X509_REQ_free($req) if $req;
314 Net::SSLeay::EVP_PKEY_free($pk) if $pk;
315 Net::SSLeay::BIO_free($bio) if $bio;
316
317 die $die_msg if $die_msg;
318 };
319
320 # this unfortunately causes a small memory leak, since there is no
321 # X509_NAME_free() (yet)
322 my $name = Net::SSLeay::X509_NAME_new();
323 $ssl_die->("Failed to allocate X509_NAME object\n") if !$name;
324 my $add_name_entry = sub {
325 my ($k, $v) = @_;
326 if (!Net::SSLeay::X509_NAME_add_entry_by_txt($name,
327 $k,
328 &Net::SSLeay::MBSTRING_UTF8,
329 encode('utf-8', $v))) {
330 $cleanup->(1, "Failed to add '$k'='$v' to DN\n");
331 }
332 };
333
334 $add_name_entry->('CN', @$san[0]);
335 for (qw(C ST L O OU)) {
336 if (defined(my $v = $attr{$_})) {
337 $add_name_entry->($_, $v);
338 }
339 }
340
341 if (defined($pem_key)) {
342 my $bio_s_mem = Net::SSLeay::BIO_s_mem();
343 $cleanup->(1, "Failed to allocate BIO_s_mem for private key\n")
344 if !$bio_s_mem;
345
346 $bio = Net::SSLeay::BIO_new($bio_s_mem);
347 $cleanup->(1, "Failed to allocate BIO for private key\n") if !$bio;
348
349 $cleanup->(1, "Failed to write PEM-encoded key to BIO\n")
350 if Net::SSLeay::BIO_write($bio, $pem_key) <= 0;
351
352 $pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
353 $cleanup->(1, "Failed to read private key into EVP_PKEY\n") if !$pk;
354 } else {
355 $pk = Net::SSLeay::EVP_PKEY_new();
356 $cleanup->(1, "Failed to allocate EVP_PKEY for private key\n") if !$pk;
357
358 my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
359 $cleanup->(1, "Failed to generate RSA key pair\n") if !$rsa;
360
361 $cleanup->(1, "Failed to assign RSA key to EVP_PKEY\n")
362 if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa);
363 }
364
365 $req = Net::SSLeay::X509_REQ_new();
366 $cleanup->(1, "Failed to allocate X509_REQ\n") if !$req;
367
368 $cleanup->(1, "Failed to set subject name\n")
369 if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));
370
371 $cleanup->(1, "Failed to add extensions to CSR\n")
372 if !Net::SSLeay::P_X509_REQ_add_extensions($req,
373 &Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment',
374 &Net::SSLeay::NID_basic_constraints => 'CA:FALSE',
375 &Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth',
376 &Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san),
377 );
378
379 $cleanup->(1, "Failed to set public key\n")
380 if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
381
382 $cleanup->(1, "Failed to set CSR version\n")
383 if !Net::SSLeay::X509_REQ_set_version($req, 2);
384
385 $cleanup->(1, "Failed to sign CSR\n")
386 if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
387
388 my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk);
389 my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req);
390
391 $cleanup->();
392
393 return wantarray ? ($req_pem, $pk_pem) : $req_pem;
394 }
395
396 1;