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;