]> git.proxmox.com Git - pve-cluster.git/blobdiff - data/PVE/Cluster.pm
Remove depency to libxml-parser-perl
[pve-cluster.git] / data / PVE / Cluster.pm
index 5860ed94475424f81fa78a661f95a0291fbc87b1..39708c84fe838a132236e132e7d726d08f73825d 100644 (file)
@@ -8,17 +8,19 @@ use Socket;
 use Storable qw(dclone);
 use IO::File;
 use MIME::Base64;
-use XML::Parser;
 use Digest::SHA;
 use Digest::HMAC_SHA1;
+use Net::SSLeay;
 use PVE::Tools;
 use PVE::INotify;
 use PVE::IPCC;
 use PVE::SafeSyslog;
 use PVE::JSONSchema;
+use PVE::Network;
 use JSON;
 use RRDs;
 use Encode;
+use UUID;
 use base 'Exporter';
 
 our @EXPORT_OK = qw(
@@ -72,6 +74,7 @@ my $observed = {
     'ha/manager_status' => 1,
     'ha/resources.cfg' => 1,
     'ha/groups.cfg' => 1,
+    'ha/fence.cfg' => 1,
     'status.cfg' => 1,
 };
 
@@ -87,7 +90,7 @@ sub run_silent_cmd {
     };
 
     eval {
-       PVE::Tools::run_command($cmd, outfunc => $record_output, 
+       PVE::Tools::run_command($cmd, outfunc => $record_output,
                                errfunc => $record_output);
     };
 
@@ -130,13 +133,13 @@ sub gen_local_dirs {
 
     my @required_dirs = (
        "$basedir/priv",
-       "$basedir/nodes", 
+       "$basedir/nodes",
        "$basedir/nodes/$nodename",
        "$basedir/nodes/$nodename/lxc",
        "$basedir/nodes/$nodename/qemu-server",
        "$basedir/nodes/$nodename/openvz",
        "$basedir/nodes/$nodename/priv");
-              
+
     foreach my $dir (@required_dirs) {
        if (! -d $dir) {
            mkdir($dir) || $! == EEXIST || die "unable to create directory '$dir' - $!\n";
@@ -152,11 +155,9 @@ sub gen_auth_key {
 
     mkdir $authdir || $! == EEXIST || die "unable to create dir '$authdir' - $!\n";
 
-    my $cmd = "openssl genrsa -out '$authprivkeyfn' 2048";
-    run_silent_cmd($cmd);
+    run_silent_cmd(['openssl', 'genrsa', '-out', $authprivkeyfn, '2048']);
 
-    $cmd = "openssl rsa -in '$authprivkeyfn' -pubout -out '$authpubkeyfn'";
-    run_silent_cmd($cmd)
+    run_silent_cmd(['openssl', 'rsa', '-in', $authprivkeyfn, '-pubout', '-out', $authpubkeyfn]);
 }
 
 sub gen_pveca_key {
@@ -164,7 +165,7 @@ sub gen_pveca_key {
     return if -f $pveca_key_fn;
 
     eval {
-       run_silent_cmd(['openssl', 'genrsa', '-out', $pveca_key_fn, '2048']);
+       run_silent_cmd(['openssl', 'genrsa', '-out', $pveca_key_fn, '4096']);
     };
 
     die "unable to generate pve ca key:\n$@" if $@;
@@ -180,13 +181,17 @@ sub gen_pveca_cert {
 
     # we try to generate an unique 'subject' to avoid browser problems
     # (reused serial numbers, ..)
-    my $nid = (split (/\s/, `md5sum '$pveca_key_fn'`))[0] || time();
+    my $uuid;
+    UUID::generate($uuid);
+    my $uuid_str;
+    UUID::unparse($uuid, $uuid_str);
 
     eval {
-       run_silent_cmd(['openssl', 'req', '-batch', '-days', '3650', '-new',
-                       '-x509', '-nodes', '-key',
+       # wrap openssl with faketime to prevent bug #904
+       run_silent_cmd(['faketime', 'yesterday', 'openssl', 'req', '-batch',
+                       '-days', '3650', '-new', '-x509', '-nodes', '-key',
                        $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
-                       "/CN=Proxmox Virtual Environment/OU=$nid/O=PVE Cluster Manager CA/"]);
+                       "/CN=Proxmox Virtual Environment/OU=$uuid_str/O=PVE Cluster Manager CA/"]);
     };
 
     die "generating pve root certificate failed:\n$@" if $@;
@@ -242,7 +247,7 @@ sub gen_pve_ssl_cert {
     my $rc = PVE::INotify::read_file('resolvconf');
 
     $names .= ",IP:$ip";
-  
+
     my $fqdn = $nodename;
 
     $names .= ",DNS:$nodename";
@@ -270,8 +275,7 @@ commonName = $fqdn
 
 [ v3_req ]
 basicConstraints = CA:FALSE
-nsCertType = server
-keyUsage = nonRepudiation, digitalSignature, keyEncipherment
+extendedKeyUsage = serverAuth
 subjectAltName = $names
 __EOD
 
@@ -298,10 +302,11 @@ __EOD
     update_serial("0000000000000000") if ! -f $pveca_srl_fn;
 
     eval {
-       run_silent_cmd(['openssl', 'x509', '-req', '-in', $reqfn, '-days', '3650',
-                       '-out', $pvessl_cert_fn, '-CAkey', $pveca_key_fn,
-                       '-CA', $pveca_cert_fn, '-CAserial', $pveca_srl_fn,
-                       '-extfile', $cfgfn]);
+       # wrap openssl with faketime to prevent bug #904
+       run_silent_cmd(['faketime', 'yesterday', 'openssl', 'x509', '-req',
+                       '-in', $reqfn, '-days', '3650', '-out', $pvessl_cert_fn,
+                       '-CAkey', $pveca_key_fn, '-CA', $pveca_cert_fn,
+                       '-CAserial', $pveca_srl_fn, '-extfile', $cfgfn]);
     };
 
     if (my $err = $@) {
@@ -542,7 +547,7 @@ sub get_tasklist {
        eval {
            my $ver = $kvstore->{$node}->{tasklist} if $kvstore->{$node};
            my $cd = $tasklistcache->{$node};
-           if (!$cd || !$ver || !$cd->{version} || 
+           if (!$cd || !$ver || !$cd->{version} ||
                ($cd->{version} != $ver)) {
                my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
                my $data = decode_json($raw);
@@ -647,8 +652,8 @@ sub create_rrd_data {
 
     my $err = RRDs::error;
     die "RRD error: $err\n" if $err;
-    
-    die "got wrong time resolution ($step != $reso)\n" 
+
+    die "got wrong time resolution ($step != $reso)\n"
        if $step != $reso;
 
     my $res = [];
@@ -656,18 +661,16 @@ sub create_rrd_data {
     for my $line (@$data) {
        my $entry = { 'time' => $start };
        $start += $step;
-       my $found_undefs;
        for (my $i = 0; $i < $fields; $i++) {
            my $name = $names->[$i];
            if (defined(my $val = $line->[$i])) {
                $entry->{$name} = $val;
            } else {
-               # we only add entryies with all data defined
-               # extjs chart has problems with undefined values
-               $found_undefs = 1;
+               # leave empty fields undefined
+               # maybe make this configurable?
            }
        }
-       push @$res, $entry if !$found_undefs;
+       push @$res, $entry;
     }
 
     return $res;
@@ -679,7 +682,7 @@ sub create_rrd_graph {
     # Using RRD graph is clumsy - maybe it
     # is better to simply fetch the data, and do all display
     # related things with javascript (new extjs html5 graph library).
-       
+
     my $rrddir = "/var/lib/rrdcached/db";
 
     my $rrd = "$rrddir/$rrdname";
@@ -707,6 +710,7 @@ sub create_rrd_graph {
        "--width" => 800,
        "--start" => - $reso*$count,
        "--end" => 'now' ,
+       "--lower-limit" => 0,
        );
 
     my $socket = "/var/run/rrdcached.sock";
@@ -812,7 +816,7 @@ sub cfs_file_version {
 sub cfs_read_file {
     my ($filename) = @_;
 
-    my ($version, $info) = cfs_file_version($filename); 
+    my ($version, $info) = cfs_file_version($filename);
     my $parser = $info->{parser};
 
     return &$ccache_read($filename, $parser, $version);
@@ -821,7 +825,7 @@ sub cfs_read_file {
 sub cfs_write_file {
     my ($filename, $data) = @_;
 
-    my ($version, $info) = cfs_file_version($filename); 
+    my ($version, $info) = cfs_file_version($filename);
 
     my $writer = $info->{writer} || die "no writer defined";
 
@@ -892,7 +896,7 @@ my $cfs_lock = sub {
     if ($err && ($err eq "got lock request timeout\n") &&
        !check_cfs_quorum()){
        $err = "$msg: no quorum!\n";
-    }  
+    }
 
     if (!$err || $err !~ /^got lock timeout -/) {
        rmdir $filename; # cfs unlock
@@ -927,6 +931,14 @@ sub cfs_lock_storage {
     &$cfs_lock($lockid, $timeout, $code, @param);
 }
 
+sub cfs_lock_domain {
+    my ($domainname, $timeout, $code, @param) = @_;
+
+    my $lockid = "domain-$domainname";
+
+    &$cfs_lock($lockid, $timeout, $code, @param);
+}
+
 my $log_levels = {
     "emerg" => 0,
     "alert" => 1,
@@ -955,12 +967,10 @@ sub log_msg {
    $msg = "empty message" if !$msg;
 
    $ident = "" if !$ident;
-   $ident = encode("ascii", decode_utf8($ident),
+   $ident = encode("ascii", $ident,
                   sub { sprintf "\\u%04x", shift });
 
-   my $utf8 = decode_utf8($msg);
-
-   my $ascii = encode("ascii", $utf8, sub { sprintf "\\u%04x", shift });
+   my $ascii = encode("ascii", $msg, sub { sprintf "\\u%04x", shift });
 
    if ($ident) {
        syslog($priority, "<%s> %s", $ident, $ascii);
@@ -975,25 +985,16 @@ sub log_msg {
 
 sub check_vmid_unused {
     my ($vmid, $noerr) = @_;
-    
+
     my $vmlist = get_vmlist();
-    my $node = PVE::INotify::nodename();
 
     my $d = $vmlist->{ids}->{$vmid};
     return 1 if !defined($d);
-    
-    return undef if $noerr;
 
-    my $msg = "$vmid already exists";
-    my $msg_cluster = "$msg on cluster node '$d->{node}'";
+    return undef if $noerr;
 
-    if ($d->{node} eq $node) {
-       die "VM $msg\n" if $d->{type} eq 'qemu';
-       die "CT $msg\n";
-    } else {
-        die "VM $msg_cluster\n" if $d->{type} eq 'qemu';
-        die "CT $msg_cluster\n";
-    }
+    my $vmtypestr =  $d->{type} eq 'qemu' ? 'VM' : 'CT';
+    die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
 }
 
 sub check_node_exists {
@@ -1048,6 +1049,32 @@ sub remote_node_ip {
     return wantarray ? ($ip, $family) : $ip;
 }
 
+sub get_local_migration_ip {
+    my ($migration_network, $noerr) = @_;
+
+    my $cidr = $migration_network;
+
+    if (!defined($cidr)) {
+       my $dc_conf = cfs_read_file('datacenter.cfg');
+       $cidr = $dc_conf->{migration}->{network}
+         if defined($dc_conf->{migration}->{network});
+    }
+
+    if (defined($cidr)) {
+       my $ips = PVE::Network::get_local_ip_from_cidr($cidr);
+
+       die "could not get migration ip: no IP address configured on local " .
+           "node for network '$cidr'\n" if !$noerr && (scalar(@$ips) == 0);
+
+       die "could not get migration ip: multiple IP address configured for " .
+           "network '$cidr'\n" if !$noerr && (scalar(@$ips) > 1);
+
+       return @$ips[0];
+    }
+
+    return undef;
+};
+
 # ssh related utility functions
 
 sub ssh_merge_keys {
@@ -1094,19 +1121,21 @@ sub ssh_merge_keys {
 }
 
 sub setup_sshd_config {
+    my ($start_sshd) = @_;
 
     my $conf = PVE::Tools::file_get_contents($sshd_config_fn);
-    
+
     return if $conf =~ m/^PermitRootLogin\s+yes\s*$/m;
 
     if ($conf !~ s/^#?PermitRootLogin.*$/PermitRootLogin yes/m) {
        chomp $conf;
        $conf .= "\nPermitRootLogin yes\n";
-    } 
+    }
 
     PVE::Tools::file_set_contents($sshd_config_fn, $conf);
 
-    PVE::Tools::run_command(['systemctl', 'reload-or-restart', 'sshd']);
+    my $cmd = $start_sshd ? 'reload-or-restart' : 'reload-or-try-restart';
+    PVE::Tools::run_command(['systemctl', $cmd, 'sshd']);
 }
 
 sub setup_rootsshconfig {
@@ -1146,7 +1175,7 @@ sub setup_ssh_keys {
        }
     }
 
-    warn "can't create shared ssh key database '$sshauthkeys'\n" 
+    warn "can't create shared ssh key database '$sshauthkeys'\n"
        if ! -f $sshauthkeys;
 
     if (-f $rootsshauthkeys && ! -l $rootsshauthkeys) {
@@ -1181,7 +1210,7 @@ sub ssh_merge_known_hosts {
 
     die "no node name specified" if !$nodename;
     die "no ip address specified" if !$ip_address;
-   
+
     mkdir $authdir;
 
     if (! -f $sshknownhosts) {
@@ -1190,10 +1219,10 @@ sub ssh_merge_known_hosts {
        }
     }
 
-    my $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024); 
-    
+    my $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024);
+
     my $new = '';
-    
+
     if ((! -l $sshglobalknownhosts) && (-f $sshglobalknownhosts)) {
        $new = PVE::Tools::file_get_contents($sshglobalknownhosts, 128*1024);
     }
@@ -1285,12 +1314,30 @@ sub ssh_merge_known_hosts {
 
     unlink $sshglobalknownhosts;
     symlink $sshknownhosts, $sshglobalknownhosts;
-    warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n" 
+
+    warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
        if ! -l $sshglobalknownhosts;
 
 }
 
+my $migration_format = {
+    type => {
+       default_key => 1,
+       type => 'string',
+       enum => ['secure', 'insecure'],
+       description => "Migration traffic is encrypted using an SSH tunnel by " .
+         "default. On secure, completely private networks this can be " .
+         "disabled to increase performance.",
+       default => 'secure',
+    },
+    network => {
+       optional => 1,
+       type => 'string', format => 'CIDR',
+       format_description => 'CIDR',
+       description => "CIDR of the (sub) network that is used for migration."
+    },
+};
+
 my $datacenter_schema = {
     type => "object",
     additionalProperties => 0,
@@ -1316,7 +1363,14 @@ my $datacenter_schema = {
        migration_unsecure => {
            optional => 1,
            type => 'boolean',
-           description => "Migration is secure using SSH tunnel by default. For secure private networks you can disable it to speed up migration.",
+           description => "Migration is secure using SSH tunnel by default. " .
+             "For secure private networks you can disable it to speed up " .
+             "migration. Deprecated, use the 'migration' property instead!",
+       },
+       migration => {
+           optional => 1,
+           type => 'string', format => $migration_format,
+           description => "For cluster wide migration settings.",
        },
        console => {
            optional => 1,
@@ -1330,6 +1384,29 @@ my $datacenter_schema = {
            format => 'email-opt',
            description => "Specify email address to send notification from (default is root@\$hostname)",
        },
+       max_workers => {
+           optional => 1,
+           type => 'integer',
+           minimum => 1,
+           description => "Defines how many workers (per node) are maximal started ".
+             " on actions like 'stopall VMs' or task from the ha-manager.",
+       },
+       fencing => {
+           optional => 1,
+           type => 'string',
+           default => 'watchdog',
+           enum => [ 'watchdog', 'hardware', 'both' ],
+           description => "Set the fencing mode of the HA cluster. Hardware mode " .
+             "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
+             " With both all two modes are used." .
+             "\n\nWARNING: 'hardware' and 'both' are EXPERIMENTAL & WIP",
+       },
+       mac_prefix => {
+           optional => 1,
+           type => 'string',
+           pattern => qr/[a-f0-9]{2}(?::[a-f0-9]{2}){0,2}:?/i,
+           description => 'Prefix for autogenerated MAC addresses.',
+       },
     },
 };
 
@@ -1339,17 +1416,39 @@ sub get_datacenter_schema { return $datacenter_schema };
 sub parse_datacenter_config {
     my ($filename, $raw) = @_;
 
-    return PVE::JSONSchema::parse_config($datacenter_schema, $filename, $raw // '');
+    my $res = PVE::JSONSchema::parse_config($datacenter_schema, $filename, $raw // '');
+
+    if (my $migration = $res->{migration}) {
+       $res->{migration} = PVE::JSONSchema::parse_property_string($migration_format, $migration);
+    }
+
+    # for backwards compatibility only, new migration property has precedence
+    if (defined($res->{migration_unsecure})) {
+       if (defined($res->{migration}->{type})) {
+           warn "deprecated setting 'migration_unsecure' and new 'migration: type' " .
+             "set at same time! Ignore 'migration_unsecure'\n";
+       } else {
+           $res->{migration}->{type} = ($res->{migration_unsecure}) ? 'insecure' : 'secure';
+       }
+    }
+
+    return $res;
 }
 
 sub write_datacenter_config {
     my ($filename, $cfg) = @_;
-    
+
+    # map deprecated setting to new one
+    if (defined($cfg->{migration_unsecure}) && !defined($cfg->{migration})) {
+       my $migration_unsecure = delete $cfg->{migration_unsecure};
+       $cfg->{migration}->{type} = ($migration_unsecure) ? 'insecure' : 'secure';
+    }
+
     return PVE::JSONSchema::dump_config($datacenter_schema, $filename, $cfg);
 }
 
-cfs_register_file('datacenter.cfg', 
-                 \&parse_datacenter_config,  
+cfs_register_file('datacenter.cfg',
+                 \&parse_datacenter_config,
                  \&write_datacenter_config);
 
 # a very simply parser ...
@@ -1365,14 +1464,14 @@ sub parse_corosync_conf {
     $raw =~ s/\s+/ /g;
     $raw =~ s/^\s+//;
     $raw =~ s/\s*$//;
-  
+
     my @tokens = split(/\s/, $raw);
-    
+
     my $conf = { section => 'main', children => [] };
 
     my $stack = [];
     my $section = $conf;
-    
+
     while (defined(my $token = shift @tokens)) {
        my $nexttok = $tokens[0];
 
@@ -1396,7 +1495,7 @@ sub parse_corosync_conf {
 
        my $key = $token;
        die "missing ':' after key '$key'\n" if ! ($key =~ s/:$//);
-       
+
        die "parse error - no value for '$key'\n" if !defined($nexttok);
        my $value = shift @tokens;
 
@@ -1413,21 +1512,21 @@ $dump_corosync_section = sub {
     my ($section, $prefix) = @_;
 
     my $raw = $prefix . $section->{section} . " {\n";
-    
+
     my @list = grep { defined($_->{key}) } @{$section->{children}};
     foreach my $child (sort {$a->{key} cmp $b->{key}} @list) {
        $raw .= $prefix . "  $child->{key}: $child->{value}\n";
     }
-    
+
     @list = grep { defined($_->{section}) } @{$section->{children}};
     foreach my $child (sort {$a->{section} cmp $b->{section}} @list) {
        $raw .= &$dump_corosync_section($child, "$prefix  ");
     }
 
     $raw .= $prefix . "}\n\n";
-    
+
     return $raw;
-    
+
 };
 
 sub write_corosync_conf {
@@ -1436,7 +1535,7 @@ sub write_corosync_conf {
     my $raw = '';
 
     my $prefix = '';
-    
+
     die "no main section" if $conf->{section} ne 'main';
 
     my @list = grep { defined($_->{key}) } @{$conf->{children}};
@@ -1472,7 +1571,7 @@ sub corosync_conf_version {
            }
        }
     }
-    
+
     return undef if $noerr;
 
     die "invalid corosync config - unable to read version\n";
@@ -1481,9 +1580,226 @@ sub corosync_conf_version {
 # read only - use "rename corosync.conf.new corosync.conf" to write
 PVE::Cluster::cfs_register_file('corosync.conf', \&parse_corosync_conf);
 # this is read/write
-PVE::Cluster::cfs_register_file('corosync.conf.new', \&parse_corosync_conf, 
+PVE::Cluster::cfs_register_file('corosync.conf.new', \&parse_corosync_conf,
                                \&write_corosync_conf);
 
+sub check_corosync_conf_exists {
+    my ($silent) = @_;
+
+    $silent = $silent // 0;
+
+    my $exists = -f "$basedir/corosync.conf";
+
+    warn "Corosync config '$basedir/corosync.conf' does not exist - is this node part of a cluster?\n"
+       if !$silent && !$exists;
+
+    return $exists;
+}
+
+sub corosync_update_nodelist {
+    my ($conf, $nodelist) = @_;
+
+    delete $conf->{digest};
+
+    my $version = corosync_conf_version($conf);
+    corosync_conf_version($conf, undef, $version + 1);
+
+    my $children = [];
+    foreach my $v (values %$nodelist) {
+       next if !($v->{ring0_addr} || $v->{name});
+       my $kv = [];
+       foreach my $k (keys %$v) {
+           push @$kv, { key => $k, value => $v->{$k} };
+       }
+       my $ns = { section => 'node', children => $kv };
+       push @$children, $ns;
+    }
+
+    foreach my $main (@{$conf->{children}}) {
+       next if !defined($main->{section});
+       if ($main->{section} eq 'nodelist') {
+           $main->{children} = $children;
+           last;
+       }
+    }
+
+
+    cfs_write_file("corosync.conf.new", $conf);
+
+    rename("/etc/pve/corosync.conf.new", "/etc/pve/corosync.conf")
+       || die "activate  corosync.conf.new failed - $!\n";
+}
+
+sub corosync_nodelist {
+    my ($conf) = @_;
+
+    my $nodelist = {};
+
+    foreach my $main (@{$conf->{children}}) {
+       next if !defined($main->{section});
+       if ($main->{section} eq 'nodelist') {
+           foreach my $ne (@{$main->{children}}) {
+               next if !defined($ne->{section}) || ($ne->{section} ne 'node');
+               my $node = { quorum_votes => 1 };
+               my $name;
+               foreach my $child (@{$ne->{children}}) {
+                   next if !defined($child->{key});
+                   $node->{$child->{key}} = $child->{value};
+                   # use 'name' over 'ring0_addr' if set
+                   if ($child->{key} eq 'name') {
+                       delete $nodelist->{$name} if $name;
+                       $name = $child->{value};
+                       $nodelist->{$name} = $node;
+                   } elsif(!$name && $child->{key} eq 'ring0_addr') {
+                       $name = $child->{value};
+                       $nodelist->{$name} = $node;
+                   }
+               }
+           }
+       }
+    }
+
+    return $nodelist;
+}
+
+# get a hash representation of the corosync config totem section
+sub corosync_totem_config {
+    my ($conf) = @_;
+
+    my $res = {};
+
+    foreach my $main (@{$conf->{children}}) {
+       next if !defined($main->{section}) ||
+           $main->{section} ne 'totem';
+
+       foreach my $e (@{$main->{children}}) {
+
+           if ($e->{section} && $e->{section} eq 'interface') {
+               my $entry = {};
+
+               $res->{interface} = {};
+
+               foreach my $child (@{$e->{children}}) {
+                   next if !defined($child->{key});
+                   $entry->{$child->{key}} = $child->{value};
+                   if($child->{key} eq 'ringnumber') {
+                       $res->{interface}->{$child->{value}} = $entry;
+                   }
+               }
+
+           } elsif  ($e->{key}) {
+               $res->{$e->{key}} = $e->{value};
+           }
+       }
+    }
+
+    return $res;
+}
+
+# X509 Certificate cache helper
+
+my $cert_cache_nodes = {};
+my $cert_cache_timestamp = time();
+my $cert_cache_fingerprints = {};
+
+sub update_cert_cache {
+    my ($update_node, $clear) = @_;
+
+    syslog('info', "Clearing outdated entries from certificate cache")
+       if $clear;
+
+    $cert_cache_timestamp = time() if !defined($update_node);
+
+    my $node_list = defined($update_node) ?
+       [ $update_node ] : [ keys %$cert_cache_nodes ];
+
+    foreach my $node (@$node_list) {
+       my $clear_old = sub {
+           if (my $old_fp = $cert_cache_nodes->{$node}) {
+               # distrust old fingerprint
+               delete $cert_cache_fingerprints->{$old_fp};
+               # ensure reload on next proxied request
+               delete $cert_cache_nodes->{$node};
+           }
+       };
+
+       my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
+       my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
+
+       $cert_path = $custom_cert_path if -f $custom_cert_path;
+
+       my $cert;
+       eval {
+           my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r');
+           $cert = Net::SSLeay::PEM_read_bio_X509($bio);
+           Net::SSLeay::BIO_free($bio);
+       };
+       my $err = $@;
+       if ($err || !defined($cert)) {
+           &$clear_old() if $clear;
+           next;
+       }
+
+       my $fp;
+       eval {
+           $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
+       };
+       $err = $@;
+       if ($err || !defined($fp) || $fp eq '') {
+           &$clear_old() if $clear;
+           next;
+       }
+
+       my $old_fp = $cert_cache_nodes->{$node};
+       $cert_cache_fingerprints->{$fp} = 1;
+       $cert_cache_nodes->{$node} = $fp;
+
+       if (defined($old_fp) && $fp ne $old_fp) {
+           delete $cert_cache_fingerprints->{$old_fp};
+       }
+    }
+}
+
+# load and cache cert fingerprint once
+sub initialize_cert_cache {
+    my ($node) = @_;
+
+    update_cert_cache($node)
+       if defined($node) && !defined($cert_cache_nodes->{$node});
+}
+
+sub check_cert_fingerprint {
+    my ($cert) = @_;
+
+    # clear cache every 30 minutes at least
+    update_cert_cache(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
+
+    # get fingerprint of server certificate
+    my $fp;
+    eval {
+       $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
+    };
+    return 0 if $@ || !defined($fp) || $fp eq ''; # error
+
+    my $check = sub {
+       for my $expected (keys %$cert_cache_fingerprints) {
+           return 1 if $fp eq $expected;
+       }
+       return 0;
+    };
+
+    return 1 if &$check();
+
+    # clear cache and retry at most once every minute
+    if (time() - $cert_cache_timestamp >= 60) {
+       syslog ('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
+       update_cert_cache();
+       return &$check();
+    }
+
+    return 0;
+}
+
 # bash completion helpers
 
 sub complete_next_vmid {