8 use Storable
qw(dclone);
12 use Digest
::HMAC_SHA1
;
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 my $authprivkeyfn = "$authdir/authkey.key";
41 my $authpubkeyfn = "$basedir/authkey.pub";
42 my $pveca_key_fn = "$authdir/pve-root-ca.key";
43 my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
44 my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
45 # this is just a secret accessable by the web browser
46 # and is used for CSRF prevention
47 my $pvewww_key_fn = "$basedir/pve-www.key";
50 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
51 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
52 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
53 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
54 my $sshknownhosts = "/etc/pve/priv/known_hosts";
55 my $sshauthkeys = "/etc/pve/priv/authorized_keys";
56 my $sshd_config_fn = "/etc/ssh/sshd_config";
57 my $rootsshauthkeys = "/root/.ssh/authorized_keys";
58 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
59 my $rootsshconfig = "/root/.ssh/config";
64 'datacenter.cfg' => 1,
66 'corosync.conf.new' => 1,
69 'priv/shadow.cfg' => 1,
73 'ha/crm_commands' => 1,
74 'ha/manager_status' => 1,
75 'ha/resources.cfg' => 1,
81 # only write output if something fails
87 my $record_output = sub {
93 PVE
::Tools
::run_command
($cmd, outfunc
=> $record_output,
94 errfunc
=> $record_output);
100 print STDERR
$outbuf;
105 sub check_cfs_quorum
{
108 # note: -w filename always return 1 for root, so wee need
109 # to use File::lstat here
110 my $st = File
::stat::lstat("$basedir/local");
111 my $quorate = ($st && (($st->mode & 0200) != 0));
113 die "cluster not ready - no quorum?\n" if !$quorate && !$noerr;
118 sub check_cfs_is_mounted
{
121 my $res = -l
"$basedir/local";
123 die "pve configuration filesystem not mounted\n"
132 check_cfs_is_mounted
();
134 my @required_dirs = (
137 "$basedir/nodes/$nodename",
138 "$basedir/nodes/$nodename/lxc",
139 "$basedir/nodes/$nodename/qemu-server",
140 "$basedir/nodes/$nodename/openvz",
141 "$basedir/nodes/$nodename/priv");
143 foreach my $dir (@required_dirs) {
145 mkdir($dir) || $! == EEXIST
|| die "unable to create directory '$dir' - $!\n";
152 return if -f
"$authprivkeyfn";
154 check_cfs_is_mounted
();
156 mkdir $authdir || $! == EEXIST
|| die "unable to create dir '$authdir' - $!\n";
158 run_silent_cmd
(['openssl', 'genrsa', '-out', $authprivkeyfn, '2048']);
160 run_silent_cmd
(['openssl', 'rsa', '-in', $authprivkeyfn, '-pubout', '-out', $authpubkeyfn]);
165 return if -f
$pveca_key_fn;
168 run_silent_cmd
(['openssl', 'genrsa', '-out', $pveca_key_fn, '4096']);
171 die "unable to generate pve ca key:\n$@" if $@;
176 if (-f
$pveca_key_fn && -f
$pveca_cert_fn) {
182 # we try to generate an unique 'subject' to avoid browser problems
183 # (reused serial numbers, ..)
185 UUID
::generate
($uuid);
187 UUID
::unparse
($uuid, $uuid_str);
190 # wrap openssl with faketime to prevent bug #904
191 run_silent_cmd
(['faketime', 'yesterday', 'openssl', 'req', '-batch',
192 '-days', '3650', '-new', '-x509', '-nodes', '-key',
193 $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
194 "/CN=Proxmox Virtual Environment/OU=$uuid_str/O=PVE Cluster Manager CA/"]);
197 die "generating pve root certificate failed:\n$@" if $@;
202 sub gen_pve_ssl_key
{
205 die "no node name specified" if !$nodename;
207 my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
209 return if -f
$pvessl_key_fn;
212 run_silent_cmd
(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
215 die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
218 sub gen_pve_www_key
{
220 return if -f
$pvewww_key_fn;
223 run_silent_cmd
(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
226 die "unable to generate pve www key:\n$@" if $@;
232 PVE
::Tools
::file_set_contents
($pveca_srl_fn, $serial);
235 sub gen_pve_ssl_cert
{
236 my ($force, $nodename, $ip) = @_;
238 die "no node name specified" if !$nodename;
239 die "no IP specified" if !$ip;
241 my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
243 return if !$force && -f
$pvessl_cert_fn;
245 my $names = "IP:127.0.0.1,IP:::1,DNS:localhost";
247 my $rc = PVE
::INotify
::read_file
('resolvconf');
251 my $fqdn = $nodename;
253 $names .= ",DNS:$nodename";
255 if ($rc && $rc->{search
}) {
256 $fqdn = $nodename . "." . $rc->{search
};
257 $names .= ",DNS:$fqdn";
260 my $sslconf = <<__EOD;
261 RANDFILE = /root/.rnd
266 distinguished_name = req_distinguished_name
267 req_extensions = v3_req
269 string_mask = nombstr
271 [ req_distinguished_name ]
272 organizationalUnitName = PVE Cluster Node
273 organizationName = Proxmox Virtual Environment
277 basicConstraints = CA:FALSE
278 extendedKeyUsage = serverAuth
279 subjectAltName = $names
282 my $cfgfn = "/tmp/pvesslconf-$$.tmp";
283 my $fh = IO
::File-
>new ($cfgfn, "w");
287 my $reqfn = "/tmp/pvecertreq-$$.tmp";
290 my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
292 run_silent_cmd
(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
293 '-key', $pvessl_key_fn, '-out', $reqfn]);
299 die "unable to generate pve certificate request:\n$err";
302 update_serial
("0000000000000000") if ! -f
$pveca_srl_fn;
305 # wrap openssl with faketime to prevent bug #904
306 run_silent_cmd
(['faketime', 'yesterday', 'openssl', 'x509', '-req',
307 '-in', $reqfn, '-days', '3650', '-out', $pvessl_cert_fn,
308 '-CAkey', $pveca_key_fn, '-CA', $pveca_cert_fn,
309 '-CAserial', $pveca_srl_fn, '-extfile', $cfgfn]);
315 die "unable to generate pve ssl certificate:\n$err";
322 sub gen_pve_node_files
{
323 my ($nodename, $ip, $opt_force) = @_;
325 gen_local_dirs
($nodename);
329 # make sure we have a (cluster wide) secret
330 # for CSRFR prevention
333 # make sure we have a (per node) private key
334 gen_pve_ssl_key
($nodename);
336 # make sure we have a CA
337 my $force = gen_pveca_cert
();
339 $force = 1 if $opt_force;
341 gen_pve_ssl_cert
($force, $nodename, $ip);
344 my $vzdump_cron_dummy = <<__EOD;
345 # cluster wide vzdump cron schedule
346 # Atomatically generated file - do not edit
348 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
352 sub gen_pve_vzdump_symlink
{
354 my $filename = "/etc/pve/vzdump.cron";
356 my $link_fn = "/etc/cron.d/vzdump";
358 if ((-f
$filename) && (! -l
$link_fn)) {
359 rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
360 symlink($filename, $link_fn);
364 sub gen_pve_vzdump_files
{
366 my $filename = "/etc/pve/vzdump.cron";
368 PVE
::Tools
::file_set_contents
($filename, $vzdump_cron_dummy)
371 gen_pve_vzdump_symlink
();
378 my $ipcc_send_rec = sub {
379 my ($msgid, $data) = @_;
381 my $res = PVE
::IPCC
::ipcc_send_rec
($msgid, $data);
383 die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
388 my $ipcc_send_rec_json = sub {
389 my ($msgid, $data) = @_;
391 my $res = PVE
::IPCC
::ipcc_send_rec
($msgid, $data);
393 die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
395 return decode_json
($res);
398 my $ipcc_get_config = sub {
401 my $bindata = pack "Z*", $path;
402 my $res = PVE
::IPCC
::ipcc_send_rec
(6, $bindata);
403 if (!defined($res)) {
404 return undef if ($! != 0);
411 my $ipcc_get_status = sub {
412 my ($name, $nodename) = @_;
414 my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
415 return PVE
::IPCC
::ipcc_send_rec
(5, $bindata);
418 my $ipcc_update_status = sub {
419 my ($name, $data) = @_;
421 my $raw = ref($data) ? encode_json
($data) : $data;
423 my $bindata = pack "Z[256]Z*", $name, $raw;
425 return &$ipcc_send_rec(4, $bindata);
429 my ($priority, $ident, $tag, $msg) = @_;
431 my $bindata = pack "CCCZ*Z*Z*", $priority, bytes
::length($ident) + 1,
432 bytes
::length($tag) + 1, $ident, $tag, $msg;
434 return &$ipcc_send_rec(7, $bindata);
437 my $ipcc_get_cluster_log = sub {
438 my ($user, $max) = @_;
440 $max = 0 if !defined($max);
442 my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
443 return &$ipcc_send_rec(8, $bindata);
450 my $res = &$ipcc_send_rec_json(1);
451 #warn "GOT1: " . Dumper($res);
452 die "no starttime\n" if !$res->{starttime
};
454 if (!$res->{starttime
} || !$versions->{starttime
} ||
455 $res->{starttime
} != $versions->{starttime
}) {
456 #print "detected changed starttime\n";
474 if (!$clinfo->{version
} || $clinfo->{version
} != $versions->{clinfo
}) {
475 #warn "detected new clinfo\n";
476 $clinfo = &$ipcc_send_rec_json(2);
486 if (!$vmlist->{version
} || $vmlist->{version
} != $versions->{vmlist
}) {
487 #warn "detected new vmlist1\n";
488 $vmlist = &$ipcc_send_rec_json(3);
507 return $clinfo->{nodelist
};
512 my $nodelist = $clinfo->{nodelist
};
516 my $nodename = PVE
::INotify
::nodename
();
518 if (!$nodelist || !$nodelist->{$nodename}) {
519 return [ $nodename ];
522 return [ keys %$nodelist ];
525 sub broadcast_tasklist
{
529 &$ipcc_update_status("tasklist", $data);
535 my $tasklistcache = {};
540 my $kvstore = $versions->{kvstore
} || {};
542 my $nodelist = get_nodelist
();
545 foreach my $node (@$nodelist) {
546 next if $nodename && ($nodename ne $node);
548 my $ver = $kvstore->{$node}->{tasklist
} if $kvstore->{$node};
549 my $cd = $tasklistcache->{$node};
550 if (!$cd || !$ver || !$cd->{version
} ||
551 ($cd->{version
} != $ver)) {
552 my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
553 my $data = decode_json
($raw);
555 $cd = $tasklistcache->{$node} = {
559 } elsif ($cd && $cd->{data
}) {
560 push @$res, @{$cd->{data
}};
564 syslog
('err', $err) if $err;
571 my ($rrdid, $data) = @_;
574 &$ipcc_update_status("rrd/$rrdid", $data);
581 my $last_rrd_dump = 0;
582 my $last_rrd_data = "";
588 my $diff = $ctime - $last_rrd_dump;
590 return $last_rrd_data;
595 $raw = &$ipcc_send_rec(10);
607 while ($raw =~ s/^(.*)\n//) {
608 my ($key, @ela) = split(/:/, $1);
610 next if !(scalar(@ela) > 1);
611 $res->{$key} = [ map { $_ eq 'U' ?
undef : $_ } @ela ];
615 $last_rrd_dump = $ctime;
616 $last_rrd_data = $res;
621 sub create_rrd_data
{
622 my ($rrdname, $timeframe, $cf) = @_;
624 my $rrddir = "/var/lib/rrdcached/db";
626 my $rrd = "$rrddir/$rrdname";
630 day
=> [ 60*30, 70 ],
631 week
=> [ 60*180, 70 ],
632 month
=> [ 60*720, 70 ],
633 year
=> [ 60*10080, 70 ],
636 my ($reso, $count) = @{$setup->{$timeframe}};
637 my $ctime = $reso*int(time()/$reso);
638 my $req_start = $ctime - $reso*$count;
640 $cf = "AVERAGE" if !$cf;
648 my $socket = "/var/run/rrdcached.sock";
649 push @args, "--daemon" => "unix:$socket" if -S
$socket;
651 my ($start, $step, $names, $data) = RRDs
::fetch
($rrd, $cf, @args);
653 my $err = RRDs
::error
;
654 die "RRD error: $err\n" if $err;
656 die "got wrong time resolution ($step != $reso)\n"
660 my $fields = scalar(@$names);
661 for my $line (@$data) {
662 my $entry = { 'time' => $start };
664 for (my $i = 0; $i < $fields; $i++) {
665 my $name = $names->[$i];
666 if (defined(my $val = $line->[$i])) {
667 $entry->{$name} = $val;
669 # leave empty fields undefined
670 # maybe make this configurable?
679 sub create_rrd_graph
{
680 my ($rrdname, $timeframe, $ds, $cf) = @_;
682 # Using RRD graph is clumsy - maybe it
683 # is better to simply fetch the data, and do all display
684 # related things with javascript (new extjs html5 graph library).
686 my $rrddir = "/var/lib/rrdcached/db";
688 my $rrd = "$rrddir/$rrdname";
690 my @ids = PVE
::Tools
::split_list
($ds);
692 my $ds_txt = join('_', @ids);
694 my $filename = "${rrd}_${ds_txt}.png";
698 day
=> [ 60*30, 70 ],
699 week
=> [ 60*180, 70 ],
700 month
=> [ 60*720, 70 ],
701 year
=> [ 60*10080, 70 ],
704 my ($reso, $count) = @{$setup->{$timeframe}};
707 "--imgformat" => "PNG",
711 "--start" => - $reso*$count,
713 "--lower-limit" => 0,
716 my $socket = "/var/run/rrdcached.sock";
717 push @args, "--daemon" => "unix:$socket" if -S
$socket;
719 my @coldef = ('#00ddff', '#ff0000');
721 $cf = "AVERAGE" if !$cf;
724 foreach my $id (@ids) {
725 my $col = $coldef[$i++] || die "fixme: no color definition";
726 push @args, "DEF:${id}=$rrd:${id}:$cf";
728 if ($id eq 'cpu' || $id eq 'iowait') {
729 push @args, "CDEF:${id}_per=${id},100,*";
730 $dataid = "${id}_per";
732 push @args, "LINE2:${dataid}${col}:${id}";
735 push @args, '--full-size-mode';
737 # we do not really store data into the file
738 my $res = RRDs
::graphv
('', @args);
740 my $err = RRDs
::error
;
741 die "RRD error: $err\n" if $err;
743 return { filename
=> $filename, image
=> $res->{image
} };
746 # a fast way to read files (avoid fuse overhead)
750 return &$ipcc_get_config($path);
753 sub get_cluster_log
{
754 my ($user, $max) = @_;
756 return &$ipcc_get_cluster_log($user, $max);
761 sub cfs_register_file
{
762 my ($filename, $parser, $writer) = @_;
764 $observed->{$filename} || die "unknown file '$filename'";
766 die "file '$filename' already registered" if $file_info->{$filename};
768 $file_info->{$filename} = {
774 my $ccache_read = sub {
775 my ($filename, $parser, $version) = @_;
777 $ccache->{$filename} = {} if !$ccache->{$filename};
779 my $ci = $ccache->{$filename};
781 if (!$ci->{version
} || !$version || $ci->{version
} != $version) {
782 # we always call the parser, even when the file does not exists
783 # (in that case $data is undef)
784 my $data = get_config
($filename);
785 $ci->{data
} = &$parser("/etc/pve/$filename", $data);
786 $ci->{version
} = $version;
789 my $res = ref($ci->{data
}) ? dclone
($ci->{data
}) : $ci->{data
};
794 sub cfs_file_version
{
799 if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) {
800 my ($type, $vmid) = ($1, $2);
801 if ($vmlist && $vmlist->{ids
} && $vmlist->{ids
}->{$vmid}) {
802 $version = $vmlist->{ids
}->{$vmid}->{version
};
804 $infotag = "/$type/";
806 $infotag = $filename;
807 $version = $versions->{$filename};
810 my $info = $file_info->{$infotag} ||
811 die "unknown file type '$filename'\n";
813 return wantarray ?
($version, $info) : $version;
819 my ($version, $info) = cfs_file_version
($filename);
820 my $parser = $info->{parser
};
822 return &$ccache_read($filename, $parser, $version);
826 my ($filename, $data) = @_;
828 my ($version, $info) = cfs_file_version
($filename);
830 my $writer = $info->{writer
} || die "no writer defined";
832 my $fsname = "/etc/pve/$filename";
834 my $raw = &$writer($fsname, $data);
836 if (my $ci = $ccache->{$filename}) {
837 $ci->{version
} = undef;
840 PVE
::Tools
::file_set_contents
($fsname, $raw);
844 my ($lockid, $timeout, $code, @param) = @_;
848 # this timeout is for aquire the lock
849 $timeout = 10 if !$timeout;
851 my $filename = "$lockdir/$lockid";
853 my $msg = "can't aquire cfs lock '$lockid'";
860 die "$msg: pve cluster filesystem not online.\n";
863 local $SIG{ALRM
} = sub { die "got lock request timeout\n"; };
867 if (!(mkdir $filename)) {
868 print STDERR
"trying to aquire cfs lock '$lockid' ...";
870 if (!(mkdir $filename)) {
871 (utime 0, 0, $filename); # cfs unlock request
873 print STDERR
" OK\n";
880 # fixed command timeout: cfs locks have a timeout of 120
881 # using 60 gives us another 60 seconds to abort the task
883 local $SIG{ALRM
} = sub { die "got lock timeout - aborting command\n"; };
885 cfs_update
(); # make sure we read latest versions inside code()
887 $res = &$code(@param);
896 if ($err && ($err eq "got lock request timeout\n") &&
897 !check_cfs_quorum
()){
898 $err = "$msg: no quorum!\n";
901 if (!$err || $err !~ /^got lock timeout -/) {
902 rmdir $filename; # cfs unlock
916 my ($filename, $timeout, $code, @param) = @_;
918 my $info = $observed->{$filename} || die "unknown file '$filename'";
920 my $lockid = "file-$filename";
921 $lockid =~ s/[.\/]/_
/g
;
923 &$cfs_lock($lockid, $timeout, $code, @param);
926 sub cfs_lock_storage
{
927 my ($storeid, $timeout, $code, @param) = @_;
929 my $lockid = "storage-$storeid";
931 &$cfs_lock($lockid, $timeout, $code, @param);
934 sub cfs_lock_domain
{
935 my ($domainname, $timeout, $code, @param) = @_;
937 my $lockid = "domain-$domainname";
939 &$cfs_lock($lockid, $timeout, $code, @param);
957 my ($priority, $ident, $msg) = @_;
959 if (my $tmp = $log_levels->{$priority}) {
963 die "need numeric log priority" if $priority !~ /^\d+$/;
965 my $tag = PVE
::SafeSyslog
::tag
();
967 $msg = "empty message" if !$msg;
969 $ident = "" if !$ident;
970 $ident = encode
("ascii", $ident,
971 sub { sprintf "\\u%04x", shift });
973 my $ascii = encode
("ascii", $msg, sub { sprintf "\\u%04x", shift });
976 syslog
($priority, "<%s> %s", $ident, $ascii);
978 syslog
($priority, "%s", $ascii);
981 eval { &$ipcc_log($priority, $ident, $tag, $ascii); };
983 syslog
("err", "writing cluster log failed: $@") if $@;
986 sub check_vmid_unused
{
987 my ($vmid, $noerr) = @_;
989 my $vmlist = get_vmlist
();
991 my $d = $vmlist->{ids
}->{$vmid};
992 return 1 if !defined($d);
994 return undef if $noerr;
996 my $vmtypestr = $d->{type
} eq 'qemu' ?
'VM' : 'CT';
997 die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
1000 sub check_node_exists
{
1001 my ($nodename, $noerr) = @_;
1003 my $nodelist = $clinfo->{nodelist
};
1004 return 1 if $nodelist && $nodelist->{$nodename};
1006 return undef if $noerr;
1008 die "no such cluster node '$nodename'\n";
1011 # this is also used to get the IP of the local node
1012 sub remote_node_ip
{
1013 my ($nodename, $noerr) = @_;
1015 my $nodelist = $clinfo->{nodelist
};
1016 if ($nodelist && $nodelist->{$nodename}) {
1017 if (my $ip = $nodelist->{$nodename}->{ip
}) {
1018 return $ip if !wantarray;
1019 my $family = $nodelist->{$nodename}->{address_family
};
1021 $nodelist->{$nodename}->{address_family
} =
1023 PVE
::Tools
::get_host_address_family
($ip);
1025 return wantarray ?
($ip, $family) : $ip;
1029 # fallback: try to get IP by other means
1030 return PVE
::Network
::get_ip_from_hostname
($nodename, $noerr);
1033 sub get_local_migration_ip
{
1034 my ($migration_network, $noerr) = @_;
1036 my $cidr = $migration_network;
1038 if (!defined($cidr)) {
1039 my $dc_conf = cfs_read_file
('datacenter.cfg');
1040 $cidr = $dc_conf->{migration
}->{network
}
1041 if defined($dc_conf->{migration
}->{network
});
1044 if (defined($cidr)) {
1045 my $ips = PVE
::Network
::get_local_ip_from_cidr
($cidr);
1047 die "could not get migration ip: no IP address configured on local " .
1048 "node for network '$cidr'\n" if !$noerr && (scalar(@$ips) == 0);
1050 die "could not get migration ip: multiple IP address configured for " .
1051 "network '$cidr'\n" if !$noerr && (scalar(@$ips) > 1);
1059 # ssh related utility functions
1061 sub ssh_merge_keys
{
1062 # remove duplicate keys in $sshauthkeys
1063 # ssh-copy-id simply add keys, so the file can grow to large
1066 if (-f
$sshauthkeys) {
1067 $data = PVE
::Tools
::file_get_contents
($sshauthkeys, 128*1024);
1072 if (-f
$rootsshauthkeysbackup) {
1074 $data .= PVE
::Tools
::file_get_contents
($rootsshauthkeysbackup, 128*1024);
1079 # always add ourself
1080 if (-f
$ssh_rsa_id) {
1081 my $pub = PVE
::Tools
::file_get_contents
($ssh_rsa_id);
1083 $data .= "\n$pub\n";
1088 my @lines = split(/\n/, $data);
1089 foreach my $line (@lines) {
1090 if ($line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/) {
1091 next if $vhash->{$3}++;
1093 $newdata .= "$line\n";
1096 PVE
::Tools
::file_set_contents
($sshauthkeys, $newdata, 0600);
1098 if ($found_backup && -l
$rootsshauthkeys) {
1099 # everything went well, so we can remove the backup
1100 unlink $rootsshauthkeysbackup;
1104 sub setup_sshd_config
{
1105 my ($start_sshd) = @_;
1107 my $conf = PVE
::Tools
::file_get_contents
($sshd_config_fn);
1109 return if $conf =~ m/^PermitRootLogin\s+yes\s*$/m;
1111 if ($conf !~ s/^#?PermitRootLogin.*$/PermitRootLogin yes/m) {
1113 $conf .= "\nPermitRootLogin yes\n";
1116 PVE
::Tools
::file_set_contents
($sshd_config_fn, $conf);
1118 my $cmd = $start_sshd ?
'reload-or-restart' : 'reload-or-try-restart';
1119 PVE
::Tools
::run_command
(['systemctl', $cmd, 'sshd']);
1122 sub setup_rootsshconfig
{
1124 # create ssh key if it does not exist
1125 if (! -f
$ssh_rsa_id) {
1126 mkdir '/root/.ssh/';
1127 system ("echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}");
1130 # create ssh config if it does not exist
1131 if (! -f
$rootsshconfig) {
1133 if (my $fh = IO
::File-
>new($rootsshconfig, O_CREAT
|O_WRONLY
|O_EXCL
, 0640)) {
1134 # this is the default ciphers list from debian openssl0.9.8 except blowfish is added as prefered
1135 print $fh "Ciphers blowfish-cbc,aes128-ctr,aes192-ctr,aes256-ctr,arcfour256,arcfour128,aes128-cbc,3des-cbc\n";
1141 sub setup_ssh_keys
{
1147 if (! -f
$sshauthkeys) {
1149 if (-f
$rootsshauthkeys) {
1150 $old = PVE
::Tools
::file_get_contents
($rootsshauthkeys, 128*1024);
1152 if (my $fh = IO
::File-
>new ($sshauthkeys, O_CREAT
|O_WRONLY
|O_EXCL
, 0400)) {
1153 PVE
::Tools
::safe_print
($sshauthkeys, $fh, $old) if $old;
1159 warn "can't create shared ssh key database '$sshauthkeys'\n"
1160 if ! -f
$sshauthkeys;
1162 if (-f
$rootsshauthkeys && ! -l
$rootsshauthkeys) {
1163 if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
1164 warn "rename $rootsshauthkeys failed - $!\n";
1168 if (! -l
$rootsshauthkeys) {
1169 symlink $sshauthkeys, $rootsshauthkeys;
1172 if (! -l
$rootsshauthkeys) {
1173 warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
1175 unlink $rootsshauthkeysbackup if $import_ok;
1179 sub ssh_unmerge_known_hosts
{
1180 return if ! -l
$sshglobalknownhosts;
1183 $old = PVE
::Tools
::file_get_contents
($sshknownhosts, 128*1024)
1184 if -f
$sshknownhosts;
1186 PVE
::Tools
::file_set_contents
($sshglobalknownhosts, $old);
1189 sub ssh_merge_known_hosts
{
1190 my ($nodename, $ip_address, $createLink) = @_;
1192 die "no node name specified" if !$nodename;
1193 die "no ip address specified" if !$ip_address;
1197 if (! -f
$sshknownhosts) {
1198 if (my $fh = IO
::File-
>new($sshknownhosts, O_CREAT
|O_WRONLY
|O_EXCL
, 0600)) {
1203 my $old = PVE
::Tools
::file_get_contents
($sshknownhosts, 128*1024);
1207 if ((! -l
$sshglobalknownhosts) && (-f
$sshglobalknownhosts)) {
1208 $new = PVE
::Tools
::file_get_contents
($sshglobalknownhosts, 128*1024);
1211 my $hostkey = PVE
::Tools
::file_get_contents
($ssh_host_rsa_id);
1212 # Note: file sometimes containe emty lines at start, so we use multiline match
1213 die "can't parse $ssh_host_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/m;
1222 my $merge_line = sub {
1223 my ($line, $all) = @_;
1225 if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
1228 if (!$vhash->{$key}) {
1230 if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
1231 my $salt = decode_base64
($1);
1233 my $hmac = Digest
::HMAC_SHA1-
>new($salt);
1234 $hmac->add($nodename);
1235 my $hd = $hmac->b64digest . '=';
1236 if ($digest eq $hd) {
1237 if ($rsakey eq $hostkey) {
1238 $found_nodename = 1;
1243 $hmac = Digest
::HMAC_SHA1-
>new($salt);
1244 $hmac->add($ip_address);
1245 $hd = $hmac->b64digest . '=';
1246 if ($digest eq $hd) {
1247 if ($rsakey eq $hostkey) {
1248 $found_local_ip = 1;
1261 while ($old && $old =~ s/^((.*?)(\n|$))//) {
1263 next if $line =~ m/^\s*$/; # skip empty lines
1264 next if $line =~ m/^#/; # skip comments
1265 &$merge_line($line, 1);
1268 while ($new && $new =~ s/^((.*?)(\n|$))//) {
1270 next if $line =~ m/^\s*$/; # skip empty lines
1271 next if $line =~ m/^#/; # skip comments
1272 &$merge_line($line);
1276 my $add_known_hosts_entry = sub {
1277 my ($name, $hostkey) = @_;
1279 my $hmac = Digest
::HMAC_SHA1-
>new("$addIndex" . time());
1280 my $b64salt = $hmac->b64digest . '=';
1281 $hmac = Digest
::HMAC_SHA1-
>new(decode_base64
($b64salt));
1283 my $digest = $hmac->b64digest . '=';
1284 $data .= "|1|$b64salt|$digest $hostkey\n";
1287 if (!$found_nodename || !$found_local_ip) {
1288 &$add_known_hosts_entry($nodename, $hostkey) if !$found_nodename;
1289 &$add_known_hosts_entry($ip_address, $hostkey) if !$found_local_ip;
1292 PVE
::Tools
::file_set_contents
($sshknownhosts, $data);
1294 return if !$createLink;
1296 unlink $sshglobalknownhosts;
1297 symlink $sshknownhosts, $sshglobalknownhosts;
1299 warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
1300 if ! -l
$sshglobalknownhosts;
1304 my $migration_format = {
1308 enum
=> ['secure', 'insecure'],
1309 description
=> "Migration traffic is encrypted using an SSH tunnel by " .
1310 "default. On secure, completely private networks this can be " .
1311 "disabled to increase performance.",
1312 default => 'secure',
1316 type
=> 'string', format
=> 'CIDR',
1317 format_description
=> 'CIDR',
1318 description
=> "CIDR of the (sub) network that is used for migration."
1322 my $datacenter_schema = {
1324 additionalProperties
=> 0,
1329 description
=> "Default keybord layout for vnc server.",
1330 enum
=> PVE
::Tools
::kvmkeymaplist
(),
1335 description
=> "Default GUI language.",
1336 enum
=> [ 'en', 'de' ],
1341 description
=> "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1342 pattern
=> "http://.*",
1344 migration_unsecure
=> {
1347 description
=> "Migration is secure using SSH tunnel by default. " .
1348 "For secure private networks you can disable it to speed up " .
1349 "migration. Deprecated, use the 'migration' property instead!",
1353 type
=> 'string', format
=> $migration_format,
1354 description
=> "For cluster wide migration settings.",
1356 storage_replication_network
=> {
1358 type
=> 'string', format
=> 'CIDR',
1359 description
=> "For cluster wide storage replication network.",
1364 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).",
1365 enum
=> ['applet', 'vv', 'html5'],
1370 format
=> 'email-opt',
1371 description
=> "Specify email address to send notification from (default is root@\$hostname)",
1377 description
=> "Defines how many workers (per node) are maximal started ".
1378 " on actions like 'stopall VMs' or task from the ha-manager.",
1383 default => 'watchdog',
1384 enum
=> [ 'watchdog', 'hardware', 'both' ],
1385 description
=> "Set the fencing mode of the HA cluster. Hardware mode " .
1386 "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
1387 " With both all two modes are used." .
1388 "\n\nWARNING: 'hardware' and 'both' are EXPERIMENTAL & WIP",
1393 pattern
=> qr/[a-f0-9]{2}(?::[a-f0-9]{2}){0,2}:?/i,
1394 description
=> 'Prefix for autogenerated MAC addresses.',
1399 # make schema accessible from outside (for documentation)
1400 sub get_datacenter_schema
{ return $datacenter_schema };
1402 sub parse_datacenter_config
{
1403 my ($filename, $raw) = @_;
1405 my $res = PVE
::JSONSchema
::parse_config
($datacenter_schema, $filename, $raw // '');
1407 if (my $migration = $res->{migration
}) {
1408 $res->{migration
} = PVE
::JSONSchema
::parse_property_string
($migration_format, $migration);
1411 # for backwards compatibility only, new migration property has precedence
1412 if (defined($res->{migration_unsecure
})) {
1413 if (defined($res->{migration
}->{type
})) {
1414 warn "deprecated setting 'migration_unsecure' and new 'migration: type' " .
1415 "set at same time! Ignore 'migration_unsecure'\n";
1417 $res->{migration
}->{type
} = ($res->{migration_unsecure
}) ?
'insecure' : 'secure';
1424 sub write_datacenter_config
{
1425 my ($filename, $cfg) = @_;
1427 # map deprecated setting to new one
1428 if (defined($cfg->{migration_unsecure
}) && !defined($cfg->{migration
})) {
1429 my $migration_unsecure = delete $cfg->{migration_unsecure
};
1430 $cfg->{migration
}->{type
} = ($migration_unsecure) ?
'insecure' : 'secure';
1433 return PVE
::JSONSchema
::dump_config
($datacenter_schema, $filename, $cfg);
1436 cfs_register_file
('datacenter.cfg',
1437 \
&parse_datacenter_config
,
1438 \
&write_datacenter_config
);
1440 # a very simply parser ...
1441 sub parse_corosync_conf
{
1442 my ($filename, $raw) = @_;
1446 my $digest = Digest
::SHA
::sha1_hex
(defined($raw) ?
$raw : '');
1449 $raw =~ s/\r?\n/ /g;
1454 my @tokens = split(/\s/, $raw);
1456 my $conf = { section
=> 'main', children
=> [] };
1459 my $section = $conf;
1461 while (defined(my $token = shift @tokens)) {
1462 my $nexttok = $tokens[0];
1464 if ($nexttok && ($nexttok eq '{')) {
1465 shift @tokens; # skip '{'
1470 push @{$section->{children
}}, $new_section;
1471 push @$stack, $section;
1472 $section = $new_section;
1476 if ($token eq '}') {
1477 $section = pop @$stack;
1478 die "parse error - uncexpected '}'\n" if !$section;
1483 die "missing ':' after key '$key'\n" if ! ($key =~ s/:$//);
1485 die "parse error - no value for '$key'\n" if !defined($nexttok);
1486 my $value = shift @tokens;
1488 push @{$section->{children
}}, { key
=> $key, value
=> $value };
1491 $conf->{digest
} = $digest;
1496 my $dump_corosync_section;
1497 $dump_corosync_section = sub {
1498 my ($section, $prefix) = @_;
1500 my $raw = $prefix . $section->{section
} . " {\n";
1502 my @list = grep { defined($_->{key
}) } @{$section->{children
}};
1503 foreach my $child (sort {$a->{key
} cmp $b->{key
}} @list) {
1504 $raw .= $prefix . " $child->{key}: $child->{value}\n";
1507 @list = grep { defined($_->{section
}) } @{$section->{children
}};
1508 foreach my $child (sort {$a->{section
} cmp $b->{section
}} @list) {
1509 $raw .= &$dump_corosync_section($child, "$prefix ");
1512 $raw .= $prefix . "}\n\n";
1518 sub write_corosync_conf
{
1519 my ($filename, $conf) = @_;
1525 die "no main section" if $conf->{section
} ne 'main';
1527 my @list = grep { defined($_->{key
}) } @{$conf->{children
}};
1528 foreach my $child (sort {$a->{key
} cmp $b->{key
}} @list) {
1529 $raw .= "$child->{key}: $child->{value}\n";
1532 @list = grep { defined($_->{section
}) } @{$conf->{children
}};
1533 foreach my $child (sort {$a->{section
} cmp $b->{section
}} @list) {
1534 $raw .= &$dump_corosync_section($child, $prefix);
1540 sub corosync_conf_version
{
1541 my ($conf, $noerr, $new_value) = @_;
1543 foreach my $child (@{$conf->{children
}}) {
1544 next if !defined($child->{section
});
1545 if ($child->{section
} eq 'totem') {
1546 foreach my $e (@{$child->{children
}}) {
1547 next if !defined($e->{key
});
1548 if ($e->{key
} eq 'config_version') {
1550 $e->{value
} = $new_value;
1552 } elsif (my $version = int($e->{value
})) {
1561 return undef if $noerr;
1563 die "invalid corosync config - unable to read version\n";
1566 # read only - use "rename corosync.conf.new corosync.conf" to write
1567 PVE
::Cluster
::cfs_register_file
('corosync.conf', \
&parse_corosync_conf
);
1568 # this is read/write
1569 PVE
::Cluster
::cfs_register_file
('corosync.conf.new', \
&parse_corosync_conf
,
1570 \
&write_corosync_conf
);
1572 sub check_corosync_conf_exists
{
1575 $silent = $silent // 0;
1577 my $exists = -f
"$basedir/corosync.conf";
1579 warn "Corosync config '$basedir/corosync.conf' does not exist - is this node part of a cluster?\n"
1580 if !$silent && !$exists;
1585 sub corosync_update_nodelist
{
1586 my ($conf, $nodelist) = @_;
1588 delete $conf->{digest
};
1590 my $version = corosync_conf_version
($conf);
1591 corosync_conf_version
($conf, undef, $version + 1);
1594 foreach my $v (values %$nodelist) {
1595 next if !($v->{ring0_addr
} || $v->{name
});
1597 foreach my $k (keys %$v) {
1598 push @$kv, { key
=> $k, value
=> $v->{$k} };
1600 my $ns = { section
=> 'node', children
=> $kv };
1601 push @$children, $ns;
1604 foreach my $main (@{$conf->{children
}}) {
1605 next if !defined($main->{section
});
1606 if ($main->{section
} eq 'nodelist') {
1607 $main->{children
} = $children;
1613 cfs_write_file
("corosync.conf.new", $conf);
1615 rename("/etc/pve/corosync.conf.new", "/etc/pve/corosync.conf")
1616 || die "activate corosync.conf.new failed - $!\n";
1619 sub corosync_nodelist
{
1624 foreach my $main (@{$conf->{children
}}) {
1625 next if !defined($main->{section
});
1626 if ($main->{section
} eq 'nodelist') {
1627 foreach my $ne (@{$main->{children
}}) {
1628 next if !defined($ne->{section
}) || ($ne->{section
} ne 'node');
1629 my $node = { quorum_votes
=> 1 };
1631 foreach my $child (@{$ne->{children
}}) {
1632 next if !defined($child->{key
});
1633 $node->{$child->{key
}} = $child->{value
};
1634 # use 'name' over 'ring0_addr' if set
1635 if ($child->{key
} eq 'name') {
1636 delete $nodelist->{$name} if $name;
1637 $name = $child->{value
};
1638 $nodelist->{$name} = $node;
1639 } elsif(!$name && $child->{key
} eq 'ring0_addr') {
1640 $name = $child->{value
};
1641 $nodelist->{$name} = $node;
1651 # get a hash representation of the corosync config totem section
1652 sub corosync_totem_config
{
1657 foreach my $main (@{$conf->{children
}}) {
1658 next if !defined($main->{section
}) ||
1659 $main->{section
} ne 'totem';
1661 foreach my $e (@{$main->{children
}}) {
1663 if ($e->{section
} && $e->{section
} eq 'interface') {
1666 $res->{interface
} = {};
1668 foreach my $child (@{$e->{children
}}) {
1669 next if !defined($child->{key
});
1670 $entry->{$child->{key
}} = $child->{value
};
1671 if($child->{key
} eq 'ringnumber') {
1672 $res->{interface
}->{$child->{value
}} = $entry;
1676 } elsif ($e->{key
}) {
1677 $res->{$e->{key
}} = $e->{value
};
1685 # X509 Certificate cache helper
1687 my $cert_cache_nodes = {};
1688 my $cert_cache_timestamp = time();
1689 my $cert_cache_fingerprints = {};
1691 sub update_cert_cache
{
1692 my ($update_node, $clear) = @_;
1694 syslog
('info', "Clearing outdated entries from certificate cache")
1697 $cert_cache_timestamp = time() if !defined($update_node);
1699 my $node_list = defined($update_node) ?
1700 [ $update_node ] : [ keys %$cert_cache_nodes ];
1702 foreach my $node (@$node_list) {
1703 my $clear_old = sub {
1704 if (my $old_fp = $cert_cache_nodes->{$node}) {
1705 # distrust old fingerprint
1706 delete $cert_cache_fingerprints->{$old_fp};
1707 # ensure reload on next proxied request
1708 delete $cert_cache_nodes->{$node};
1712 my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
1713 my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
1715 $cert_path = $custom_cert_path if -f
$custom_cert_path;
1719 my $bio = Net
::SSLeay
::BIO_new_file
($cert_path, 'r');
1720 $cert = Net
::SSLeay
::PEM_read_bio_X509
($bio);
1721 Net
::SSLeay
::BIO_free
($bio);
1724 if ($err || !defined($cert)) {
1725 &$clear_old() if $clear;
1731 $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
1734 if ($err || !defined($fp) || $fp eq '') {
1735 &$clear_old() if $clear;
1739 my $old_fp = $cert_cache_nodes->{$node};
1740 $cert_cache_fingerprints->{$fp} = 1;
1741 $cert_cache_nodes->{$node} = $fp;
1743 if (defined($old_fp) && $fp ne $old_fp) {
1744 delete $cert_cache_fingerprints->{$old_fp};
1749 # load and cache cert fingerprint once
1750 sub initialize_cert_cache
{
1753 update_cert_cache
($node)
1754 if defined($node) && !defined($cert_cache_nodes->{$node});
1757 sub check_cert_fingerprint
{
1760 # clear cache every 30 minutes at least
1761 update_cert_cache
(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
1763 # get fingerprint of server certificate
1766 $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
1768 return 0 if $@ || !defined($fp) || $fp eq ''; # error
1771 for my $expected (keys %$cert_cache_fingerprints) {
1772 return 1 if $fp eq $expected;
1777 return 1 if &$check();
1779 # clear cache and retry at most once every minute
1780 if (time() - $cert_cache_timestamp >= 60) {
1781 syslog
('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
1782 update_cert_cache
();
1789 # bash completion helpers
1791 sub complete_next_vmid
{
1793 my $vmlist = get_vmlist
() || {};
1794 my $idlist = $vmlist->{ids
} || {};
1796 for (my $i = 100; $i < 10000; $i++) {
1797 return [$i] if !defined($idlist->{$i});
1805 my $vmlist = get_vmlist
();
1806 my $ids = $vmlist->{ids
} || {};
1808 return [ keys %$ids ];
1811 sub complete_local_vmid
{
1813 my $vmlist = get_vmlist
();
1814 my $ids = $vmlist->{ids
} || {};
1816 my $nodename = PVE
::INotify
::nodename
();
1819 foreach my $vmid (keys %$ids) {
1820 my $d = $ids->{$vmid};
1821 next if !$d->{node
} || $d->{node
} ne $nodename;
1828 sub complete_migration_target
{
1832 my $nodename = PVE
::INotify
::nodename
();
1834 my $nodelist = get_nodelist
();
1835 foreach my $node (@$nodelist) {
1836 next if $node eq $nodename;