]> 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 da8dab48ca8369c43ff3475230e35eb8448a3e33..39708c84fe838a132236e132e7d726d08f73825d 100644 (file)
@@ -8,9 +8,9 @@ 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;
@@ -90,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);
     };
 
@@ -133,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";
@@ -247,7 +247,7 @@ sub gen_pve_ssl_cert {
     my $rc = PVE::INotify::read_file('resolvconf');
 
     $names .= ",IP:$ip";
-  
+
     my $fqdn = $nodename;
 
     $names .= ",DNS:$nodename";
@@ -547,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);
@@ -652,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 = [];
@@ -682,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";
@@ -816,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);
@@ -825,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";
 
@@ -896,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
@@ -985,12 +985,12 @@ sub log_msg {
 
 sub check_vmid_unused {
     my ($vmid, $noerr) = @_;
-    
+
     my $vmlist = get_vmlist();
 
     my $d = $vmlist->{ids}->{$vmid};
     return 1 if !defined($d);
-    
+
     return undef if $noerr;
 
     my $vmtypestr =  $d->{type} eq 'qemu' ? 'VM' : 'CT';
@@ -1063,11 +1063,11 @@ sub get_local_migration_ip {
     if (defined($cidr)) {
        my $ips = PVE::Network::get_local_ip_from_cidr($cidr);
 
-       die "no IP address configured on local node for network '$cidr'\n" 
-           if !$noerr && (scalar(@$ips) == 0);
+       die "could not get migration ip: no IP address configured on local " .
+           "node for network '$cidr'\n" if !$noerr && (scalar(@$ips) == 0);
 
-       die "multiple IP address configured for network '$cidr'\n" 
-           if !$noerr && (scalar(@$ips) > 1);
+       die "could not get migration ip: multiple IP address configured for " .
+           "network '$cidr'\n" if !$noerr && (scalar(@$ips) > 1);
 
        return @$ips[0];
     }
@@ -1121,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 {
@@ -1173,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) {
@@ -1208,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) {
@@ -1217,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);
     }
@@ -1312,8 +1314,8 @@ 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;
 
 }
@@ -1327,7 +1329,6 @@ my $migration_format = {
          "default. On secure, completely private networks this can be " .
          "disabled to increase performance.",
        default => 'secure',
-       format_description => 'migration type',
     },
     network => {
        optional => 1,
@@ -1446,8 +1447,8 @@ sub write_datacenter_config {
     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 ...
@@ -1463,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];
 
@@ -1494,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;
 
@@ -1511,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 {
@@ -1534,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}};
@@ -1570,7 +1571,7 @@ sub corosync_conf_version {
            }
        }
     }
-    
+
     return undef if $noerr;
 
     die "invalid corosync config - unable to read version\n";
@@ -1579,7 +1580,7 @@ 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 {
@@ -1595,6 +1596,210 @@ sub check_corosync_conf_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 {