5 use POSIX
qw(EEXIST ENOENT);
8 use Storable
qw(dclone);
12 use Digest
::HMAC_SHA1
;
14 use PVE
::Tools
qw(run_command);
32 use Data
::Dumper
; # fixme: remove
34 # x509 certificate utils
36 my $basedir = "/etc/pve";
37 my $authdir = "$basedir/priv";
38 my $lockdir = "/etc/pve/priv/lock";
40 # cfs and corosync files
41 my $dbfile = "/var/lib/pve-cluster/config.db";
42 my $dbbackupdir = "/var/lib/pve-cluster/backup";
43 my $localclusterdir = "/etc/corosync";
44 my $localclusterconf = "$localclusterdir/corosync.conf";
45 my $authfile = "$localclusterdir/authkey";
46 my $clusterconf = "$basedir/corosync.conf";
48 my $authprivkeyfn = "$authdir/authkey.key";
49 my $authpubkeyfn = "$basedir/authkey.pub";
50 my $pveca_key_fn = "$authdir/pve-root-ca.key";
51 my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
52 my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
53 # this is just a secret accessable by the web browser
54 # and is used for CSRF prevention
55 my $pvewww_key_fn = "$basedir/pve-www.key";
58 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
59 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
60 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
61 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
62 my $sshknownhosts = "/etc/pve/priv/known_hosts";
63 my $sshauthkeys = "/etc/pve/priv/authorized_keys";
64 my $sshd_config_fn = "/etc/ssh/sshd_config";
65 my $rootsshauthkeys = "/root/.ssh/authorized_keys";
66 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
67 my $rootsshconfig = "/root/.ssh/config";
72 'datacenter.cfg' => 1,
73 'replication.cfg' => 1,
75 'corosync.conf.new' => 1,
78 'priv/shadow.cfg' => 1,
82 'ha/crm_commands' => 1,
83 'ha/manager_status' => 1,
84 'ha/resources.cfg' => 1,
90 # only write output if something fails
96 my $record_output = sub {
102 PVE
::Tools
::run_command
($cmd, outfunc
=> $record_output,
103 errfunc
=> $record_output);
109 print STDERR
$outbuf;
114 sub check_cfs_quorum
{
117 # note: -w filename always return 1 for root, so wee need
118 # to use File::lstat here
119 my $st = File
::stat::lstat("$basedir/local");
120 my $quorate = ($st && (($st->mode & 0200) != 0));
122 die "cluster not ready - no quorum?\n" if !$quorate && !$noerr;
127 sub check_cfs_is_mounted
{
130 my $res = -l
"$basedir/local";
132 die "pve configuration filesystem not mounted\n"
141 check_cfs_is_mounted
();
143 my @required_dirs = (
146 "$basedir/nodes/$nodename",
147 "$basedir/nodes/$nodename/lxc",
148 "$basedir/nodes/$nodename/qemu-server",
149 "$basedir/nodes/$nodename/openvz",
150 "$basedir/nodes/$nodename/priv");
152 foreach my $dir (@required_dirs) {
154 mkdir($dir) || $! == EEXIST
|| die "unable to create directory '$dir' - $!\n";
161 return if -f
"$authprivkeyfn";
163 check_cfs_is_mounted
();
165 mkdir $authdir || $! == EEXIST
|| die "unable to create dir '$authdir' - $!\n";
167 run_silent_cmd
(['openssl', 'genrsa', '-out', $authprivkeyfn, '2048']);
169 run_silent_cmd
(['openssl', 'rsa', '-in', $authprivkeyfn, '-pubout', '-out', $authpubkeyfn]);
174 return if -f
$pveca_key_fn;
177 run_silent_cmd
(['openssl', 'genrsa', '-out', $pveca_key_fn, '4096']);
180 die "unable to generate pve ca key:\n$@" if $@;
185 if (-f
$pveca_key_fn && -f
$pveca_cert_fn) {
191 # we try to generate an unique 'subject' to avoid browser problems
192 # (reused serial numbers, ..)
194 UUID
::generate
($uuid);
196 UUID
::unparse
($uuid, $uuid_str);
199 # wrap openssl with faketime to prevent bug #904
200 run_silent_cmd
(['faketime', 'yesterday', 'openssl', 'req', '-batch',
201 '-days', '3650', '-new', '-x509', '-nodes', '-key',
202 $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
203 "/CN=Proxmox Virtual Environment/OU=$uuid_str/O=PVE Cluster Manager CA/"]);
206 die "generating pve root certificate failed:\n$@" if $@;
211 sub gen_pve_ssl_key
{
214 die "no node name specified" if !$nodename;
216 my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
218 return if -f
$pvessl_key_fn;
221 run_silent_cmd
(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
224 die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
227 sub gen_pve_www_key
{
229 return if -f
$pvewww_key_fn;
232 run_silent_cmd
(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
235 die "unable to generate pve www key:\n$@" if $@;
241 PVE
::Tools
::file_set_contents
($pveca_srl_fn, $serial);
244 sub gen_pve_ssl_cert
{
245 my ($force, $nodename, $ip) = @_;
247 die "no node name specified" if !$nodename;
248 die "no IP specified" if !$ip;
250 my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
252 return if !$force && -f
$pvessl_cert_fn;
254 my $names = "IP:127.0.0.1,IP:::1,DNS:localhost";
256 my $rc = PVE
::INotify
::read_file
('resolvconf');
260 my $fqdn = $nodename;
262 $names .= ",DNS:$nodename";
264 if ($rc && $rc->{search
}) {
265 $fqdn = $nodename . "." . $rc->{search
};
266 $names .= ",DNS:$fqdn";
269 my $sslconf = <<__EOD;
270 RANDFILE = /root/.rnd
275 distinguished_name = req_distinguished_name
276 req_extensions = v3_req
278 string_mask = nombstr
280 [ req_distinguished_name ]
281 organizationalUnitName = PVE Cluster Node
282 organizationName = Proxmox Virtual Environment
286 basicConstraints = CA:FALSE
287 extendedKeyUsage = serverAuth
288 subjectAltName = $names
291 my $cfgfn = "/tmp/pvesslconf-$$.tmp";
292 my $fh = IO
::File-
>new ($cfgfn, "w");
296 my $reqfn = "/tmp/pvecertreq-$$.tmp";
299 my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
301 run_silent_cmd
(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
302 '-key', $pvessl_key_fn, '-out', $reqfn]);
308 die "unable to generate pve certificate request:\n$err";
311 update_serial
("0000000000000000") if ! -f
$pveca_srl_fn;
314 # wrap openssl with faketime to prevent bug #904
315 run_silent_cmd
(['faketime', 'yesterday', 'openssl', 'x509', '-req',
316 '-in', $reqfn, '-days', '3650', '-out', $pvessl_cert_fn,
317 '-CAkey', $pveca_key_fn, '-CA', $pveca_cert_fn,
318 '-CAserial', $pveca_srl_fn, '-extfile', $cfgfn]);
324 die "unable to generate pve ssl certificate:\n$err";
331 sub gen_pve_node_files
{
332 my ($nodename, $ip, $opt_force) = @_;
334 gen_local_dirs
($nodename);
338 # make sure we have a (cluster wide) secret
339 # for CSRFR prevention
342 # make sure we have a (per node) private key
343 gen_pve_ssl_key
($nodename);
345 # make sure we have a CA
346 my $force = gen_pveca_cert
();
348 $force = 1 if $opt_force;
350 gen_pve_ssl_cert
($force, $nodename, $ip);
353 my $vzdump_cron_dummy = <<__EOD;
354 # cluster wide vzdump cron schedule
355 # Atomatically generated file - do not edit
357 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
361 sub gen_pve_vzdump_symlink
{
363 my $filename = "/etc/pve/vzdump.cron";
365 my $link_fn = "/etc/cron.d/vzdump";
367 if ((-f
$filename) && (! -l
$link_fn)) {
368 rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
369 symlink($filename, $link_fn);
373 sub gen_pve_vzdump_files
{
375 my $filename = "/etc/pve/vzdump.cron";
377 PVE
::Tools
::file_set_contents
($filename, $vzdump_cron_dummy)
380 gen_pve_vzdump_symlink
();
387 my $ipcc_send_rec = sub {
388 my ($msgid, $data) = @_;
390 my $res = PVE
::IPCC
::ipcc_send_rec
($msgid, $data);
392 die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
397 my $ipcc_send_rec_json = sub {
398 my ($msgid, $data) = @_;
400 my $res = PVE
::IPCC
::ipcc_send_rec
($msgid, $data);
402 die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
404 return decode_json
($res);
407 my $ipcc_get_config = sub {
410 my $bindata = pack "Z*", $path;
411 my $res = PVE
::IPCC
::ipcc_send_rec
(6, $bindata);
412 if (!defined($res)) {
414 return undef if $! == ENOENT
;
423 my $ipcc_get_status = sub {
424 my ($name, $nodename) = @_;
426 my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
427 return PVE
::IPCC
::ipcc_send_rec
(5, $bindata);
430 my $ipcc_update_status = sub {
431 my ($name, $data) = @_;
433 my $raw = ref($data) ? encode_json
($data) : $data;
435 my $bindata = pack "Z[256]Z*", $name, $raw;
437 return &$ipcc_send_rec(4, $bindata);
441 my ($priority, $ident, $tag, $msg) = @_;
443 my $bindata = pack "CCCZ*Z*Z*", $priority, bytes
::length($ident) + 1,
444 bytes
::length($tag) + 1, $ident, $tag, $msg;
446 return &$ipcc_send_rec(7, $bindata);
449 my $ipcc_get_cluster_log = sub {
450 my ($user, $max) = @_;
452 $max = 0 if !defined($max);
454 my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
455 return &$ipcc_send_rec(8, $bindata);
463 my $res = &$ipcc_send_rec_json(1);
464 #warn "GOT1: " . Dumper($res);
465 die "no starttime\n" if !$res->{starttime
};
467 if (!$res->{starttime
} || !$versions->{starttime
} ||
468 $res->{starttime
} != $versions->{starttime
}) {
469 #print "detected changed starttime\n";
488 if (!$clinfo->{version
} || $clinfo->{version
} != $versions->{clinfo
}) {
489 #warn "detected new clinfo\n";
490 $clinfo = &$ipcc_send_rec_json(2);
501 if (!$vmlist->{version
} || $vmlist->{version
} != $versions->{vmlist
}) {
502 #warn "detected new vmlist1\n";
503 $vmlist = &$ipcc_send_rec_json(3);
523 return $clinfo->{nodelist
};
528 my $nodelist = $clinfo->{nodelist
};
532 my $nodename = PVE
::INotify
::nodename
();
534 if (!$nodelist || !$nodelist->{$nodename}) {
535 return [ $nodename ];
538 return [ keys %$nodelist ];
541 # $data must be a chronological descending ordered array of tasks
542 sub broadcast_tasklist
{
545 # the serialized list may not get bigger than 32kb (CFS_MAX_STATUS_SIZE
546 # from pmxcfs) - drop older items until we satisfy this constraint
547 my $size = length(encode_json
($data));
548 while ($size >= (32 * 1024)) {
550 $size = length(encode_json
($data));
554 &$ipcc_update_status("tasklist", $data);
560 my $tasklistcache = {};
565 my $kvstore = $versions->{kvstore
} || {};
567 my $nodelist = get_nodelist
();
570 foreach my $node (@$nodelist) {
571 next if $nodename && ($nodename ne $node);
573 my $ver = $kvstore->{$node}->{tasklist
} if $kvstore->{$node};
574 my $cd = $tasklistcache->{$node};
575 if (!$cd || !$ver || !$cd->{version
} ||
576 ($cd->{version
} != $ver)) {
577 my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
578 my $data = decode_json
($raw);
580 $cd = $tasklistcache->{$node} = {
584 } elsif ($cd && $cd->{data
}) {
585 push @$res, @{$cd->{data
}};
589 syslog
('err', $err) if $err;
596 my ($rrdid, $data) = @_;
599 &$ipcc_update_status("rrd/$rrdid", $data);
606 my $last_rrd_dump = 0;
607 my $last_rrd_data = "";
613 my $diff = $ctime - $last_rrd_dump;
615 return $last_rrd_data;
620 $raw = &$ipcc_send_rec(10);
632 while ($raw =~ s/^(.*)\n//) {
633 my ($key, @ela) = split(/:/, $1);
635 next if !(scalar(@ela) > 1);
636 $res->{$key} = [ map { $_ eq 'U' ?
undef : $_ } @ela ];
640 $last_rrd_dump = $ctime;
641 $last_rrd_data = $res;
646 sub create_rrd_data
{
647 my ($rrdname, $timeframe, $cf) = @_;
649 my $rrddir = "/var/lib/rrdcached/db";
651 my $rrd = "$rrddir/$rrdname";
655 day
=> [ 60*30, 70 ],
656 week
=> [ 60*180, 70 ],
657 month
=> [ 60*720, 70 ],
658 year
=> [ 60*10080, 70 ],
661 my ($reso, $count) = @{$setup->{$timeframe}};
662 my $ctime = $reso*int(time()/$reso);
663 my $req_start = $ctime - $reso*$count;
665 $cf = "AVERAGE" if !$cf;
673 my $socket = "/var/run/rrdcached.sock";
674 push @args, "--daemon" => "unix:$socket" if -S
$socket;
676 my ($start, $step, $names, $data) = RRDs
::fetch
($rrd, $cf, @args);
678 my $err = RRDs
::error
;
679 die "RRD error: $err\n" if $err;
681 die "got wrong time resolution ($step != $reso)\n"
685 my $fields = scalar(@$names);
686 for my $line (@$data) {
687 my $entry = { 'time' => $start };
689 for (my $i = 0; $i < $fields; $i++) {
690 my $name = $names->[$i];
691 if (defined(my $val = $line->[$i])) {
692 $entry->{$name} = $val;
694 # leave empty fields undefined
695 # maybe make this configurable?
704 sub create_rrd_graph
{
705 my ($rrdname, $timeframe, $ds, $cf) = @_;
707 # Using RRD graph is clumsy - maybe it
708 # is better to simply fetch the data, and do all display
709 # related things with javascript (new extjs html5 graph library).
711 my $rrddir = "/var/lib/rrdcached/db";
713 my $rrd = "$rrddir/$rrdname";
715 my @ids = PVE
::Tools
::split_list
($ds);
717 my $ds_txt = join('_', @ids);
719 my $filename = "${rrd}_${ds_txt}.png";
723 day
=> [ 60*30, 70 ],
724 week
=> [ 60*180, 70 ],
725 month
=> [ 60*720, 70 ],
726 year
=> [ 60*10080, 70 ],
729 my ($reso, $count) = @{$setup->{$timeframe}};
732 "--imgformat" => "PNG",
736 "--start" => - $reso*$count,
738 "--lower-limit" => 0,
741 my $socket = "/var/run/rrdcached.sock";
742 push @args, "--daemon" => "unix:$socket" if -S
$socket;
744 my @coldef = ('#00ddff', '#ff0000');
746 $cf = "AVERAGE" if !$cf;
749 foreach my $id (@ids) {
750 my $col = $coldef[$i++] || die "fixme: no color definition";
751 push @args, "DEF:${id}=$rrd:${id}:$cf";
753 if ($id eq 'cpu' || $id eq 'iowait') {
754 push @args, "CDEF:${id}_per=${id},100,*";
755 $dataid = "${id}_per";
757 push @args, "LINE2:${dataid}${col}:${id}";
760 push @args, '--full-size-mode';
762 # we do not really store data into the file
763 my $res = RRDs
::graphv
('-', @args);
765 my $err = RRDs
::error
;
766 die "RRD error: $err\n" if $err;
768 return { filename
=> $filename, image
=> $res->{image
} };
771 # a fast way to read files (avoid fuse overhead)
775 return &$ipcc_get_config($path);
778 sub get_cluster_log
{
779 my ($user, $max) = @_;
781 return &$ipcc_get_cluster_log($user, $max);
786 sub cfs_register_file
{
787 my ($filename, $parser, $writer) = @_;
789 $observed->{$filename} || die "unknown file '$filename'";
791 die "file '$filename' already registered" if $file_info->{$filename};
793 $file_info->{$filename} = {
799 my $ccache_read = sub {
800 my ($filename, $parser, $version) = @_;
802 $ccache->{$filename} = {} if !$ccache->{$filename};
804 my $ci = $ccache->{$filename};
806 if (!$ci->{version
} || !$version || $ci->{version
} != $version) {
807 # we always call the parser, even when the file does not exists
808 # (in that case $data is undef)
809 my $data = get_config
($filename);
810 $ci->{data
} = &$parser("/etc/pve/$filename", $data);
811 $ci->{version
} = $version;
814 my $res = ref($ci->{data
}) ? dclone
($ci->{data
}) : $ci->{data
};
819 sub cfs_file_version
{
824 if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) {
825 my ($type, $vmid) = ($1, $2);
826 if ($vmlist && $vmlist->{ids
} && $vmlist->{ids
}->{$vmid}) {
827 $version = $vmlist->{ids
}->{$vmid}->{version
};
829 $infotag = "/$type/";
831 $infotag = $filename;
832 $version = $versions->{$filename};
835 my $info = $file_info->{$infotag} ||
836 die "unknown file type '$filename'\n";
838 return wantarray ?
($version, $info) : $version;
844 my ($version, $info) = cfs_file_version
($filename);
845 my $parser = $info->{parser
};
847 return &$ccache_read($filename, $parser, $version);
851 my ($filename, $data) = @_;
853 my ($version, $info) = cfs_file_version
($filename);
855 my $writer = $info->{writer
} || die "no writer defined";
857 my $fsname = "/etc/pve/$filename";
859 my $raw = &$writer($fsname, $data);
861 if (my $ci = $ccache->{$filename}) {
862 $ci->{version
} = undef;
865 PVE
::Tools
::file_set_contents
($fsname, $raw);
869 my ($lockid, $timeout, $code, @param) = @_;
871 my $prev_alarm = alarm(0); # suspend outer alarm early
876 # this timeout is for aquire the lock
877 $timeout = 10 if !$timeout;
879 my $filename = "$lockdir/$lockid";
886 die "pve cluster filesystem not online.\n";
889 my $timeout_err = sub { die "got lock request timeout\n"; };
890 local $SIG{ALRM
} = $timeout_err;
894 $got_lock = mkdir($filename);
895 $timeout = alarm(0) - 1; # we'll sleep for 1s, see down below
899 $timeout_err->() if $timeout <= 0;
901 print STDERR
"trying to aquire cfs lock '$lockid' ...\n";
902 utime (0, 0, $filename); # cfs unlock request
906 # fixed command timeout: cfs locks have a timeout of 120
907 # using 60 gives us another 60 seconds to abort the task
908 local $SIG{ALRM
} = sub { die "got lock timeout - aborting command\n"; };
911 cfs_update
(); # make sure we read latest versions inside code()
913 $res = &$code(@param);
920 $err = "no quorum!\n" if !$got_lock && !check_cfs_quorum
(1);
922 rmdir $filename if $got_lock; # if we held the lock always unlock again
927 $@ = "error with cfs lock '$lockid': $err";
937 my ($filename, $timeout, $code, @param) = @_;
939 my $info = $observed->{$filename} || die "unknown file '$filename'";
941 my $lockid = "file-$filename";
942 $lockid =~ s/[.\/]/_
/g
;
944 &$cfs_lock($lockid, $timeout, $code, @param);
947 sub cfs_lock_storage
{
948 my ($storeid, $timeout, $code, @param) = @_;
950 my $lockid = "storage-$storeid";
952 &$cfs_lock($lockid, $timeout, $code, @param);
955 sub cfs_lock_domain
{
956 my ($domainname, $timeout, $code, @param) = @_;
958 my $lockid = "domain-$domainname";
960 &$cfs_lock($lockid, $timeout, $code, @param);
978 my ($priority, $ident, $msg) = @_;
980 if (my $tmp = $log_levels->{$priority}) {
984 die "need numeric log priority" if $priority !~ /^\d+$/;
986 my $tag = PVE
::SafeSyslog
::tag
();
988 $msg = "empty message" if !$msg;
990 $ident = "" if !$ident;
991 $ident = encode
("ascii", $ident,
992 sub { sprintf "\\u%04x", shift });
994 my $ascii = encode
("ascii", $msg, sub { sprintf "\\u%04x", shift });
997 syslog
($priority, "<%s> %s", $ident, $ascii);
999 syslog
($priority, "%s", $ascii);
1002 eval { &$ipcc_log($priority, $ident, $tag, $ascii); };
1004 syslog
("err", "writing cluster log failed: $@") if $@;
1007 sub check_vmid_unused
{
1008 my ($vmid, $noerr) = @_;
1010 my $vmlist = get_vmlist
();
1012 my $d = $vmlist->{ids
}->{$vmid};
1013 return 1 if !defined($d);
1015 return undef if $noerr;
1017 my $vmtypestr = $d->{type
} eq 'qemu' ?
'VM' : 'CT';
1018 die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
1021 sub check_node_exists
{
1022 my ($nodename, $noerr) = @_;
1024 my $nodelist = $clinfo->{nodelist
};
1025 return 1 if $nodelist && $nodelist->{$nodename};
1027 return undef if $noerr;
1029 die "no such cluster node '$nodename'\n";
1032 # this is also used to get the IP of the local node
1033 sub remote_node_ip
{
1034 my ($nodename, $noerr) = @_;
1036 my $nodelist = $clinfo->{nodelist
};
1037 if ($nodelist && $nodelist->{$nodename}) {
1038 if (my $ip = $nodelist->{$nodename}->{ip
}) {
1039 return $ip if !wantarray;
1040 my $family = $nodelist->{$nodename}->{address_family
};
1042 $nodelist->{$nodename}->{address_family
} =
1044 PVE
::Tools
::get_host_address_family
($ip);
1046 return wantarray ?
($ip, $family) : $ip;
1050 # fallback: try to get IP by other means
1051 return PVE
::Network
::get_ip_from_hostname
($nodename, $noerr);
1054 sub get_local_migration_ip
{
1055 my ($migration_network, $noerr) = @_;
1057 my $cidr = $migration_network;
1059 if (!defined($cidr)) {
1060 my $dc_conf = cfs_read_file
('datacenter.cfg');
1061 $cidr = $dc_conf->{migration
}->{network
}
1062 if defined($dc_conf->{migration
}->{network
});
1065 if (defined($cidr)) {
1066 my $ips = PVE
::Network
::get_local_ip_from_cidr
($cidr);
1068 die "could not get migration ip: no IP address configured on local " .
1069 "node for network '$cidr'\n" if !$noerr && (scalar(@$ips) == 0);
1071 die "could not get migration ip: multiple IP address configured for " .
1072 "network '$cidr'\n" if !$noerr && (scalar(@$ips) > 1);
1080 # ssh related utility functions
1082 sub ssh_merge_keys
{
1083 # remove duplicate keys in $sshauthkeys
1084 # ssh-copy-id simply add keys, so the file can grow to large
1087 if (-f
$sshauthkeys) {
1088 $data = PVE
::Tools
::file_get_contents
($sshauthkeys, 128*1024);
1093 if (-f
$rootsshauthkeysbackup) {
1095 $data .= PVE
::Tools
::file_get_contents
($rootsshauthkeysbackup, 128*1024);
1100 # always add ourself
1101 if (-f
$ssh_rsa_id) {
1102 my $pub = PVE
::Tools
::file_get_contents
($ssh_rsa_id);
1104 $data .= "\n$pub\n";
1109 my @lines = split(/\n/, $data);
1110 foreach my $line (@lines) {
1111 if ($line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/) {
1112 next if $vhash->{$3}++;
1114 $newdata .= "$line\n";
1117 PVE
::Tools
::file_set_contents
($sshauthkeys, $newdata, 0600);
1119 if ($found_backup && -l
$rootsshauthkeys) {
1120 # everything went well, so we can remove the backup
1121 unlink $rootsshauthkeysbackup;
1125 sub setup_sshd_config
{
1128 my $conf = PVE
::Tools
::file_get_contents
($sshd_config_fn);
1130 return if $conf =~ m/^PermitRootLogin\s+yes\s*$/m;
1132 if ($conf !~ s/^#?PermitRootLogin.*$/PermitRootLogin yes/m) {
1134 $conf .= "\nPermitRootLogin yes\n";
1137 PVE
::Tools
::file_set_contents
($sshd_config_fn, $conf);
1139 PVE
::Tools
::run_command
(['systemctl', 'reload-or-restart', 'sshd']);
1142 sub setup_rootsshconfig
{
1144 # create ssh key if it does not exist
1145 if (! -f
$ssh_rsa_id) {
1146 mkdir '/root/.ssh/';
1147 system ("echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}");
1150 # create ssh config if it does not exist
1151 if (! -f
$rootsshconfig) {
1153 if (my $fh = IO
::File-
>new($rootsshconfig, O_CREAT
|O_WRONLY
|O_EXCL
, 0640)) {
1154 # this is the default ciphers list from Debian's OpenSSH package (OpenSSH_7.4p1 Debian-10, OpenSSL 1.0.2k 26 Jan 2017)
1155 # changed order to put AES before Chacha20 (most hardware has AESNI)
1156 print $fh "Ciphers aes128-ctr,aes192-ctr,aes256-ctr,aes128-gcm\@openssh.com,aes256-gcm\@openssh.com,chacha20-poly1305\@openssh.com\n";
1162 sub setup_ssh_keys
{
1168 if (! -f
$sshauthkeys) {
1170 if (-f
$rootsshauthkeys) {
1171 $old = PVE
::Tools
::file_get_contents
($rootsshauthkeys, 128*1024);
1173 if (my $fh = IO
::File-
>new ($sshauthkeys, O_CREAT
|O_WRONLY
|O_EXCL
, 0400)) {
1174 PVE
::Tools
::safe_print
($sshauthkeys, $fh, $old) if $old;
1180 warn "can't create shared ssh key database '$sshauthkeys'\n"
1181 if ! -f
$sshauthkeys;
1183 if (-f
$rootsshauthkeys && ! -l
$rootsshauthkeys) {
1184 if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
1185 warn "rename $rootsshauthkeys failed - $!\n";
1189 if (! -l
$rootsshauthkeys) {
1190 symlink $sshauthkeys, $rootsshauthkeys;
1193 if (! -l
$rootsshauthkeys) {
1194 warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
1196 unlink $rootsshauthkeysbackup if $import_ok;
1200 sub ssh_unmerge_known_hosts
{
1201 return if ! -l
$sshglobalknownhosts;
1204 $old = PVE
::Tools
::file_get_contents
($sshknownhosts, 128*1024)
1205 if -f
$sshknownhosts;
1207 PVE
::Tools
::file_set_contents
($sshglobalknownhosts, $old);
1210 sub ssh_merge_known_hosts
{
1211 my ($nodename, $ip_address, $createLink) = @_;
1213 die "no node name specified" if !$nodename;
1214 die "no ip address specified" if !$ip_address;
1216 # ssh lowercases hostnames (aliases) before comparision, so we need too
1217 $nodename = lc($nodename);
1218 $ip_address = lc($ip_address);
1222 if (! -f
$sshknownhosts) {
1223 if (my $fh = IO
::File-
>new($sshknownhosts, O_CREAT
|O_WRONLY
|O_EXCL
, 0600)) {
1228 my $old = PVE
::Tools
::file_get_contents
($sshknownhosts, 128*1024);
1232 if ((! -l
$sshglobalknownhosts) && (-f
$sshglobalknownhosts)) {
1233 $new = PVE
::Tools
::file_get_contents
($sshglobalknownhosts, 128*1024);
1236 my $hostkey = PVE
::Tools
::file_get_contents
($ssh_host_rsa_id);
1237 # Note: file sometimes containe emty lines at start, so we use multiline match
1238 die "can't parse $ssh_host_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/m;
1247 my $merge_line = sub {
1248 my ($line, $all) = @_;
1250 return if $line =~ m/^\s*$/; # skip empty lines
1251 return if $line =~ m/^#/; # skip comments
1253 if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
1256 if (!$vhash->{$key}) {
1258 if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
1259 my $salt = decode_base64
($1);
1261 my $hmac = Digest
::HMAC_SHA1-
>new($salt);
1262 $hmac->add($nodename);
1263 my $hd = $hmac->b64digest . '=';
1264 if ($digest eq $hd) {
1265 if ($rsakey eq $hostkey) {
1266 $found_nodename = 1;
1271 $hmac = Digest
::HMAC_SHA1-
>new($salt);
1272 $hmac->add($ip_address);
1273 $hd = $hmac->b64digest . '=';
1274 if ($digest eq $hd) {
1275 if ($rsakey eq $hostkey) {
1276 $found_local_ip = 1;
1282 $key = lc($key); # avoid duplicate entries, ssh compares lowercased
1283 if ($key eq $ip_address) {
1284 $found_local_ip = 1 if $rsakey eq $hostkey;
1285 } elsif ($key eq $nodename) {
1286 $found_nodename = 1 if $rsakey eq $hostkey;
1296 while ($old && $old =~ s/^((.*?)(\n|$))//) {
1298 &$merge_line($line, 1);
1301 while ($new && $new =~ s/^((.*?)(\n|$))//) {
1303 &$merge_line($line);
1306 # add our own key if not already there
1307 $data .= "$nodename $hostkey\n" if !$found_nodename;
1308 $data .= "$ip_address $hostkey\n" if !$found_local_ip;
1310 PVE
::Tools
::file_set_contents
($sshknownhosts, $data);
1312 return if !$createLink;
1314 unlink $sshglobalknownhosts;
1315 symlink $sshknownhosts, $sshglobalknownhosts;
1317 warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
1318 if ! -l
$sshglobalknownhosts;
1322 my $migration_format = {
1326 enum
=> ['secure', 'insecure'],
1327 description
=> "Migration traffic is encrypted using an SSH tunnel by " .
1328 "default. On secure, completely private networks this can be " .
1329 "disabled to increase performance.",
1330 default => 'secure',
1334 type
=> 'string', format
=> 'CIDR',
1335 format_description
=> 'CIDR',
1336 description
=> "CIDR of the (sub) network that is used for migration."
1340 my $datacenter_schema = {
1342 additionalProperties
=> 0,
1347 description
=> "Default keybord layout for vnc server.",
1348 enum
=> PVE
::Tools
::kvmkeymaplist
(),
1353 description
=> "Default GUI language.",
1354 enum
=> [ 'en', 'de' ],
1359 description
=> "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1360 pattern
=> "http://.*",
1362 migration_unsecure
=> {
1365 description
=> "Migration is secure using SSH tunnel by default. " .
1366 "For secure private networks you can disable it to speed up " .
1367 "migration. Deprecated, use the 'migration' property instead!",
1371 type
=> 'string', format
=> $migration_format,
1372 description
=> "For cluster wide migration settings.",
1377 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).",
1378 enum
=> ['applet', 'vv', 'html5'],
1383 format
=> 'email-opt',
1384 description
=> "Specify email address to send notification from (default is root@\$hostname)",
1390 description
=> "Defines how many workers (per node) are maximal started ".
1391 " on actions like 'stopall VMs' or task from the ha-manager.",
1396 default => 'watchdog',
1397 enum
=> [ 'watchdog', 'hardware', 'both' ],
1398 description
=> "Set the fencing mode of the HA cluster. Hardware mode " .
1399 "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
1400 " With both all two modes are used." .
1401 "\n\nWARNING: 'hardware' and 'both' are EXPERIMENTAL & WIP",
1406 pattern
=> qr/[a-f0-9]{2}(?::[a-f0-9]{2}){0,2}:?/i,
1407 description
=> 'Prefix for autogenerated MAC addresses.',
1409 bwlimit
=> PVE
::JSONSchema
::get_standard_option
('bwlimit'),
1413 # make schema accessible from outside (for documentation)
1414 sub get_datacenter_schema
{ return $datacenter_schema };
1416 sub parse_datacenter_config
{
1417 my ($filename, $raw) = @_;
1419 my $res = PVE
::JSONSchema
::parse_config
($datacenter_schema, $filename, $raw // '');
1421 if (my $migration = $res->{migration
}) {
1422 $res->{migration
} = PVE
::JSONSchema
::parse_property_string
($migration_format, $migration);
1425 # for backwards compatibility only, new migration property has precedence
1426 if (defined($res->{migration_unsecure
})) {
1427 if (defined($res->{migration
}->{type
})) {
1428 warn "deprecated setting 'migration_unsecure' and new 'migration: type' " .
1429 "set at same time! Ignore 'migration_unsecure'\n";
1431 $res->{migration
}->{type
} = ($res->{migration_unsecure
}) ?
'insecure' : 'secure';
1435 # for backwards compatibility only, applet maps to html5
1436 if (defined($res->{console
}) && $res->{console
} eq 'applet') {
1437 $res->{console
} = 'html5';
1443 sub write_datacenter_config
{
1444 my ($filename, $cfg) = @_;
1446 # map deprecated setting to new one
1447 if (defined($cfg->{migration_unsecure
}) && !defined($cfg->{migration
})) {
1448 my $migration_unsecure = delete $cfg->{migration_unsecure
};
1449 $cfg->{migration
}->{type
} = ($migration_unsecure) ?
'insecure' : 'secure';
1452 # map deprecated applet setting to html5
1453 if (defined($cfg->{console
}) && $cfg->{console
} eq 'applet') {
1454 $cfg->{console
} = 'html5';
1457 if (my $migration = $cfg->{migration
}) {
1458 $cfg->{migration
} = PVE
::JSONSchema
::print_property_string
($migration, $migration_format);
1461 return PVE
::JSONSchema
::dump_config
($datacenter_schema, $filename, $cfg);
1464 cfs_register_file
('datacenter.cfg',
1465 \
&parse_datacenter_config
,
1466 \
&write_datacenter_config
);
1468 # X509 Certificate cache helper
1470 my $cert_cache_nodes = {};
1471 my $cert_cache_timestamp = time();
1472 my $cert_cache_fingerprints = {};
1474 sub update_cert_cache
{
1475 my ($update_node, $clear) = @_;
1477 syslog
('info', "Clearing outdated entries from certificate cache")
1480 $cert_cache_timestamp = time() if !defined($update_node);
1482 my $node_list = defined($update_node) ?
1483 [ $update_node ] : [ keys %$cert_cache_nodes ];
1485 foreach my $node (@$node_list) {
1486 my $clear_old = sub {
1487 if (my $old_fp = $cert_cache_nodes->{$node}) {
1488 # distrust old fingerprint
1489 delete $cert_cache_fingerprints->{$old_fp};
1490 # ensure reload on next proxied request
1491 delete $cert_cache_nodes->{$node};
1495 my $fp = eval { get_node_fingerprint
($node) };
1498 &$clear_old() if $clear;
1502 my $old_fp = $cert_cache_nodes->{$node};
1503 $cert_cache_fingerprints->{$fp} = 1;
1504 $cert_cache_nodes->{$node} = $fp;
1506 if (defined($old_fp) && $fp ne $old_fp) {
1507 delete $cert_cache_fingerprints->{$old_fp};
1512 # load and cache cert fingerprint once
1513 sub initialize_cert_cache
{
1516 update_cert_cache
($node)
1517 if defined($node) && !defined($cert_cache_nodes->{$node});
1520 sub read_ssl_cert_fingerprint
{
1521 my ($cert_path) = @_;
1523 my $bio = Net
::SSLeay
::BIO_new_file
($cert_path, 'r')
1524 or die "unable to read '$cert_path' - $!\n";
1526 my $cert = Net
::SSLeay
::PEM_read_bio_X509
($bio);
1528 Net
::SSLeay
::BIO_free
($bio);
1529 die "unable to read certificate from '$cert_path'\n";
1532 my $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
1533 Net
::SSLeay
::X509_free
($cert);
1535 die "unable to get fingerprint for '$cert_path' - got empty value\n"
1536 if !defined($fp) || $fp eq '';
1541 sub get_node_fingerprint
{
1544 my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
1545 my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
1547 $cert_path = $custom_cert_path if -f
$custom_cert_path;
1549 return read_ssl_cert_fingerprint
($cert_path);
1553 sub check_cert_fingerprint
{
1556 # clear cache every 30 minutes at least
1557 update_cert_cache
(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
1559 # get fingerprint of server certificate
1560 my $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
1561 return 0 if !defined($fp) || $fp eq ''; # error
1564 for my $expected (keys %$cert_cache_fingerprints) {
1565 return 1 if $fp eq $expected;
1570 return 1 if &$check();
1572 # clear cache and retry at most once every minute
1573 if (time() - $cert_cache_timestamp >= 60) {
1574 syslog
('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
1575 update_cert_cache
();
1582 # bash completion helpers
1584 sub complete_next_vmid
{
1586 my $vmlist = get_vmlist
() || {};
1587 my $idlist = $vmlist->{ids
} || {};
1589 for (my $i = 100; $i < 10000; $i++) {
1590 return [$i] if !defined($idlist->{$i});
1598 my $vmlist = get_vmlist
();
1599 my $ids = $vmlist->{ids
} || {};
1601 return [ keys %$ids ];
1604 sub complete_local_vmid
{
1606 my $vmlist = get_vmlist
();
1607 my $ids = $vmlist->{ids
} || {};
1609 my $nodename = PVE
::INotify
::nodename
();
1612 foreach my $vmid (keys %$ids) {
1613 my $d = $ids->{$vmid};
1614 next if !$d->{node
} || $d->{node
} ne $nodename;
1621 sub complete_migration_target
{
1625 my $nodename = PVE
::INotify
::nodename
();
1627 my $nodelist = get_nodelist
();
1628 foreach my $node (@$nodelist) {
1629 next if $node eq $nodename;
1637 my ($node, $network_cidr) = @_;
1640 if (defined($network_cidr)) {
1641 # Use mtunnel via to get the remote node's ip inside $network_cidr.
1642 # This goes over the regular network (iow. uses get_ssh_info() with
1643 # $network_cidr undefined.
1644 # FIXME: Use the REST API client for this after creating an API entry
1645 # for get_migration_ip.
1646 my $default_remote = get_ssh_info
($node, undef);
1647 my $default_ssh = ssh_info_to_command
($default_remote);
1648 my $cmd =[@$default_ssh, 'pvecm', 'mtunnel',
1649 '-migration_network', $network_cidr,
1652 PVE
::Tools
::run_command
($cmd, outfunc
=> sub {
1655 die "internal error: unexpected output from mtunnel\n"
1657 if ($line =~ /^ip: '(.*)'$/) {
1660 die "internal error: bad output from mtunnel\n"
1664 die "failed to get ip for node '$node' in network '$network_cidr'\n"
1667 $ip = remote_node_ip
($node);
1673 network
=> $network_cidr,
1677 sub ssh_info_to_command_base
{
1678 my ($info, @extra_options) = @_;
1682 '-o', 'BatchMode=yes',
1683 '-o', 'HostKeyAlias='.$info->{name
},
1688 sub ssh_info_to_command
{
1689 my ($info, @extra_options) = @_;
1690 my $cmd = ssh_info_to_command_base
($info, @extra_options);
1691 push @$cmd, "root\@$info->{ip}";
1695 sub assert_joinable
{
1696 my ($ring0_addr, $ring1_addr, $force) = @_;
1699 my $error = sub { $errors .= "* $_[0]\n"; };
1702 $error->("authentication key '$authfile' already exists");
1705 if (-f
$clusterconf) {
1706 $error->("cluster config '$clusterconf' already exists");
1709 my $vmlist = get_vmlist
();
1710 if ($vmlist && $vmlist->{ids
} && scalar(keys %{$vmlist->{ids
}})) {
1711 $error->("this host already contains virtual guests");
1714 if (run_command
(['corosync-quorumtool', '-l'], noerr
=> 1, quiet
=> 1) == 0) {
1715 $error->("corosync is already running, is this node already in a cluster?!");
1718 # check if corosync ring IPs are configured on the current nodes interfaces
1719 my $check_ip = sub {
1720 my $ip = shift // return;
1721 if (!PVE
::JSONSchema
::pve_verify_ip
($ip, 1)) {
1723 eval { $ip = PVE
::Network
::get_ip_from_hostname
($host); };
1725 $error->("cannot use '$host': $@\n") ;
1730 my $cidr = (Net
::IP
::ip_is_ipv6
($ip)) ?
"$ip/128" : "$ip/32";
1731 my $configured_ips = PVE
::Network
::get_local_ip_from_cidr
($cidr);
1733 $error->("cannot use IP '$ip', it must be configured exactly once on local node!\n")
1734 if (scalar(@$configured_ips) != 1);
1737 $check_ip->($ring0_addr);
1738 $check_ip->($ring1_addr);
1741 warn "detected the following error(s):\n$errors";
1742 die "Check if node may join a cluster failed!\n" if !$force;
1746 my $backup_cfs_database = sub {
1751 print "backup old database\n";
1755 ['sqlite3', $dbfile],
1756 ['gzip', '-', \
">${dbbackupdir}/config-${ctime}.sql.gz"],
1759 PVE
::Tools
::run_command
($cmd, 'errmsg' => "cannot backup old database\n");
1761 # purge older backup
1764 foreach my $fn (<$dbbackupdir/config-*.sql
.gz
>) {
1765 if ($fn =~ m!/config-(\d+)\.sql.gz$!) {
1766 push @bklist, [$fn, $1];
1770 @bklist = sort { $b->[1] <=> $a->[1] } @bklist;
1771 while (scalar (@bklist) >= $maxfiles) {
1772 my $d = pop @bklist;
1773 print "delete old backup '$d->[0]'\n";
1781 my $nodename = PVE
::INotify
::nodename
();
1783 setup_sshd_config
();
1784 setup_rootsshconfig
();
1787 # check if we can join with the given parameters and current node state
1788 my ($ring0_addr, $ring1_addr) = $param->@{'ring0_addr', 'ring1_addr'};
1789 assert_joinable
($ring0_addr, $ring1_addr, $param->{force
});
1791 # make sure known_hosts is on local filesystem
1792 ssh_unmerge_known_hosts
();
1794 my $host = $param->{hostname
};
1797 username
=> 'root@pam',
1798 password
=> $param->{password
},
1799 cookie_name
=> 'PVEAuthCookie',
1800 protocol
=> 'https',
1805 if (my $fp = $param->{fingerprint
}) {
1806 $conn_args->{cached_fingerprints
} = { uc($fp) => 1 };
1808 # API schema ensures that we can only get here from CLI handler
1809 $conn_args->{manual_verification
} = 1;
1812 print "Etablishing API connection with host '$host'\n";
1814 my $conn = PVE
::APIClient
::LWP-
>new(%$conn_args);
1817 # login raises an exception on failure, so if we get here we're good
1818 print "Login succeeded.\n";
1821 $args->{force
} = $param->{force
} if defined($param->{force
});
1822 $args->{nodeid
} = $param->{nodeid
} if $param->{nodeid
};
1823 $args->{votes
} = $param->{votes
} if defined($param->{votes
});
1824 $args->{ring0_addr
} = $ring0_addr if defined($ring0_addr);
1825 $args->{ring1_addr
} = $ring1_addr if defined($ring1_addr);
1827 print "Request addition of this node\n";
1828 my $res = $conn->post("/cluster/config/nodes/$nodename", $args);
1830 print "Join request OK, finishing setup locally\n";
1832 # added successfuly - now prepare local node
1833 finish_join
($nodename, $res->{corosync_conf
}, $res->{corosync_authkey
});
1837 my ($nodename, $corosync_conf, $corosync_authkey) = @_;
1839 mkdir "$localclusterdir";
1840 PVE
::Tools
::file_set_contents
($authfile, $corosync_authkey);
1841 PVE
::Tools
::file_set_contents
($localclusterconf, $corosync_conf);
1843 print "stopping pve-cluster service\n";
1844 my $cmd = ['systemctl', 'stop', 'pve-cluster'];
1845 run_command
($cmd, errmsg
=> "can't stop pve-cluster service");
1847 $backup_cfs_database->($dbfile);
1850 $cmd = ['systemctl', 'start', 'corosync', 'pve-cluster'];
1851 run_command
($cmd, errmsg
=> "starting pve-cluster failed");
1855 while (!check_cfs_quorum
(1)) {
1857 print "waiting for quorum...";
1863 print "OK\n" if !$printqmsg;
1865 my $local_ip_address = remote_node_ip
($nodename);
1867 print "generating node certificates\n";
1868 gen_pve_node_files
($nodename, $local_ip_address);
1870 print "merge known_hosts file\n";
1871 ssh_merge_known_hosts
($nodename, $local_ip_address, 1);
1873 print "node certificate changed, restart pveproxy and pvedaemon services\n";
1874 run_command
(['systemctl', 'reload-or-restart', 'pvedaemon', 'pveproxy']);
1876 print "successfully added node '$nodename' to cluster.\n";