8 use Storable
qw(dclone);
13 use Digest
::HMAC_SHA1
;
30 use Data
::Dumper
; # fixme: remove
32 # x509 certificate utils
34 my $basedir = "/etc/pve";
35 my $authdir = "$basedir/priv";
36 my $lockdir = "/etc/pve/priv/lock";
38 my $authprivkeyfn = "$authdir/authkey.key";
39 my $authpubkeyfn = "$basedir/authkey.pub";
40 my $pveca_key_fn = "$authdir/pve-root-ca.key";
41 my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
42 my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
43 # this is just a secret accessable by the web browser
44 # and is used for CSRF prevention
45 my $pvewww_key_fn = "$basedir/pve-www.key";
48 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
49 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
50 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
51 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
52 my $sshknownhosts = "/etc/pve/priv/known_hosts";
53 my $sshauthkeys = "/etc/pve/priv/authorized_keys";
54 my $sshd_config_fn = "/etc/ssh/sshd_config";
55 my $rootsshauthkeys = "/root/.ssh/authorized_keys";
56 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
57 my $rootsshconfig = "/root/.ssh/config";
62 'datacenter.cfg' => 1,
64 'corosync.conf.new' => 1,
67 'priv/shadow.cfg' => 1,
71 'ha/crm_commands' => 1,
72 'ha/manager_status' => 1,
73 'ha/resources.cfg' => 1,
79 # only write output if something fails
85 my $record_output = sub {
91 PVE
::Tools
::run_command
($cmd, outfunc
=> $record_output,
92 errfunc
=> $record_output);
103 sub check_cfs_quorum
{
106 # note: -w filename always return 1 for root, so wee need
107 # to use File::lstat here
108 my $st = File
::stat::lstat("$basedir/local");
109 my $quorate = ($st && (($st->mode & 0200) != 0));
111 die "cluster not ready - no quorum?\n" if !$quorate && !$noerr;
116 sub check_cfs_is_mounted
{
119 my $res = -l
"$basedir/local";
121 die "pve configuration filesystem not mounted\n"
130 check_cfs_is_mounted
();
132 my @required_dirs = (
135 "$basedir/nodes/$nodename",
136 "$basedir/nodes/$nodename/lxc",
137 "$basedir/nodes/$nodename/qemu-server",
138 "$basedir/nodes/$nodename/openvz",
139 "$basedir/nodes/$nodename/priv");
141 foreach my $dir (@required_dirs) {
143 mkdir($dir) || $! == EEXIST
|| die "unable to create directory '$dir' - $!\n";
150 return if -f
"$authprivkeyfn";
152 check_cfs_is_mounted
();
154 mkdir $authdir || $! == EEXIST
|| die "unable to create dir '$authdir' - $!\n";
156 my $cmd = "openssl genrsa -out '$authprivkeyfn' 2048";
157 run_silent_cmd
($cmd);
159 $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, ..)
184 my $nid = (split (/\s/, `md5sum '$pveca_key_fn'`))[0] || time();
187 run_silent_cmd
(['openssl', 'req', '-batch', '-days', '3650', '-new',
188 '-x509', '-nodes', '-key',
189 $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
190 "/CN=Proxmox Virtual Environment/OU=$nid/O=PVE Cluster Manager CA/"]);
193 die "generating pve root certificate failed:\n$@" if $@;
198 sub gen_pve_ssl_key
{
201 die "no node name specified" if !$nodename;
203 my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
205 return if -f
$pvessl_key_fn;
208 run_silent_cmd
(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
211 die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
214 sub gen_pve_www_key
{
216 return if -f
$pvewww_key_fn;
219 run_silent_cmd
(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
222 die "unable to generate pve www key:\n$@" if $@;
228 PVE
::Tools
::file_set_contents
($pveca_srl_fn, $serial);
231 sub gen_pve_ssl_cert
{
232 my ($force, $nodename, $ip) = @_;
234 die "no node name specified" if !$nodename;
235 die "no IP specified" if !$ip;
237 my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
239 return if !$force && -f
$pvessl_cert_fn;
241 my $names = "IP:127.0.0.1,IP:::1,DNS:localhost";
243 my $rc = PVE
::INotify
::read_file
('resolvconf');
247 my $fqdn = $nodename;
249 $names .= ",DNS:$nodename";
251 if ($rc && $rc->{search
}) {
252 $fqdn = $nodename . "." . $rc->{search
};
253 $names .= ",DNS:$fqdn";
256 my $sslconf = <<__EOD;
257 RANDFILE = /root/.rnd
262 distinguished_name = req_distinguished_name
263 req_extensions = v3_req
265 string_mask = nombstr
267 [ req_distinguished_name ]
268 organizationalUnitName = PVE Cluster Node
269 organizationName = Proxmox Virtual Environment
273 basicConstraints = CA:FALSE
274 extendedKeyUsage = serverAuth
275 subjectAltName = $names
278 my $cfgfn = "/tmp/pvesslconf-$$.tmp";
279 my $fh = IO
::File-
>new ($cfgfn, "w");
283 my $reqfn = "/tmp/pvecertreq-$$.tmp";
286 my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
288 run_silent_cmd
(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
289 '-key', $pvessl_key_fn, '-out', $reqfn]);
295 die "unable to generate pve certificate request:\n$err";
298 update_serial
("0000000000000000") if ! -f
$pveca_srl_fn;
301 run_silent_cmd
(['openssl', 'x509', '-req', '-in', $reqfn, '-days', '3650',
302 '-out', $pvessl_cert_fn, '-CAkey', $pveca_key_fn,
303 '-CA', $pveca_cert_fn, '-CAserial', $pveca_srl_fn,
304 '-extfile', $cfgfn]);
310 die "unable to generate pve ssl certificate:\n$err";
317 sub gen_pve_node_files
{
318 my ($nodename, $ip, $opt_force) = @_;
320 gen_local_dirs
($nodename);
324 # make sure we have a (cluster wide) secret
325 # for CSRFR prevention
328 # make sure we have a (per node) private key
329 gen_pve_ssl_key
($nodename);
331 # make sure we have a CA
332 my $force = gen_pveca_cert
();
334 $force = 1 if $opt_force;
336 gen_pve_ssl_cert
($force, $nodename, $ip);
339 my $vzdump_cron_dummy = <<__EOD;
340 # cluster wide vzdump cron schedule
341 # Atomatically generated file - do not edit
343 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
347 sub gen_pve_vzdump_symlink
{
349 my $filename = "/etc/pve/vzdump.cron";
351 my $link_fn = "/etc/cron.d/vzdump";
353 if ((-f
$filename) && (! -l
$link_fn)) {
354 rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
355 symlink($filename, $link_fn);
359 sub gen_pve_vzdump_files
{
361 my $filename = "/etc/pve/vzdump.cron";
363 PVE
::Tools
::file_set_contents
($filename, $vzdump_cron_dummy)
366 gen_pve_vzdump_symlink
();
373 my $ipcc_send_rec = sub {
374 my ($msgid, $data) = @_;
376 my $res = PVE
::IPCC
::ipcc_send_rec
($msgid, $data);
378 die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
383 my $ipcc_send_rec_json = sub {
384 my ($msgid, $data) = @_;
386 my $res = PVE
::IPCC
::ipcc_send_rec
($msgid, $data);
388 die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
390 return decode_json
($res);
393 my $ipcc_get_config = sub {
396 my $bindata = pack "Z*", $path;
397 my $res = PVE
::IPCC
::ipcc_send_rec
(6, $bindata);
398 if (!defined($res)) {
399 return undef if ($! != 0);
406 my $ipcc_get_status = sub {
407 my ($name, $nodename) = @_;
409 my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
410 return PVE
::IPCC
::ipcc_send_rec
(5, $bindata);
413 my $ipcc_update_status = sub {
414 my ($name, $data) = @_;
416 my $raw = ref($data) ? encode_json
($data) : $data;
418 my $bindata = pack "Z[256]Z*", $name, $raw;
420 return &$ipcc_send_rec(4, $bindata);
424 my ($priority, $ident, $tag, $msg) = @_;
426 my $bindata = pack "CCCZ*Z*Z*", $priority, bytes
::length($ident) + 1,
427 bytes
::length($tag) + 1, $ident, $tag, $msg;
429 return &$ipcc_send_rec(7, $bindata);
432 my $ipcc_get_cluster_log = sub {
433 my ($user, $max) = @_;
435 $max = 0 if !defined($max);
437 my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
438 return &$ipcc_send_rec(8, $bindata);
445 my $res = &$ipcc_send_rec_json(1);
446 #warn "GOT1: " . Dumper($res);
447 die "no starttime\n" if !$res->{starttime
};
449 if (!$res->{starttime
} || !$versions->{starttime
} ||
450 $res->{starttime
} != $versions->{starttime
}) {
451 #print "detected changed starttime\n";
469 if (!$clinfo->{version
} || $clinfo->{version
} != $versions->{clinfo
}) {
470 #warn "detected new clinfo\n";
471 $clinfo = &$ipcc_send_rec_json(2);
481 if (!$vmlist->{version
} || $vmlist->{version
} != $versions->{vmlist
}) {
482 #warn "detected new vmlist1\n";
483 $vmlist = &$ipcc_send_rec_json(3);
502 return $clinfo->{nodelist
};
507 my $nodelist = $clinfo->{nodelist
};
511 my $nodename = PVE
::INotify
::nodename
();
513 if (!$nodelist || !$nodelist->{$nodename}) {
514 return [ $nodename ];
517 return [ keys %$nodelist ];
520 sub broadcast_tasklist
{
524 &$ipcc_update_status("tasklist", $data);
530 my $tasklistcache = {};
535 my $kvstore = $versions->{kvstore
} || {};
537 my $nodelist = get_nodelist
();
540 foreach my $node (@$nodelist) {
541 next if $nodename && ($nodename ne $node);
543 my $ver = $kvstore->{$node}->{tasklist
} if $kvstore->{$node};
544 my $cd = $tasklistcache->{$node};
545 if (!$cd || !$ver || !$cd->{version
} ||
546 ($cd->{version
} != $ver)) {
547 my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
548 my $data = decode_json
($raw);
550 $cd = $tasklistcache->{$node} = {
554 } elsif ($cd && $cd->{data
}) {
555 push @$res, @{$cd->{data
}};
559 syslog
('err', $err) if $err;
566 my ($rrdid, $data) = @_;
569 &$ipcc_update_status("rrd/$rrdid", $data);
576 my $last_rrd_dump = 0;
577 my $last_rrd_data = "";
583 my $diff = $ctime - $last_rrd_dump;
585 return $last_rrd_data;
590 $raw = &$ipcc_send_rec(10);
602 while ($raw =~ s/^(.*)\n//) {
603 my ($key, @ela) = split(/:/, $1);
605 next if !(scalar(@ela) > 1);
606 $res->{$key} = \
@ela;
610 $last_rrd_dump = $ctime;
611 $last_rrd_data = $res;
616 sub create_rrd_data
{
617 my ($rrdname, $timeframe, $cf) = @_;
619 my $rrddir = "/var/lib/rrdcached/db";
621 my $rrd = "$rrddir/$rrdname";
625 day
=> [ 60*30, 70 ],
626 week
=> [ 60*180, 70 ],
627 month
=> [ 60*720, 70 ],
628 year
=> [ 60*10080, 70 ],
631 my ($reso, $count) = @{$setup->{$timeframe}};
632 my $ctime = $reso*int(time()/$reso);
633 my $req_start = $ctime - $reso*$count;
635 $cf = "AVERAGE" if !$cf;
643 my $socket = "/var/run/rrdcached.sock";
644 push @args, "--daemon" => "unix:$socket" if -S
$socket;
646 my ($start, $step, $names, $data) = RRDs
::fetch
($rrd, $cf, @args);
648 my $err = RRDs
::error
;
649 die "RRD error: $err\n" if $err;
651 die "got wrong time resolution ($step != $reso)\n"
655 my $fields = scalar(@$names);
656 for my $line (@$data) {
657 my $entry = { 'time' => $start };
660 for (my $i = 0; $i < $fields; $i++) {
661 my $name = $names->[$i];
662 if (defined(my $val = $line->[$i])) {
663 $entry->{$name} = $val;
665 # we only add entryies with all data defined
666 # extjs chart has problems with undefined values
670 push @$res, $entry if !$found_undefs;
676 sub create_rrd_graph
{
677 my ($rrdname, $timeframe, $ds, $cf) = @_;
679 # Using RRD graph is clumsy - maybe it
680 # is better to simply fetch the data, and do all display
681 # related things with javascript (new extjs html5 graph library).
683 my $rrddir = "/var/lib/rrdcached/db";
685 my $rrd = "$rrddir/$rrdname";
687 my @ids = PVE
::Tools
::split_list
($ds);
689 my $ds_txt = join('_', @ids);
691 my $filename = "${rrd}_${ds_txt}.png";
695 day
=> [ 60*30, 70 ],
696 week
=> [ 60*180, 70 ],
697 month
=> [ 60*720, 70 ],
698 year
=> [ 60*10080, 70 ],
701 my ($reso, $count) = @{$setup->{$timeframe}};
704 "--imgformat" => "PNG",
708 "--start" => - $reso*$count,
710 "--lower-limit" => 0,
713 my $socket = "/var/run/rrdcached.sock";
714 push @args, "--daemon" => "unix:$socket" if -S
$socket;
716 my @coldef = ('#00ddff', '#ff0000');
718 $cf = "AVERAGE" if !$cf;
721 foreach my $id (@ids) {
722 my $col = $coldef[$i++] || die "fixme: no color definition";
723 push @args, "DEF:${id}=$rrd:${id}:$cf";
725 if ($id eq 'cpu' || $id eq 'iowait') {
726 push @args, "CDEF:${id}_per=${id},100,*";
727 $dataid = "${id}_per";
729 push @args, "LINE2:${dataid}${col}:${id}";
732 push @args, '--full-size-mode';
734 # we do not really store data into the file
735 my $res = RRDs
::graphv
('', @args);
737 my $err = RRDs
::error
;
738 die "RRD error: $err\n" if $err;
740 return { filename
=> $filename, image
=> $res->{image
} };
743 # a fast way to read files (avoid fuse overhead)
747 return &$ipcc_get_config($path);
750 sub get_cluster_log
{
751 my ($user, $max) = @_;
753 return &$ipcc_get_cluster_log($user, $max);
758 sub cfs_register_file
{
759 my ($filename, $parser, $writer) = @_;
761 $observed->{$filename} || die "unknown file '$filename'";
763 die "file '$filename' already registered" if $file_info->{$filename};
765 $file_info->{$filename} = {
771 my $ccache_read = sub {
772 my ($filename, $parser, $version) = @_;
774 $ccache->{$filename} = {} if !$ccache->{$filename};
776 my $ci = $ccache->{$filename};
778 if (!$ci->{version
} || !$version || $ci->{version
} != $version) {
779 # we always call the parser, even when the file does not exists
780 # (in that case $data is undef)
781 my $data = get_config
($filename);
782 $ci->{data
} = &$parser("/etc/pve/$filename", $data);
783 $ci->{version
} = $version;
786 my $res = ref($ci->{data
}) ? dclone
($ci->{data
}) : $ci->{data
};
791 sub cfs_file_version
{
796 if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) {
797 my ($type, $vmid) = ($1, $2);
798 if ($vmlist && $vmlist->{ids
} && $vmlist->{ids
}->{$vmid}) {
799 $version = $vmlist->{ids
}->{$vmid}->{version
};
801 $infotag = "/$type/";
803 $infotag = $filename;
804 $version = $versions->{$filename};
807 my $info = $file_info->{$infotag} ||
808 die "unknown file type '$filename'\n";
810 return wantarray ?
($version, $info) : $version;
816 my ($version, $info) = cfs_file_version
($filename);
817 my $parser = $info->{parser
};
819 return &$ccache_read($filename, $parser, $version);
823 my ($filename, $data) = @_;
825 my ($version, $info) = cfs_file_version
($filename);
827 my $writer = $info->{writer
} || die "no writer defined";
829 my $fsname = "/etc/pve/$filename";
831 my $raw = &$writer($fsname, $data);
833 if (my $ci = $ccache->{$filename}) {
834 $ci->{version
} = undef;
837 PVE
::Tools
::file_set_contents
($fsname, $raw);
841 my ($lockid, $timeout, $code, @param) = @_;
845 # this timeout is for aquire the lock
846 $timeout = 10 if !$timeout;
848 my $filename = "$lockdir/$lockid";
850 my $msg = "can't aquire cfs lock '$lockid'";
857 die "$msg: pve cluster filesystem not online.\n";
860 local $SIG{ALRM
} = sub { die "got lock request timeout\n"; };
864 if (!(mkdir $filename)) {
865 print STDERR
"trying to aquire cfs lock '$lockid' ...";
867 if (!(mkdir $filename)) {
868 (utime 0, 0, $filename); # cfs unlock request
870 print STDERR
" OK\n";
877 # fixed command timeout: cfs locks have a timeout of 120
878 # using 60 gives us another 60 seconds to abort the task
880 local $SIG{ALRM
} = sub { die "got lock timeout - aborting command\n"; };
882 cfs_update
(); # make sure we read latest versions inside code()
884 $res = &$code(@param);
893 if ($err && ($err eq "got lock request timeout\n") &&
894 !check_cfs_quorum
()){
895 $err = "$msg: no quorum!\n";
898 if (!$err || $err !~ /^got lock timeout -/) {
899 rmdir $filename; # cfs unlock
913 my ($filename, $timeout, $code, @param) = @_;
915 my $info = $observed->{$filename} || die "unknown file '$filename'";
917 my $lockid = "file-$filename";
918 $lockid =~ s/[.\/]/_
/g
;
920 &$cfs_lock($lockid, $timeout, $code, @param);
923 sub cfs_lock_storage
{
924 my ($storeid, $timeout, $code, @param) = @_;
926 my $lockid = "storage-$storeid";
928 &$cfs_lock($lockid, $timeout, $code, @param);
931 sub cfs_lock_domain
{
932 my ($domainname, $timeout, $code, @param) = @_;
934 my $lockid = "domain-$domainname";
936 &$cfs_lock($lockid, $timeout, $code, @param);
954 my ($priority, $ident, $msg) = @_;
956 if (my $tmp = $log_levels->{$priority}) {
960 die "need numeric log priority" if $priority !~ /^\d+$/;
962 my $tag = PVE
::SafeSyslog
::tag
();
964 $msg = "empty message" if !$msg;
966 $ident = "" if !$ident;
967 $ident = encode
("ascii", $ident,
968 sub { sprintf "\\u%04x", shift });
970 my $ascii = encode
("ascii", $msg, sub { sprintf "\\u%04x", shift });
973 syslog
($priority, "<%s> %s", $ident, $ascii);
975 syslog
($priority, "%s", $ascii);
978 eval { &$ipcc_log($priority, $ident, $tag, $ascii); };
980 syslog
("err", "writing cluster log failed: $@") if $@;
983 sub check_vmid_unused
{
984 my ($vmid, $noerr) = @_;
986 my $vmlist = get_vmlist
();
988 my $d = $vmlist->{ids
}->{$vmid};
989 return 1 if !defined($d);
991 return undef if $noerr;
993 my $vmtypestr = $d->{type
} eq 'qemu' ?
'VM' : 'CT';
994 die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
997 sub check_node_exists
{
998 my ($nodename, $noerr) = @_;
1000 my $nodelist = $clinfo->{nodelist
};
1001 return 1 if $nodelist && $nodelist->{$nodename};
1003 return undef if $noerr;
1005 die "no such cluster node '$nodename'\n";
1008 # this is also used to get the IP of the local node
1009 sub remote_node_ip
{
1010 my ($nodename, $noerr) = @_;
1012 my $nodelist = $clinfo->{nodelist
};
1013 if ($nodelist && $nodelist->{$nodename}) {
1014 if (my $ip = $nodelist->{$nodename}->{ip
}) {
1015 return $ip if !wantarray;
1016 my $family = $nodelist->{$nodename}->{address_family
};
1018 $nodelist->{$nodename}->{address_family
} =
1020 PVE
::Tools
::get_host_address_family
($ip);
1022 return ($ip, $family);
1026 # fallback: try to get IP by other means
1027 my ($family, $packed_ip);
1030 my @res = PVE
::Tools
::getaddrinfo_all
($nodename);
1031 $family = $res[0]->{family
};
1032 $packed_ip = (PVE
::Tools
::unpack_sockaddr_in46
($res[0]->{addr
}))[2];
1036 die "hostname lookup failed:\n$@" if !$noerr;
1040 my $ip = Socket
::inet_ntop
($family, $packed_ip);
1041 if ($ip =~ m/^127\.|^::1$/) {
1042 die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
1046 return wantarray ?
($ip, $family) : $ip;
1049 # ssh related utility functions
1051 sub ssh_merge_keys
{
1052 # remove duplicate keys in $sshauthkeys
1053 # ssh-copy-id simply add keys, so the file can grow to large
1056 if (-f
$sshauthkeys) {
1057 $data = PVE
::Tools
::file_get_contents
($sshauthkeys, 128*1024);
1062 if (-f
$rootsshauthkeysbackup) {
1064 $data .= PVE
::Tools
::file_get_contents
($rootsshauthkeysbackup, 128*1024);
1069 # always add ourself
1070 if (-f
$ssh_rsa_id) {
1071 my $pub = PVE
::Tools
::file_get_contents
($ssh_rsa_id);
1073 $data .= "\n$pub\n";
1078 my @lines = split(/\n/, $data);
1079 foreach my $line (@lines) {
1080 if ($line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/) {
1081 next if $vhash->{$3}++;
1083 $newdata .= "$line\n";
1086 PVE
::Tools
::file_set_contents
($sshauthkeys, $newdata, 0600);
1088 if ($found_backup && -l
$rootsshauthkeys) {
1089 # everything went well, so we can remove the backup
1090 unlink $rootsshauthkeysbackup;
1094 sub setup_sshd_config
{
1096 my $conf = PVE
::Tools
::file_get_contents
($sshd_config_fn);
1098 return if $conf =~ m/^PermitRootLogin\s+yes\s*$/m;
1100 if ($conf !~ s/^#?PermitRootLogin.*$/PermitRootLogin yes/m) {
1102 $conf .= "\nPermitRootLogin yes\n";
1105 PVE
::Tools
::file_set_contents
($sshd_config_fn, $conf);
1107 PVE
::Tools
::run_command
(['systemctl', 'reload-or-restart', 'sshd']);
1110 sub setup_rootsshconfig
{
1112 # create ssh key if it does not exist
1113 if (! -f
$ssh_rsa_id) {
1114 mkdir '/root/.ssh/';
1115 system ("echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}");
1118 # create ssh config if it does not exist
1119 if (! -f
$rootsshconfig) {
1121 if (my $fh = IO
::File-
>new($rootsshconfig, O_CREAT
|O_WRONLY
|O_EXCL
, 0640)) {
1122 # this is the default ciphers list from debian openssl0.9.8 except blowfish is added as prefered
1123 print $fh "Ciphers blowfish-cbc,aes128-ctr,aes192-ctr,aes256-ctr,arcfour256,arcfour128,aes128-cbc,3des-cbc\n";
1129 sub setup_ssh_keys
{
1135 if (! -f
$sshauthkeys) {
1137 if (-f
$rootsshauthkeys) {
1138 $old = PVE
::Tools
::file_get_contents
($rootsshauthkeys, 128*1024);
1140 if (my $fh = IO
::File-
>new ($sshauthkeys, O_CREAT
|O_WRONLY
|O_EXCL
, 0400)) {
1141 PVE
::Tools
::safe_print
($sshauthkeys, $fh, $old) if $old;
1147 warn "can't create shared ssh key database '$sshauthkeys'\n"
1148 if ! -f
$sshauthkeys;
1150 if (-f
$rootsshauthkeys && ! -l
$rootsshauthkeys) {
1151 if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
1152 warn "rename $rootsshauthkeys failed - $!\n";
1156 if (! -l
$rootsshauthkeys) {
1157 symlink $sshauthkeys, $rootsshauthkeys;
1160 if (! -l
$rootsshauthkeys) {
1161 warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
1163 unlink $rootsshauthkeysbackup if $import_ok;
1167 sub ssh_unmerge_known_hosts
{
1168 return if ! -l
$sshglobalknownhosts;
1171 $old = PVE
::Tools
::file_get_contents
($sshknownhosts, 128*1024)
1172 if -f
$sshknownhosts;
1174 PVE
::Tools
::file_set_contents
($sshglobalknownhosts, $old);
1177 sub ssh_merge_known_hosts
{
1178 my ($nodename, $ip_address, $createLink) = @_;
1180 die "no node name specified" if !$nodename;
1181 die "no ip address specified" if !$ip_address;
1185 if (! -f
$sshknownhosts) {
1186 if (my $fh = IO
::File-
>new($sshknownhosts, O_CREAT
|O_WRONLY
|O_EXCL
, 0600)) {
1191 my $old = PVE
::Tools
::file_get_contents
($sshknownhosts, 128*1024);
1195 if ((! -l
$sshglobalknownhosts) && (-f
$sshglobalknownhosts)) {
1196 $new = PVE
::Tools
::file_get_contents
($sshglobalknownhosts, 128*1024);
1199 my $hostkey = PVE
::Tools
::file_get_contents
($ssh_host_rsa_id);
1200 # Note: file sometimes containe emty lines at start, so we use multiline match
1201 die "can't parse $ssh_host_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/m;
1210 my $merge_line = sub {
1211 my ($line, $all) = @_;
1213 if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
1216 if (!$vhash->{$key}) {
1218 if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
1219 my $salt = decode_base64
($1);
1221 my $hmac = Digest
::HMAC_SHA1-
>new($salt);
1222 $hmac->add($nodename);
1223 my $hd = $hmac->b64digest . '=';
1224 if ($digest eq $hd) {
1225 if ($rsakey eq $hostkey) {
1226 $found_nodename = 1;
1231 $hmac = Digest
::HMAC_SHA1-
>new($salt);
1232 $hmac->add($ip_address);
1233 $hd = $hmac->b64digest . '=';
1234 if ($digest eq $hd) {
1235 if ($rsakey eq $hostkey) {
1236 $found_local_ip = 1;
1249 while ($old && $old =~ s/^((.*?)(\n|$))//) {
1251 next if $line =~ m/^\s*$/; # skip empty lines
1252 next if $line =~ m/^#/; # skip comments
1253 &$merge_line($line, 1);
1256 while ($new && $new =~ s/^((.*?)(\n|$))//) {
1258 next if $line =~ m/^\s*$/; # skip empty lines
1259 next if $line =~ m/^#/; # skip comments
1260 &$merge_line($line);
1264 my $add_known_hosts_entry = sub {
1265 my ($name, $hostkey) = @_;
1267 my $hmac = Digest
::HMAC_SHA1-
>new("$addIndex" . time());
1268 my $b64salt = $hmac->b64digest . '=';
1269 $hmac = Digest
::HMAC_SHA1-
>new(decode_base64
($b64salt));
1271 my $digest = $hmac->b64digest . '=';
1272 $data .= "|1|$b64salt|$digest $hostkey\n";
1275 if (!$found_nodename || !$found_local_ip) {
1276 &$add_known_hosts_entry($nodename, $hostkey) if !$found_nodename;
1277 &$add_known_hosts_entry($ip_address, $hostkey) if !$found_local_ip;
1280 PVE
::Tools
::file_set_contents
($sshknownhosts, $data);
1282 return if !$createLink;
1284 unlink $sshglobalknownhosts;
1285 symlink $sshknownhosts, $sshglobalknownhosts;
1287 warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
1288 if ! -l
$sshglobalknownhosts;
1292 my $datacenter_schema = {
1294 additionalProperties
=> 0,
1299 description
=> "Default keybord layout for vnc server.",
1300 enum
=> PVE
::Tools
::kvmkeymaplist
(),
1305 description
=> "Default GUI language.",
1306 enum
=> [ 'en', 'de' ],
1311 description
=> "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1312 pattern
=> "http://.*",
1314 migration_unsecure
=> {
1317 description
=> "Migration is secure using SSH tunnel by default. For secure private networks you can disable it to speed up migration.",
1322 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).",
1323 enum
=> ['applet', 'vv', 'html5'],
1328 format
=> 'email-opt',
1329 description
=> "Specify email address to send notification from (default is root@\$hostname)",
1335 description
=> "Defines how many workers (per node) are maximal started ".
1336 " on actions like 'stopall VMs' or task from the ha-manager.",
1341 default => 'watchdog',
1342 enum
=> [ 'watchdog', 'hardware', 'both' ],
1343 description
=> "Set the fencing mode of the HA cluster. Hardware mode " .
1344 "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
1345 " With both all two modes are used. " .
1346 " NOTE: 'hardware' and 'both' are EXPERIMENTAL & WIP",
1351 # make schema accessible from outside (for documentation)
1352 sub get_datacenter_schema
{ return $datacenter_schema };
1354 sub parse_datacenter_config
{
1355 my ($filename, $raw) = @_;
1357 return PVE
::JSONSchema
::parse_config
($datacenter_schema, $filename, $raw // '');
1360 sub write_datacenter_config
{
1361 my ($filename, $cfg) = @_;
1363 return PVE
::JSONSchema
::dump_config
($datacenter_schema, $filename, $cfg);
1366 cfs_register_file
('datacenter.cfg',
1367 \
&parse_datacenter_config
,
1368 \
&write_datacenter_config
);
1370 # a very simply parser ...
1371 sub parse_corosync_conf
{
1372 my ($filename, $raw) = @_;
1376 my $digest = Digest
::SHA
::sha1_hex
(defined($raw) ?
$raw : '');
1379 $raw =~ s/\r?\n/ /g;
1384 my @tokens = split(/\s/, $raw);
1386 my $conf = { section
=> 'main', children
=> [] };
1389 my $section = $conf;
1391 while (defined(my $token = shift @tokens)) {
1392 my $nexttok = $tokens[0];
1394 if ($nexttok && ($nexttok eq '{')) {
1395 shift @tokens; # skip '{'
1400 push @{$section->{children
}}, $new_section;
1401 push @$stack, $section;
1402 $section = $new_section;
1406 if ($token eq '}') {
1407 $section = pop @$stack;
1408 die "parse error - uncexpected '}'\n" if !$section;
1413 die "missing ':' after key '$key'\n" if ! ($key =~ s/:$//);
1415 die "parse error - no value for '$key'\n" if !defined($nexttok);
1416 my $value = shift @tokens;
1418 push @{$section->{children
}}, { key
=> $key, value
=> $value };
1421 $conf->{digest
} = $digest;
1426 my $dump_corosync_section;
1427 $dump_corosync_section = sub {
1428 my ($section, $prefix) = @_;
1430 my $raw = $prefix . $section->{section
} . " {\n";
1432 my @list = grep { defined($_->{key
}) } @{$section->{children
}};
1433 foreach my $child (sort {$a->{key
} cmp $b->{key
}} @list) {
1434 $raw .= $prefix . " $child->{key}: $child->{value}\n";
1437 @list = grep { defined($_->{section
}) } @{$section->{children
}};
1438 foreach my $child (sort {$a->{section
} cmp $b->{section
}} @list) {
1439 $raw .= &$dump_corosync_section($child, "$prefix ");
1442 $raw .= $prefix . "}\n\n";
1448 sub write_corosync_conf
{
1449 my ($filename, $conf) = @_;
1455 die "no main section" if $conf->{section
} ne 'main';
1457 my @list = grep { defined($_->{key
}) } @{$conf->{children
}};
1458 foreach my $child (sort {$a->{key
} cmp $b->{key
}} @list) {
1459 $raw .= "$child->{key}: $child->{value}\n";
1462 @list = grep { defined($_->{section
}) } @{$conf->{children
}};
1463 foreach my $child (sort {$a->{section
} cmp $b->{section
}} @list) {
1464 $raw .= &$dump_corosync_section($child, $prefix);
1470 sub corosync_conf_version
{
1471 my ($conf, $noerr, $new_value) = @_;
1473 foreach my $child (@{$conf->{children
}}) {
1474 next if !defined($child->{section
});
1475 if ($child->{section
} eq 'totem') {
1476 foreach my $e (@{$child->{children
}}) {
1477 next if !defined($e->{key
});
1478 if ($e->{key
} eq 'config_version') {
1480 $e->{value
} = $new_value;
1482 } elsif (my $version = int($e->{value
})) {
1491 return undef if $noerr;
1493 die "invalid corosync config - unable to read version\n";
1496 # read only - use "rename corosync.conf.new corosync.conf" to write
1497 PVE
::Cluster
::cfs_register_file
('corosync.conf', \
&parse_corosync_conf
);
1498 # this is read/write
1499 PVE
::Cluster
::cfs_register_file
('corosync.conf.new', \
&parse_corosync_conf
,
1500 \
&write_corosync_conf
);
1502 # bash completion helpers
1504 sub complete_next_vmid
{
1506 my $vmlist = get_vmlist
() || {};
1507 my $idlist = $vmlist->{ids
} || {};
1509 for (my $i = 100; $i < 10000; $i++) {
1510 return [$i] if !defined($idlist->{$i});
1518 my $vmlist = get_vmlist
();
1519 my $ids = $vmlist->{ids
} || {};
1521 return [ keys %$ids ];
1524 sub complete_local_vmid
{
1526 my $vmlist = get_vmlist
();
1527 my $ids = $vmlist->{ids
} || {};
1529 my $nodename = PVE
::INotify
::nodename
();
1532 foreach my $vmid (keys %$ids) {
1533 my $d = $ids->{$vmid};
1534 next if !$d->{node
} || $d->{node
} ne $nodename;
1541 sub complete_migration_target
{
1545 my $nodename = PVE
::INotify
::nodename
();
1547 my $nodelist = get_nodelist
();
1548 foreach my $node (@$nodelist) {
1549 next if $node eq $nodename;