package PVE::Cluster;
use strict;
-use POSIX;
+use warnings;
+use POSIX qw(EEXIST ENOENT);
use File::stat qw();
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(
my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
my $sshknownhosts = "/etc/pve/priv/known_hosts";
my $sshauthkeys = "/etc/pve/priv/authorized_keys";
+my $sshd_config_fn = "/etc/ssh/sshd_config";
my $rootsshauthkeys = "/root/.ssh/authorized_keys";
my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
my $rootsshconfig = "/root/.ssh/config";
'vzdump.cron' => 1,
'storage.cfg' => 1,
'datacenter.cfg' => 1,
- 'cluster.conf' => 1,
- 'cluster.conf.new' => 1,
+ 'replication.cfg' => 1,
+ 'corosync.conf' => 1,
+ 'corosync.conf.new' => 1,
'user.cfg' => 1,
'domains.cfg' => 1,
'priv/shadow.cfg' => 1,
'/qemu-server/' => 1,
'/openvz/' => 1,
+ '/lxc/' => 1,
+ 'ha/crm_commands' => 1,
+ 'ha/manager_status' => 1,
+ 'ha/resources.cfg' => 1,
+ 'ha/groups.cfg' => 1,
+ 'ha/fence.cfg' => 1,
+ 'status.cfg' => 1,
};
# only write output if something fails
};
eval {
- PVE::Tools::run_command($cmd, outfunc => $record_output,
+ PVE::Tools::run_command($cmd, outfunc => $record_output,
errfunc => $record_output);
};
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) || die "unable to create directory '$dir' - $!\n";
+ mkdir($dir) || $! == EEXIST || die "unable to create directory '$dir' - $!\n";
}
}
}
check_cfs_is_mounted();
- -d $authdir || mkdir $authdir || die "unable to create dir '$authdir' - $!\n";
+ 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 {
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 $@;
# 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 $@;
return if !$force && -f $pvessl_cert_fn;
- my $names = "IP:127.0.0.1,DNS:localhost";
+ my $names = "IP:127.0.0.1,IP:::1,DNS:localhost";
my $rc = PVE::INotify::read_file('resolvconf');
$names .= ",IP:$ip";
-
+
my $fqdn = $nodename;
$names .= ",DNS:$nodename";
[ v3_req ]
basicConstraints = CA:FALSE
-nsCertType = server
-keyUsage = nonRepudiation, digitalSignature, keyEncipherment
+extendedKeyUsage = serverAuth
subjectAltName = $names
__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 = $@) {
my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
- die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
+ die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
return $res;
};
my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
- die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
+ die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
return decode_json($res);
};
my $bindata = pack "Z*", $path;
my $res = PVE::IPCC::ipcc_send_rec(6, $bindata);
if (!defined($res)) {
- return undef if ($! != 0);
+ if ($! != 0) {
+ return undef if $! == ENOENT;
+ die "$!\n";
+ }
return '';
}
my $ccache = {};
sub cfs_update {
+ my ($fail) = @_;
eval {
my $res = &$ipcc_send_rec_json(1);
#warn "GOT1: " . Dumper($res);
$vmlist = {};
$clinfo = {};
$ccache = {};
+ die $err if $fail;
warn $err;
}
$err = $@;
if ($err) {
$clinfo = {};
+ die $err if $fail;
warn $err;
}
$err = $@;
if ($err) {
$vmlist = {};
+ die $err if $fail;
warn $err;
}
}
return [ keys %$nodelist ];
}
+# $data must be a chronological descending ordered array of tasks
sub broadcast_tasklist {
my ($data) = @_;
+ # the serialized list may not get bigger than 32kb (CFS_MAX_STATUS_SIZE
+ # from pmxcfs) - drop older items until we satisfy this constraint
+ my $size = length(encode_json($data));
+ while ($size >= (32 * 1024)) {
+ pop @$data;
+ $size = length(encode_json($data));
+ }
+
eval {
&$ipcc_update_status("tasklist", $data);
};
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);
my $res = {};
- while ($raw =~ s/^(.*)\n//) {
- my ($key, @ela) = split(/:/, $1);
- next if !$key;
- next if !(scalar(@ela) > 1);
- $res->{$key} = \@ela;
+ if ($raw) {
+ while ($raw =~ s/^(.*)\n//) {
+ my ($key, @ela) = split(/:/, $1);
+ next if !$key;
+ next if !(scalar(@ela) > 1);
+ $res->{$key} = [ map { $_ eq 'U' ? undef : $_ } @ela ];
+ }
}
$last_rrd_dump = $ctime;
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 = [];
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;
# 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";
"--width" => 800,
"--start" => - $reso*$count,
"--end" => 'now' ,
+ "--lower-limit" => 0,
);
my $socket = "/var/run/rrdcached.sock";
push @args, '--full-size-mode';
# we do not really store data into the file
- my $res = RRDs::graphv('', @args);
+ my $res = RRDs::graphv('-', @args);
my $err = RRDs::error;
die "RRD error: $err\n" if $err;
my $version;
my $infotag;
- if ($filename =~ m!^nodes/[^/]+/(openvz|qemu-server)/(\d+)\.conf$!) {
+ if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) {
my ($type, $vmid) = ($1, $2);
if ($vmlist && $vmlist->{ids} && $vmlist->{ids}->{$vmid}) {
$version = $vmlist->{ids}->{$vmid}->{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);
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";
alarm(60);
local $SIG{ALRM} = sub { die "got lock timeout - aborting command\n"; };
+ cfs_update(); # make sure we read latest versions inside code()
+
$res = &$code(@param);
alarm(0);
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
&$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,
$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);
syslog("err", "writing cluster log failed: $@") if $@;
}
+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';
+ die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
+}
+
sub check_node_exists {
my ($nodename, $noerr) = @_;
my $nodelist = $clinfo->{nodelist};
if ($nodelist && $nodelist->{$nodename}) {
if (my $ip = $nodelist->{$nodename}->{ip}) {
- return $ip;
+ return $ip if !wantarray;
+ my $family = $nodelist->{$nodename}->{address_family};
+ if (!$family) {
+ $nodelist->{$nodename}->{address_family} =
+ $family =
+ PVE::Tools::get_host_address_family($ip);
+ }
+ return wantarray ? ($ip, $family) : $ip;
}
}
# fallback: try to get IP by other means
- my $packed_ip = gethostbyname($nodename);
- if (defined $packed_ip) {
- my $ip = inet_ntoa($packed_ip);
+ return PVE::Network::get_ip_from_hostname($nodename, $noerr);
+}
- if ($ip =~ m/^127\./) {
- die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
- return undef;
- }
+sub get_local_migration_ip {
+ my ($migration_network, $noerr) = @_;
- return $ip;
+ 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});
}
- die "unable to get IP for node '$nodename' - node offline?\n" if !$noerr;
+ 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 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);
+
+ my $cmd = $start_sshd ? 'reload-or-restart' : 'reload-or-try-restart';
+ PVE::Tools::run_command(['systemctl', $cmd, 'sshd']);
+}
+
sub setup_rootsshconfig {
# create ssh key if it does not exist
if (! -f $rootsshconfig) {
mkdir '/root/.ssh';
if (my $fh = IO::File->new($rootsshconfig, O_CREAT|O_WRONLY|O_EXCL, 0640)) {
- # this is the default ciphers list from debian openssl0.9.8 except blowfish is added as prefered
- print $fh "Ciphers blowfish-cbc,aes128-ctr,aes192-ctr,aes256-ctr,arcfour256,arcfour128,aes128-cbc,3des-cbc\n";
+ # this is the default ciphers list from Debian's OpenSSH package (OpenSSH_7.4p1 Debian-10, OpenSSL 1.0.2k 26 Jan 2017)
+ # changed order to put AES before Chacha20 (most hardware has AESNI)
+ print $fh "Ciphers aes128-ctr,aes192-ctr,aes256-ctr,aes128-gcm\@openssh.com,aes256-gcm\@openssh.com,chacha20-poly1305\@openssh.com\n";
close($fh);
}
}
}
}
- 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) {
die "no node name specified" if !$nodename;
die "no ip address specified" if !$ip_address;
-
+
+ # ssh lowercases hostnames (aliases) before comparision, so we need too
+ $nodename = lc($nodename);
+ $ip_address = lc($ip_address);
+
mkdir $authdir;
if (! -f $sshknownhosts) {
}
}
- 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);
}
my $hostkey = PVE::Tools::file_get_contents($ssh_host_rsa_id);
- die "can't parse $ssh_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/;
+ # Note: file sometimes containe emty lines at start, so we use multiline match
+ die "can't parse $ssh_host_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/m;
$hostkey = $1;
my $data = '';
my $merge_line = sub {
my ($line, $all) = @_;
+ return if $line =~ m/^\s*$/; # skip empty lines
+ return if $line =~ m/^#/; # skip comments
+
if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
my $key = $1;
my $rsakey = $2;
}
return;
}
+ } else {
+ $key = lc($key); # avoid duplicate entries, ssh compares lowercased
+ if ($key eq $ip_address) {
+ $found_local_ip = 1 if $rsakey eq $hostkey;
+ } elsif ($key eq $nodename) {
+ $found_nodename = 1 if $rsakey eq $hostkey;
+ }
}
$data .= $line;
}
while ($old && $old =~ s/^((.*?)(\n|$))//) {
my $line = "$2\n";
- next if $line =~ m/^\s*$/; # skip empty lines
- next if $line =~ m/^#/; # skip comments
&$merge_line($line, 1);
}
while ($new && $new =~ s/^((.*?)(\n|$))//) {
my $line = "$2\n";
- next if $line =~ m/^\s*$/; # skip empty lines
- next if $line =~ m/^#/; # skip comments
&$merge_line($line);
}
- my $addIndex = $$;
- my $add_known_hosts_entry = sub {
- my ($name, $hostkey) = @_;
- $addIndex++;
- my $hmac = Digest::HMAC_SHA1->new("$addIndex" . time());
- my $b64salt = $hmac->b64digest . '=';
- $hmac = Digest::HMAC_SHA1->new(decode_base64($b64salt));
- $hmac->add($name);
- my $digest = $hmac->b64digest . '=';
- $data .= "|1|$b64salt|$digest $hostkey\n";
- };
-
- if (!$found_nodename || !$found_local_ip) {
- &$add_known_hosts_entry($nodename, $hostkey) if !$found_nodename;
- &$add_known_hosts_entry($ip_address, $hostkey) if !$found_local_ip;
- }
+ # add our own key if not already there
+ $data .= "$nodename $hostkey\n" if !$found_nodename;
+ $data .= "$ip_address $hostkey\n" if !$found_local_ip;
PVE::Tools::file_set_contents($sshknownhosts, $data);
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,
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,
+ type => 'string',
+ description => "Select the default Console viewer. You can either use the builtin java applet (VNC), an external virt-viewer comtatible application (SPICE), or an HTML5 based viewer (noVNC).",
+ enum => ['applet', 'vv', 'html5'],
+ },
+ email_from => {
+ optional => 1,
+ type => 'string',
+ 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.',
},
},
};
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);
-sub parse_cluster_conf {
- my ($filename, $raw) = @_;
+# X509 Certificate cache helper
- my $conf = {};
+my $cert_cache_nodes = {};
+my $cert_cache_timestamp = time();
+my $cert_cache_fingerprints = {};
- my $digest = Digest::SHA::sha1_hex(defined($raw) ? $raw : '');
+sub update_cert_cache {
+ my ($update_node, $clear) = @_;
- my $createNode = sub {
- my ($expat, $tag, %attrib) = @_;
- $expat->{NodeCount}++;
- return { text => $tag, id => $expat->{NodeCount}, %attrib };
- };
+ syslog('info', "Clearing outdated entries from certificate cache")
+ if $clear;
- my $handlers = {
- Init => sub {
- my $expat = shift;
- $expat->{NodeCount} = 0;
- $expat->{NodeStack} = [];
- $expat->{CurNode} = $expat->{Tree} = &$createNode($expat, 'root');
- },
- Final => sub {
- my $expat = shift;
- delete $expat->{CurNode};
- delete $expat->{NodeStack};
- $expat->{Tree};
- },
- Start => sub {
- my $expat = shift;
- my $tag = shift;
- my $parent = $expat->{CurNode};
- push @{ $expat->{NodeStack} }, $parent;
- my $node = &$createNode($expat, $tag, @_);
- push @{$expat->{CurNode}->{children}}, $node;
- $expat->{CurNode} = $node;
- },
- End => sub {
- my $expat = shift;
- my $tag = shift;
- my $node = pop @{ $expat->{NodeStack} };
- $expat->{CurNode} = $node;
- },
- };
-
- if ($raw) {
- my $parser = new XML::Parser(Handlers => $handlers);
- $conf = $parser->parse($raw);
- }
+ $cert_cache_timestamp = time() if !defined($update_node);
- $conf->{digest} = $digest;
+ my $node_list = defined($update_node) ?
+ [ $update_node ] : [ keys %$cert_cache_nodes ];
- return $conf;
-}
+ 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};
+ }
+ };
-sub cluster_conf_version {
- my ($conf, $noerr) = @_;
+ my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
+ my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
- if ($conf && $conf->{children} && $conf->{children}->[0]) {
- my $cluster = $conf->{children}->[0];
- if ($cluster && ($cluster->{text} eq 'cluster') &&
- $cluster->{config_version}) {
- if (my $version = int($cluster->{config_version})) {
- return wantarray ? ($version, $cluster) : $version;
- }
+ $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;
}
- }
- return undef if $noerr;
+ my $fp;
+ eval {
+ $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
+ };
+ $err = $@;
+ if ($err || !defined($fp) || $fp eq '') {
+ &$clear_old() if $clear;
+ next;
+ }
- die "no cluster config - unable to read version\n";
-}
+ my $old_fp = $cert_cache_nodes->{$node};
+ $cert_cache_fingerprints->{$fp} = 1;
+ $cert_cache_nodes->{$node} = $fp;
-sub cluster_conf_lookup_cluster_section {
- my ($conf, $noerr) = @_;
+ if (defined($old_fp) && $fp ne $old_fp) {
+ delete $cert_cache_fingerprints->{$old_fp};
+ }
+ }
+}
- my ($version, $cluster) = cluster_conf_version($conf, $noerr);
+# load and cache cert fingerprint once
+sub initialize_cert_cache {
+ my ($node) = @_;
- return $cluster;
+ update_cert_cache($node)
+ if defined($node) && !defined($cert_cache_nodes->{$node});
}
-sub cluster_conf_lookup_rm_section {
- my ($conf, $create, $noerr) = @_;
+sub check_cert_fingerprint {
+ my ($cert) = @_;
- my $cluster = cluster_conf_lookup_cluster_section($conf, $noerr);
- return undef if !$cluster;
+ # clear cache every 30 minutes at least
+ update_cert_cache(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
- my $rmsec;
- foreach my $child (@{$cluster->{children}}) {
- if ($child->{text} eq 'rm') {
- $rmsec = $child;
- }
- }
- if (!$rmsec) {
- if (!$create) {
- return undef if $noerr;
- die "no resource manager section\n";
+ # 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;
}
- $rmsec = { text => 'rm' };
- push @{$cluster->{children}}, $rmsec;
+ 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 $rmsec;
+ return 0;
}
-sub cluster_conf_lookup_pvevm {
- my ($conf, $create, $vmid, $noerr) = @_;
+# bash completion helpers
- my $rmsec = cluster_conf_lookup_rm_section($conf, $create, $noerr);
- return undef if !$rmsec;
+sub complete_next_vmid {
- my $vmref;
- foreach my $child (@{$rmsec->{children}}) {
- if ($child->{text} eq 'pvevm' && $child->{vmid} eq $vmid) {
- $vmref = $child;
- }
- }
+ my $vmlist = get_vmlist() || {};
+ my $idlist = $vmlist->{ids} || {};
- if (!$vmref) {
- if (!$create) {
- return undef if $noerr;
- die "unable to find service 'pvevm:$vmid'\n";
- }
- $vmref = { text => 'pvevm', vmid => $vmid };
- push @{$rmsec->{children}}, $vmref;
- } elsif ($create) {
- return undef if $noerr;
- die "unable to create service 'pvevm:$vmid' - already exists\n";
+ for (my $i = 100; $i < 10000; $i++) {
+ return [$i] if !defined($idlist->{$i});
}
- return $vmref;
+ return [];
}
-sub xml_escape_attrib {
- my ($data) = @_;
+sub complete_vmid {
- return '' if !defined($data);
+ my $vmlist = get_vmlist();
+ my $ids = $vmlist->{ids} || {};
- $data =~ s/&/&/sg;
- $data =~ s/</</sg;
- $data =~ s/>/>/sg;
- $data =~ s/"/"/sg;
-
- return $data;
+ return [ keys %$ids ];
}
-sub __cluster_conf_dump_node {
- my ($node, $indend) = @_;
-
- my $xml = '';
+sub complete_local_vmid {
- $indend = '' if !defined($indend);
+ my $vmlist = get_vmlist();
+ my $ids = $vmlist->{ids} || {};
- my $attribs = '';
+ my $nodename = PVE::INotify::nodename();
- foreach my $key (sort keys %$node) {
- my $value = $node->{$key};
- next if $key eq 'id' || $key eq 'text' || $key eq 'children';
- $attribs .= " $key=\"" . xml_escape_attrib($value) . "\"";
- }
-
- my $children = $node->{children};
-
- if ($children && scalar(@$children)) {
- $xml .= "$indend<$node->{text}$attribs>\n";
- my $childindend = "$indend ";
- foreach my $child (@$children) {
- $xml .= __cluster_conf_dump_node($child, $childindend);
- }
- $xml .= "$indend</$node->{text}>\n";
- } else {
- $xml .= "$indend<$node->{text}$attribs/>\n";
+ my $res = [];
+ foreach my $vmid (keys %$ids) {
+ my $d = $ids->{$vmid};
+ next if !$d->{node} || $d->{node} ne $nodename;
+ push @$res, $vmid;
}
- return $xml;
+ return $res;
}
-sub write_cluster_conf {
- my ($filename, $cfg) = @_;
+sub complete_migration_target {
- my $version = cluster_conf_version($cfg);
-
- my $res = "<?xml version=\"1.0\"?>\n";
+ my $res = [];
- $res .= __cluster_conf_dump_node($cfg->{children}->[0]);
+ my $nodename = PVE::INotify::nodename();
+
+ my $nodelist = get_nodelist();
+ foreach my $node (@$nodelist) {
+ next if $node eq $nodename;
+ push @$res, $node;
+ }
return $res;
}
-# read only - use "rename cluster.conf.new cluster.conf" to write
-PVE::Cluster::cfs_register_file('cluster.conf', \&parse_cluster_conf);
-# this is read/write
-PVE::Cluster::cfs_register_file('cluster.conf.new', \&parse_cluster_conf,
- \&write_cluster_conf);
+sub get_ssh_info {
+ my ($node, $network_cidr) = @_;
+
+ my $ip;
+ if (defined($network_cidr)) {
+ # Use mtunnel via to get the remote node's ip inside $network_cidr.
+ # This goes over the regular network (iow. uses get_ssh_info() with
+ # $network_cidr undefined.
+ # FIXME: Use the REST API client for this after creating an API entry
+ # for get_migration_ip.
+ my $default_remote = get_ssh_info($node, undef);
+ my $default_ssh = ssh_info_to_command($default_remote);
+ my $cmd =[@$default_ssh, 'pvecm', 'mtunnel',
+ '-migration_network', $network_cidr,
+ '-get_migration_ip'
+ ];
+ PVE::Tools::run_command($cmd, outfunc => sub {
+ my ($line) = @_;
+ chomp $line;
+ die "internal error: unexpected output from mtunnel\n"
+ if defined($ip);
+ if ($line =~ /^ip: '(.*)'$/) {
+ $ip = $1;
+ } else {
+ die "internal error: bad output from mtunnel\n"
+ if defined($ip);
+ }
+ });
+ die "failed to get ip for node '$node' in network '$network_cidr'\n"
+ if !defined($ip);
+ } else {
+ $ip = remote_node_ip($node);
+ }
+
+ return {
+ ip => $ip,
+ name => $node,
+ network => $network_cidr,
+ };
+}
+
+sub ssh_info_to_command_base {
+ my ($info, @extra_options) = @_;
+ return [
+ '/usr/bin/ssh',
+ '-o', 'BatchMode=yes',
+ '-o', 'HostKeyAlias='.$info->{name},
+ @extra_options
+ ];
+}
+
+sub ssh_info_to_command {
+ my ($info, @extra_options) = @_;
+ my $cmd = ssh_info_to_command_base($info, @extra_options);
+ push @$cmd, "root\@$info->{ip}";
+ return $cmd;
+}
+
+1;