use strict;
use warnings;
-use POSIX qw(EEXIST ENOENT);
+
+use Encode;
use File::stat qw();
+use File::Path qw(make_path);
+use JSON;
+use Net::SSLeay;
+use POSIX qw(ENOENT);
use Socket;
use Storable qw(dclone);
-use IO::File;
-use MIME::Base64;
-use Digest::SHA;
-use Digest::HMAC_SHA1;
-use Net::SSLeay;
-use PVE::Tools;
+
+use PVE::Certificate;
use PVE::INotify;
use PVE::IPCC;
-use PVE::SafeSyslog;
use PVE::JSONSchema;
use PVE::Network;
-use JSON;
-use RRDs;
-use Encode;
-use UUID;
+use PVE::SafeSyslog;
+use PVE::Tools qw(run_command);
+
+use PVE::Cluster::IPCConst;
+
use base 'Exporter';
our @EXPORT_OK = qw(
cfs_register_file
cfs_lock_file);
-use Data::Dumper; # fixme: remove
-
# x509 certificate utils
my $basedir = "/etc/pve";
my $authdir = "$basedir/priv";
my $lockdir = "/etc/pve/priv/lock";
-my $authprivkeyfn = "$authdir/authkey.key";
-my $authpubkeyfn = "$basedir/authkey.pub";
-my $pveca_key_fn = "$authdir/pve-root-ca.key";
-my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
-my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
-# this is just a secret accessable by the web browser
-# and is used for CSRF prevention
-my $pvewww_key_fn = "$basedir/pve-www.key";
-
-# ssh related files
-my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
-my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
-my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
-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";
+# cfs and corosync files
+my $dbfile = "/var/lib/pve-cluster/config.db";
+my $dbbackupdir = "/var/lib/pve-cluster/backup";
+# this is just a readonly copy, the relevant one is in status.c from pmxcfs
+# observed files are the one we can get directly through IPCC, they are cached
+# using a computed version and only those can be used by the cfs_*_file methods
my $observed = {
'vzdump.cron' => 1,
'storage.cfg' => 1,
'user.cfg' => 1,
'domains.cfg' => 1,
'priv/shadow.cfg' => 1,
+ 'priv/tfa.cfg' => 1,
+ 'priv/token.cfg' => 1,
+ 'priv/acme/plugins.cfg' => 1,
'/qemu-server/' => 1,
'/openvz/' => 1,
'/lxc/' => 1,
'ha/groups.cfg' => 1,
'ha/fence.cfg' => 1,
'status.cfg' => 1,
+ 'ceph.conf' => 1,
+ 'sdn/vnets.cfg' => 1,
+ 'sdn/zones.cfg' => 1,
+ 'sdn/controllers.cfg' => 1,
+ 'virtual-guest/cpu-models.conf' => 1,
};
-# only write output if something fails
-sub run_silent_cmd {
- my ($cmd) = @_;
+sub prepare_observed_file_basedirs {
- my $outbuf = '';
-
- my $record_output = sub {
- $outbuf .= shift;
- $outbuf .= "\n";
- };
+ if (check_cfs_is_mounted(1)) {
+ warn "pmxcfs isn't mounted (/etc/pve), chickening out..\n";
+ return;
+ }
- eval {
- PVE::Tools::run_command($cmd, outfunc => $record_output,
- errfunc => $record_output);
- };
+ for my $f (sort keys %$observed) {
+ next if $f !~ m!^(.*)/[^/]+$!;
+ my $dir = "$basedir/$1";
+ next if -e $dir; # can also be a link, so just use -e xist check
+ print "creating directory '$dir' for observerd files\n";
+ make_path($dir);
+ }
+}
- my $err = $@;
+sub base_dir {
+ return $basedir;
+}
- if ($err) {
- print STDERR $outbuf;
- die $err;
- }
+sub auth_dir {
+ return $authdir;
}
sub check_cfs_quorum {
return $res;
}
-sub gen_local_dirs {
- my ($nodename) = @_;
-
- check_cfs_is_mounted();
-
- my @required_dirs = (
- "$basedir/priv",
- "$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";
- }
- }
-}
-
-sub gen_auth_key {
-
- return if -f "$authprivkeyfn";
-
- check_cfs_is_mounted();
-
- mkdir $authdir || $! == EEXIST || die "unable to create dir '$authdir' - $!\n";
-
- run_silent_cmd(['openssl', 'genrsa', '-out', $authprivkeyfn, '2048']);
-
- 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, '4096']);
- };
-
- die "unable to generate pve ca key:\n$@" if $@;
-}
-
-sub gen_pveca_cert {
-
- if (-f $pveca_key_fn && -f $pveca_cert_fn) {
- return 0;
- }
-
- gen_pveca_key();
-
- # we try to generate an unique 'subject' to avoid browser problems
- # (reused serial numbers, ..)
- my $uuid;
- UUID::generate($uuid);
- my $uuid_str;
- UUID::unparse($uuid, $uuid_str);
-
- eval {
- # 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=$uuid_str/O=PVE Cluster Manager CA/"]);
- };
-
- die "generating pve root certificate failed:\n$@" if $@;
-
- return 1;
-}
-
-sub gen_pve_ssl_key {
- my ($nodename) = @_;
-
- die "no node name specified" if !$nodename;
-
- my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
-
- return if -f $pvessl_key_fn;
-
- eval {
- run_silent_cmd(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
- };
-
- die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
-}
-
-sub gen_pve_www_key {
-
- return if -f $pvewww_key_fn;
-
- eval {
- run_silent_cmd(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
- };
-
- die "unable to generate pve www key:\n$@" if $@;
-}
-
-sub update_serial {
- my ($serial) = @_;
-
- PVE::Tools::file_set_contents($pveca_srl_fn, $serial);
-}
-
-sub gen_pve_ssl_cert {
- my ($force, $nodename, $ip) = @_;
-
- die "no node name specified" if !$nodename;
- die "no IP specified" if !$ip;
-
- my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
-
- return if !$force && -f $pvessl_cert_fn;
-
- 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";
-
- if ($rc && $rc->{search}) {
- $fqdn = $nodename . "." . $rc->{search};
- $names .= ",DNS:$fqdn";
- }
-
- my $sslconf = <<__EOD;
-RANDFILE = /root/.rnd
-extensions = v3_req
-
-[ req ]
-default_bits = 2048
-distinguished_name = req_distinguished_name
-req_extensions = v3_req
-prompt = no
-string_mask = nombstr
-
-[ req_distinguished_name ]
-organizationalUnitName = PVE Cluster Node
-organizationName = Proxmox Virtual Environment
-commonName = $fqdn
-
-[ v3_req ]
-basicConstraints = CA:FALSE
-extendedKeyUsage = serverAuth
-subjectAltName = $names
-__EOD
-
- my $cfgfn = "/tmp/pvesslconf-$$.tmp";
- my $fh = IO::File->new ($cfgfn, "w");
- print $fh $sslconf;
- close ($fh);
-
- my $reqfn = "/tmp/pvecertreq-$$.tmp";
- unlink $reqfn;
-
- my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
- eval {
- run_silent_cmd(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
- '-key', $pvessl_key_fn, '-out', $reqfn]);
- };
-
- if (my $err = $@) {
- unlink $reqfn;
- unlink $cfgfn;
- die "unable to generate pve certificate request:\n$err";
- }
-
- update_serial("0000000000000000") if ! -f $pveca_srl_fn;
-
- eval {
- # 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 = $@) {
- unlink $reqfn;
- unlink $cfgfn;
- die "unable to generate pve ssl certificate:\n$err";
- }
-
- unlink $cfgfn;
- unlink $reqfn;
-}
-
-sub gen_pve_node_files {
- my ($nodename, $ip, $opt_force) = @_;
-
- gen_local_dirs($nodename);
-
- gen_auth_key();
-
- # make sure we have a (cluster wide) secret
- # for CSRFR prevention
- gen_pve_www_key();
-
- # make sure we have a (per node) private key
- gen_pve_ssl_key($nodename);
-
- # make sure we have a CA
- my $force = gen_pveca_cert();
-
- $force = 1 if $opt_force;
-
- gen_pve_ssl_cert($force, $nodename, $ip);
-}
-
-my $vzdump_cron_dummy = <<__EOD;
-# cluster wide vzdump cron schedule
-# Atomatically generated file - do not edit
-
-PATH="/usr/sbin:/usr/bin:/sbin:/bin"
-
-__EOD
-
-sub gen_pve_vzdump_symlink {
-
- my $filename = "/etc/pve/vzdump.cron";
-
- my $link_fn = "/etc/cron.d/vzdump";
-
- if ((-f $filename) && (! -l $link_fn)) {
- rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
- symlink($filename, $link_fn);
- }
-}
-
-sub gen_pve_vzdump_files {
-
- my $filename = "/etc/pve/vzdump.cron";
-
- PVE::Tools::file_set_contents($filename, $vzdump_cron_dummy)
- if ! -f $filename;
-
- gen_pve_vzdump_symlink();
-};
-
my $versions = {};
my $vmlist = {};
my $clinfo = {};
my ($path) = @_;
my $bindata = pack "Z*", $path;
- my $res = PVE::IPCC::ipcc_send_rec(6, $bindata);
+ my $res = PVE::IPCC::ipcc_send_rec(CFS_IPC_GET_CONFIG, $bindata);
if (!defined($res)) {
if ($! != 0) {
return undef if $! == ENOENT;
my ($name, $nodename) = @_;
my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
- return PVE::IPCC::ipcc_send_rec(5, $bindata);
+ return PVE::IPCC::ipcc_send_rec(CFS_IPC_GET_STATUS, $bindata);
+};
+
+my $ipcc_remove_status = sub {
+ my ($name) = @_;
+ # we just omit the data payload, pmxcfs takes this as hint and removes this
+ # key from the status hashtable
+ my $bindata = pack "Z[256]", $name;
+ return &$ipcc_send_rec(CFS_IPC_SET_STATUS, $bindata);
};
my $ipcc_update_status = sub {
# update status
my $bindata = pack "Z[256]Z*", $name, $raw;
- return &$ipcc_send_rec(4, $bindata);
+ return &$ipcc_send_rec(CFS_IPC_SET_STATUS, $bindata);
};
my $ipcc_log = sub {
my $bindata = pack "CCCZ*Z*Z*", $priority, bytes::length($ident) + 1,
bytes::length($tag) + 1, $ident, $tag, $msg;
- return &$ipcc_send_rec(7, $bindata);
+ return &$ipcc_send_rec(CFS_IPC_LOG_CLUSTER_MSG, $bindata);
};
my $ipcc_get_cluster_log = sub {
$max = 0 if !defined($max);
my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
- return &$ipcc_send_rec(8, $bindata);
+ return &$ipcc_send_rec(CFS_IPC_GET_CLUSTER_LOG, $bindata);
+};
+
+my $ipcc_verify_token = sub {
+ my ($full_token) = @_;
+
+ my $bindata = pack "Z*", $full_token;
+ my $res = PVE::IPCC::ipcc_send_rec(CFS_IPC_VERIFY_TOKEN, $bindata);
+
+ return 1 if $! == 0;
+ return 0 if $! == ENOENT;
+
+ die "$!\n";
};
my $ccache = {};
sub cfs_update {
my ($fail) = @_;
eval {
- my $res = &$ipcc_send_rec_json(1);
- #warn "GOT1: " . Dumper($res);
+ my $res = &$ipcc_send_rec_json(CFS_IPC_GET_FS_VERSION);
die "no starttime\n" if !$res->{starttime};
if (!$res->{starttime} || !$versions->{starttime} ||
eval {
if (!$clinfo->{version} || $clinfo->{version} != $versions->{clinfo}) {
#warn "detected new clinfo\n";
- $clinfo = &$ipcc_send_rec_json(2);
+ $clinfo = &$ipcc_send_rec_json(CFS_IPC_GET_CLUSTER_INFO);
}
};
$err = $@;
eval {
if (!$vmlist->{version} || $vmlist->{version} != $versions->{vmlist}) {
#warn "detected new vmlist1\n";
- $vmlist = &$ipcc_send_rec_json(3);
+ $vmlist = &$ipcc_send_rec_json(CFS_IPC_GET_GUEST_LIST);
}
};
$err = $@;
}
sub get_nodelist {
-
my $nodelist = $clinfo->{nodelist};
- my $result = [];
-
my $nodename = PVE::INotify::nodename();
if (!$nodelist || !$nodelist->{$nodename}) {
return [ keys %$nodelist ];
}
+# only stored in a in-memory hashtable inside pmxcfs, local data is gone after
+# a restart (of pmxcfs or the node), peer data is still available then
+# best used for status data, like running (ceph) services, package versions, ...
+sub broadcast_node_kv {
+ my ($key, $data) = @_;
+
+ if (!defined($data)) {
+ eval {
+ $ipcc_remove_status->("kv/$key");
+ };
+ } else {
+ die "cannot send a reference\n" if ref($data);
+ my $size = length($data);
+ die "data for '$key' too big\n" if $size >= (32 * 1024); # limit from pmxfs
+
+ eval {
+ $ipcc_update_status->("kv/$key", $data);
+ };
+ }
+
+ warn $@ if $@;
+}
+
+# nodename is optional
+sub get_node_kv {
+ my ($key, $nodename) = @_;
+
+ my $res = {};
+ my $get_node_data = sub {
+ my ($node) = @_;
+ my $raw = $ipcc_get_status->("kv/$key", $node);
+ $res->{$node} = unpack("Z*", $raw) if $raw;
+ };
+
+ if ($nodename) {
+ $get_node_data->($nodename);
+ } else {
+ my $nodelist = get_nodelist();
+
+ foreach my $node (@$nodelist) {
+ $get_node_data->($node);
+ }
+ }
+
+ return $res;
+}
+
+# property: a config property you want to get, e.g., this is perfect to get
+# the 'lock' entry of a guest _fast_ (>100 faster than manual parsing here)
+# vmid: optipnal, if a valid is passed we only check that one, else return all
+# NOTE: does *not* searches snapshot and PENDING entries sections!
+sub get_guest_config_property {
+ my ($property, $vmid) = @_;
+
+ die "property is required" if !defined($property);
+
+ my $bindata = pack "VZ*", $vmid // 0, $property;
+ my $res = $ipcc_send_rec_json->(CFS_IPC_GET_GUEST_CONFIG_PROPERTY, $bindata);
+
+ return $res;
+}
+
# $data must be a chronological descending ordered array of tasks
sub broadcast_tasklist {
my ($data) = @_;
my $raw;
eval {
- $raw = &$ipcc_send_rec(10);
+ $raw = &$ipcc_send_rec(CFS_IPC_GET_RRD_DUMP);
};
my $err = $@;
return $res;
}
-sub create_rrd_data {
- my ($rrdname, $timeframe, $cf) = @_;
-
- my $rrddir = "/var/lib/rrdcached/db";
-
- my $rrd = "$rrddir/$rrdname";
-
- my $setup = {
- hour => [ 60, 70 ],
- day => [ 60*30, 70 ],
- week => [ 60*180, 70 ],
- month => [ 60*720, 70 ],
- year => [ 60*10080, 70 ],
- };
-
- my ($reso, $count) = @{$setup->{$timeframe}};
- my $ctime = $reso*int(time()/$reso);
- my $req_start = $ctime - $reso*$count;
-
- $cf = "AVERAGE" if !$cf;
-
- my @args = (
- "-s" => $req_start,
- "-e" => $ctime - 1,
- "-r" => $reso,
- );
-
- my $socket = "/var/run/rrdcached.sock";
- push @args, "--daemon" => "unix:$socket" if -S $socket;
-
- my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);
-
- my $err = RRDs::error;
- die "RRD error: $err\n" if $err;
-
- die "got wrong time resolution ($step != $reso)\n"
- if $step != $reso;
-
- my $res = [];
- my $fields = scalar(@$names);
- for my $line (@$data) {
- my $entry = { 'time' => $start };
- $start += $step;
- for (my $i = 0; $i < $fields; $i++) {
- my $name = $names->[$i];
- if (defined(my $val = $line->[$i])) {
- $entry->{$name} = $val;
- } else {
- # leave empty fields undefined
- # maybe make this configurable?
- }
- }
- push @$res, $entry;
- }
-
- return $res;
-}
-
-sub create_rrd_graph {
- my ($rrdname, $timeframe, $ds, $cf) = @_;
-
- # 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";
-
- my @ids = PVE::Tools::split_list($ds);
-
- my $ds_txt = join('_', @ids);
-
- my $filename = "${rrd}_${ds_txt}.png";
-
- my $setup = {
- hour => [ 60, 60 ],
- day => [ 60*30, 70 ],
- week => [ 60*180, 70 ],
- month => [ 60*720, 70 ],
- year => [ 60*10080, 70 ],
- };
-
- my ($reso, $count) = @{$setup->{$timeframe}};
-
- my @args = (
- "--imgformat" => "PNG",
- "--border" => 0,
- "--height" => 200,
- "--width" => 800,
- "--start" => - $reso*$count,
- "--end" => 'now' ,
- "--lower-limit" => 0,
- );
-
- my $socket = "/var/run/rrdcached.sock";
- push @args, "--daemon" => "unix:$socket" if -S $socket;
-
- my @coldef = ('#00ddff', '#ff0000');
-
- $cf = "AVERAGE" if !$cf;
-
- my $i = 0;
- foreach my $id (@ids) {
- my $col = $coldef[$i++] || die "fixme: no color definition";
- push @args, "DEF:${id}=$rrd:${id}:$cf";
- my $dataid = $id;
- if ($id eq 'cpu' || $id eq 'iowait') {
- push @args, "CDEF:${id}_per=${id},100,*";
- $dataid = "${id}_per";
- }
- push @args, "LINE2:${dataid}${col}:${id}";
- }
-
- push @args, '--full-size-mode';
-
- # we do not really store data into the file
- my $res = RRDs::graphv('-', @args);
-
- my $err = RRDs::error;
- die "RRD error: $err\n" if $err;
-
- return { filename => $filename, image => $res->{image} };
-}
# a fast way to read files (avoid fuse overhead)
sub get_config {
return &$ipcc_get_cluster_log($user, $max);
}
+sub verify_token {
+ my ($userid, $token) = @_;
+
+ return &$ipcc_verify_token("$userid $token");
+}
+
my $file_info = {};
sub cfs_register_file {
my $ci = $ccache->{$filename};
if (!$ci->{version} || !$version || $ci->{version} != $version) {
- # we always call the parser, even when the file does not exists
+ # we always call the parser, even when the file does not exist
# (in that case $data is undef)
my $data = get_config($filename);
$ci->{data} = &$parser("/etc/pve/$filename", $data);
my $res;
my $got_lock = 0;
- # this timeout is for aquire the lock
+ # this timeout is for acquire the lock
$timeout = 10 if !$timeout;
my $filename = "$lockdir/$lockid";
$timeout_err->() if $timeout <= 0;
- print STDERR "trying to aquire cfs lock '$lockid' ...\n";
+ print STDERR "trying to acquire cfs lock '$lockid' ...\n";
utime (0, 0, $filename); # cfs unlock request
sleep(1);
}
alarm($prev_alarm);
if ($err) {
- $@ = "error with cfs lock '$lockid': $err";
+ if (ref($err) eq 'PVE::Exception') {
+ # re-raise defined exceptions
+ $@ = $err;
+ } else {
+ # add lock info for plain errors
+ $@ = "error during cfs-locked '$lockid' operation: $err";
+ }
return undef;
}
&$cfs_lock($lockid, $timeout, $code, @param);
}
+sub cfs_lock_acme {
+ my ($account, $timeout, $code, @param) = @_;
+
+ my $lockid = "acme-$account";
+
+ &$cfs_lock($lockid, $timeout, $code, @param);
+}
+
+sub cfs_lock_authkey {
+ my ($timeout, $code, @param) = @_;
+
+ $cfs_lock->('authkey', $timeout, $code, @param);
+}
+
+sub cfs_lock_firewall {
+ my ($scope, $timeout, $code, @param) = @_;
+
+ my $lockid = "firewall-$scope";
+
+ $cfs_lock->($lockid, $timeout, $code, @param);
+}
+
my $log_levels = {
"emerg" => 0,
"alert" => 1,
return PVE::Network::get_ip_from_hostname($nodename, $noerr);
}
-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 {
- # remove duplicate keys in $sshauthkeys
- # ssh-copy-id simply add keys, so the file can grow to large
-
- my $data = '';
- if (-f $sshauthkeys) {
- $data = PVE::Tools::file_get_contents($sshauthkeys, 128*1024);
- chomp($data);
- }
-
- my $found_backup;
- if (-f $rootsshauthkeysbackup) {
- $data .= "\n";
- $data .= PVE::Tools::file_get_contents($rootsshauthkeysbackup, 128*1024);
- chomp($data);
- $found_backup = 1;
- }
-
- # always add ourself
- if (-f $ssh_rsa_id) {
- my $pub = PVE::Tools::file_get_contents($ssh_rsa_id);
- chomp($pub);
- $data .= "\n$pub\n";
- }
-
- my $newdata = "";
- my $vhash = {};
- my @lines = split(/\n/, $data);
- foreach my $line (@lines) {
- if ($line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/) {
- next if $vhash->{$3}++;
- }
- $newdata .= "$line\n";
- }
-
- PVE::Tools::file_set_contents($sshauthkeys, $newdata, 0600);
-
- if ($found_backup && -l $rootsshauthkeys) {
- # everything went well, so we can remove the backup
- unlink $rootsshauthkeysbackup;
- }
-}
-
-sub setup_sshd_config {
- my () = @_;
-
- 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']);
-}
-
-sub setup_rootsshconfig {
-
- # create ssh key if it does not exist
- if (! -f $ssh_rsa_id) {
- mkdir '/root/.ssh/';
- system ("echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}");
- }
-
- # create ssh config 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'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);
- }
- }
-}
-
-sub setup_ssh_keys {
-
- mkdir $authdir;
-
- my $import_ok;
-
- if (! -f $sshauthkeys) {
- my $old;
- if (-f $rootsshauthkeys) {
- $old = PVE::Tools::file_get_contents($rootsshauthkeys, 128*1024);
- }
- if (my $fh = IO::File->new ($sshauthkeys, O_CREAT|O_WRONLY|O_EXCL, 0400)) {
- PVE::Tools::safe_print($sshauthkeys, $fh, $old) if $old;
- close($fh);
- $import_ok = 1;
- }
- }
-
- warn "can't create shared ssh key database '$sshauthkeys'\n"
- if ! -f $sshauthkeys;
-
- if (-f $rootsshauthkeys && ! -l $rootsshauthkeys) {
- if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
- warn "rename $rootsshauthkeys failed - $!\n";
- }
- }
-
- if (! -l $rootsshauthkeys) {
- symlink $sshauthkeys, $rootsshauthkeys;
- }
-
- if (! -l $rootsshauthkeys) {
- warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
- } else {
- unlink $rootsshauthkeysbackup if $import_ok;
- }
-}
-
-sub ssh_unmerge_known_hosts {
- return if ! -l $sshglobalknownhosts;
-
- my $old = '';
- $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024)
- if -f $sshknownhosts;
-
- PVE::Tools::file_set_contents($sshglobalknownhosts, $old);
-}
-
-sub ssh_merge_known_hosts {
- my ($nodename, $ip_address, $createLink) = @_;
-
- 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) {
- if (my $fh = IO::File->new($sshknownhosts, O_CREAT|O_WRONLY|O_EXCL, 0600)) {
- close($fh);
- }
- }
-
- 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);
- # 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 $vhash = {};
-
- my $found_nodename;
- my $found_local_ip;
-
- 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;
- if (!$vhash->{$key}) {
- $vhash->{$key} = 1;
- if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
- my $salt = decode_base64($1);
- my $digest = $2;
- my $hmac = Digest::HMAC_SHA1->new($salt);
- $hmac->add($nodename);
- my $hd = $hmac->b64digest . '=';
- if ($digest eq $hd) {
- if ($rsakey eq $hostkey) {
- $found_nodename = 1;
- $data .= $line;
- }
- return;
- }
- $hmac = Digest::HMAC_SHA1->new($salt);
- $hmac->add($ip_address);
- $hd = $hmac->b64digest . '=';
- if ($digest eq $hd) {
- if ($rsakey eq $hostkey) {
- $found_local_ip = 1;
- $data .= $line;
- }
- 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;
- }
- } elsif ($all) {
- $data .= $line;
- }
- };
-
- while ($old && $old =~ s/^((.*?)(\n|$))//) {
- my $line = "$2\n";
- &$merge_line($line, 1);
- }
-
- while ($new && $new =~ s/^((.*?)(\n|$))//) {
- my $line = "$2\n";
- &$merge_line($line);
- }
-
- # 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);
-
- return if !$createLink;
-
- unlink $sshglobalknownhosts;
- symlink $sshknownhosts, $sshglobalknownhosts;
-
- 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,
- properties => {
- keyboard => {
- optional => 1,
- type => 'string',
- description => "Default keybord layout for vnc server.",
- enum => PVE::Tools::kvmkeymaplist(),
- },
- language => {
- optional => 1,
- type => 'string',
- description => "Default GUI language.",
- enum => [ 'en', 'de' ],
- },
- http_proxy => {
- optional => 1,
- type => 'string',
- description => "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
- pattern => "http://.*",
- },
- 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. 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; deprecated and maps to html5), 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.',
- },
- },
-};
-
-# make schema accessible from outside (for documentation)
-sub get_datacenter_schema { return $datacenter_schema };
-
-sub parse_datacenter_config {
- my ($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';
- }
- }
-
- # for backwards compatibility only, applet maps to html5
- if (defined($res->{console}) && $res->{console} eq 'applet') {
- $res->{console} = 'html5';
- }
-
- 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';
- }
-
- # map deprecated applet setting to html5
- if (defined($cfg->{console}) && $cfg->{console} eq 'applet') {
- $cfg->{console} = 'html5';
- }
-
- if (my $migration = $cfg->{migration}) {
- $cfg->{migration} = PVE::JSONSchema::print_property_string($migration, $migration_format);
- }
-
- return PVE::JSONSchema::dump_config($datacenter_schema, $filename, $cfg);
-}
-
-cfs_register_file('datacenter.cfg',
- \&parse_datacenter_config,
- \&write_datacenter_config);
-
-# 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 $fp = eval { get_node_fingerprint($node) };
- if (my $err = $@) {
- warn "$err\n";
- &$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 read_ssl_cert_fingerprint {
- my ($cert_path) = @_;
-
- my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
- or die "unable to read '$cert_path' - $!\n";
-
- my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
- if (!$cert) {
- Net::SSLeay::BIO_free($bio);
- die "unable to read certificate from '$cert_path'\n";
- }
-
- my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
- Net::SSLeay::X509_free($cert);
-
- die "unable to get fingerprint for '$cert_path' - got empty value\n"
- if !defined($fp) || $fp eq '';
-
- return $fp;
-}
-
sub get_node_fingerprint {
my ($node) = @_;
$cert_path = $custom_cert_path if -f $custom_cert_path;
- return read_ssl_cert_fingerprint($cert_path);
-}
-
-
-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 = 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;
+ return PVE::Certificate::get_certificate_fingerprint($cert_path);
}
# bash completion helpers
return $res;
}
-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',
- '-e', 'none',
- '-o', 'BatchMode=yes',
- '-o', 'HostKeyAlias='.$info->{name},
- @extra_options
- ];
-}
+# NOTE: filesystem must be offline here, no DB changes allowed
+sub cfs_backup_database {
+ mkdir $dbbackupdir;
+
+ my $ctime = time();
+ my $backup_fn = "$dbbackupdir/config-$ctime.sql.gz";
+
+ print "backup old database to '$backup_fn'\n";
+
+ my $cmd = [ ['sqlite3', $dbfile, '.dump'], ['gzip', '-', \ ">${backup_fn}"] ];
+ run_command($cmd, 'errmsg' => "cannot backup old database\n");
+
+ my $maxfiles = 10; # purge older backup
+ my $backups = [ sort { $b cmp $a } <$dbbackupdir/config-*.sql.gz> ];
+
+ if ((my $count = scalar(@$backups)) > $maxfiles) {
+ foreach my $f (@$backups[$maxfiles..$count-1]) {
+ next if $f !~ m/^(\S+)$/; # untaint
+ print "delete old backup '$1'\n";
+ unlink $1;
+ }
+ }
-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;
+ return $dbfile;
}
1;
projects / pve-cluster.git / blobdiff