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             renderer => 'timestamp',
  58             optional => 1,
  59         },
  60         notafter => {
  61             type => 'integer',
  62             description => 'Certificate\'s notAfter timestamp (UNIX epoch).',
  63             renderer => 'timestamp',
  64             optional => 1,
  65         },
  66         san => {
  67             type => 'array',
  68             description => 'List of Certificate\'s SubjectAlternativeName entries.',
  69             optional => 1,
  70             renderer => 'yaml',
  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         },
  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         },
  91     },
  92 });
  93
  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
 105     my $b64_char_re = qr![0-9A-Za-z\+/]!; # see RFC 7468
 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
 136     $content = strip_leading_text($content);
 137
 138     my $re = $pem_re->($opts{label} // 'CERTIFICATE');
 139     $re = qr/($re\n+)*$re/ if $opts{multiple};
 140
 141     return $content if $content =~ /^$re$/; # OK
 142
 143     return undef if $opts{noerr};
 144     die "not a valid PEM-formatted string.\n";
 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
 174 my sub ssl_die {
 175     my ($msg) = @_;
 176     Net::SSLeay::die_now("$msg\n");
 177 };
 178
 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')
 185         or ssl_die("unable to read '$cert_path' - $!");
 186
 187     my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
 188     Net::SSLeay::BIO_free($bio);
 189     die "unable to read certificate from '$cert_path'\n" if !$cert;
 190
 191     return $cert;
 192 };
 193
 194 sub convert_asn1_to_epoch {
 195     my ($asn1_time) = @_;
 196
 197     ssl_die("invalid ASN1 time object") if !$asn1_time;
 198     my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
 199     ssl_die("unable to parse ASN1 time") if $iso_time eq '';
 200     return Date::Parse::str2time($iso_time);
 201 }
 202
 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
 217 sub assert_certificate_matches_key {
 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()
 227         or ssl_die("Failed to create SSL context in order to verify private key");
 228
 229     eval {
 230         my $filetype = &Net::SSLeay::FILETYPE_PEM;
 231
 232         Net::SSLeay::CTX_use_PrivateKey_file($ctx, $key_path, $filetype)
 233             or ssl_die("Failed to load private key from '$key_path' into SSL context");
 234
 235         Net::SSLeay::CTX_use_certificate_file($ctx, $cert_path, $filetype)
 236             or ssl_die("Failed to load certificate from '$cert_path' into SSL context");
 237
 238         Net::SSLeay::CTX_check_private_key($ctx)
 239             or ssl_die("Failed to validate private key and certificate");
 240     };
 241     my $err = $@;
 242
 243     Net::SSLeay::CTX_free($ctx);
 244
 245     die $err if $err;
 246
 247     return 1;
 248 }
 249
 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
 286     if (my $subject = Net::SSLeay::X509_get_subject_name($cert)) {
 287         $info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
 288     }
 289
 290     if (my $issuer = Net::SSLeay::X509_get_issuer_name($cert)) {
 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
 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
 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
 354     # optional
 355     my $common_name = delete($attr{common_name}) // $san->[0];
 356
 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 {
 363         my ($die_msg, $no_warn) = @_;
 364         Net::SSLeay::print_errs() if !$no_warn;
 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();
 376     ssl_die("Failed to allocate X509_NAME object") if !$name;
 377     my $add_name_entry = sub {
 378         my ($k, $v) = @_;
 379
 380         my $res = Net::SSLeay::X509_NAME_add_entry_by_txt(
 381             $name, $k, &Net::SSLeay::MBSTRING_UTF8, encode('utf-8', $v));
 382
 383         $cleanup->("Failed to add '$k'='$v' to DN\n") if !$res;
 384     };
 385
 386     $add_name_entry->('CN', $common_name);
 387     for (qw(C ST L O OU)) {
 388         if (defined(my $v = $attr{$_})) {
 389             $add_name_entry->($_, $v);
 390         }
 391     }
 392
 393     if (defined($pem_key)) {
 394         my $bio_s_mem = Net::SSLeay::BIO_s_mem();
 395         $cleanup->("Failed to allocate BIO_s_mem for private key\n") if !$bio_s_mem;
 396
 397         $bio = Net::SSLeay::BIO_new($bio_s_mem);
 398         $cleanup->("Failed to allocate BIO for private key\n") if !$bio;
 399
 400         $cleanup->("Failed to write PEM-encoded key to BIO\n")
 401             if Net::SSLeay::BIO_write($bio, $pem_key) <= 0;
 402
 403         $pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
 404         $cleanup->("Failed to read private key into EVP_PKEY\n") if !$pk;
 405     } else {
 406         $pk = Net::SSLeay::EVP_PKEY_new();
 407         $cleanup->("Failed to allocate EVP_PKEY for private key\n") if !$pk;
 408
 409         my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
 410         $cleanup->("Failed to generate RSA key pair\n") if !$rsa;
 411
 412         $cleanup->("Failed to assign RSA key to EVP_PKEY\n")
 413             if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa);
 414     }
 415
 416     $req = Net::SSLeay::X509_REQ_new();
 417     $cleanup->("Failed to allocate X509_REQ\n") if !$req;
 418
 419     $cleanup->("Failed to set subject name\n")
 420         if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));
 421
 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),
 428     ) or $cleanup->("Failed to add extensions to CSR\n");
 429
 430     $cleanup->("Failed to set public key\n") if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
 431
 432     $cleanup->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 2);
 433
 434     $cleanup->("Failed to sign CSR\n") if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
 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
 439     $cleanup->(undef, 1);
 440
 441     return wantarray ? ($req_pem, $pk_pem) : $req_pem;
 442 }
 443
 444 1;