data/PVE/Cluster.pm

   1 package PVE::Cluster;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX qw(EEXIST ENOENT);
   6 use File::stat qw();
   7 use Socket;
   8 use Storable qw(dclone);
   9 use IO::File;
  10 use MIME::Base64;
  11 use Digest::SHA;
  12 use Digest::HMAC_SHA1;
  13 use Net::SSLeay;
  14 use PVE::Tools qw(run_command);
  15 use PVE::INotify;
  16 use PVE::IPCC;
  17 use PVE::SafeSyslog;
  18 use PVE::JSONSchema;
  19 use PVE::Network;
  20 use PVE::Cluster::IPCConst;
  21 use JSON;
  22 use RRDs;
  23 use Encode;
  24 use UUID;
  25 use base 'Exporter';
  26
  27 our @EXPORT_OK = qw(
  28 cfs_read_file
  29 cfs_write_file
  30 cfs_register_file
  31 cfs_lock_file);
  32
  33 use Data::Dumper; # fixme: remove
  34
  35 # x509 certificate utils
  36
  37 my $basedir = "/etc/pve";
  38 my $authdir = "$basedir/priv";
  39 my $lockdir = "/etc/pve/priv/lock";
  40
  41 # cfs and corosync files
  42 my $dbfile = "/var/lib/pve-cluster/config.db";
  43 my $dbbackupdir = "/var/lib/pve-cluster/backup";
  44 my $localclusterdir = "/etc/corosync";
  45 my $localclusterconf = "$localclusterdir/corosync.conf";
  46 my $authfile = "$localclusterdir/authkey";
  47 my $clusterconf = "$basedir/corosync.conf";
  48
  49 my $authprivkeyfn = "$authdir/authkey.key";
  50 my $authpubkeyfn = "$basedir/authkey.pub";
  51 my $pveca_key_fn = "$authdir/pve-root-ca.key";
  52 my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
  53 my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
  54 # this is just a secret accessable by the web browser
  55 # and is used for CSRF prevention
  56 my $pvewww_key_fn = "$basedir/pve-www.key";
  57
  58 # ssh related files
  59 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
  60 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
  61 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
  62 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
  63 my $sshknownhosts = "/etc/pve/priv/known_hosts";
  64 my $sshauthkeys = "/etc/pve/priv/authorized_keys";
  65 my $sshd_config_fn = "/etc/ssh/sshd_config";
  66 my $rootsshauthkeys = "/root/.ssh/authorized_keys";
  67 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
  68 my $rootsshconfig = "/root/.ssh/config";
  69
  70 my $observed = {
  71     'vzdump.cron' => 1,
  72     'storage.cfg' => 1,
  73     'datacenter.cfg' => 1,
  74     'replication.cfg' => 1,
  75     'corosync.conf' => 1,
  76     'corosync.conf.new' => 1,
  77     'user.cfg' => 1,
  78     'domains.cfg' => 1,
  79     'priv/shadow.cfg' => 1,
  80     '/qemu-server/' => 1,
  81     '/openvz/' => 1,
  82     '/lxc/' => 1,
  83     'ha/crm_commands' => 1,
  84     'ha/manager_status' => 1,
  85     'ha/resources.cfg' => 1,
  86     'ha/groups.cfg' => 1,
  87     'ha/fence.cfg' => 1,
  88     'status.cfg' => 1,
  89 };
  90
  91 # only write output if something fails
  92 sub run_silent_cmd {
  93     my ($cmd) = @_;
  94
  95     my $outbuf = '';
  96     my $record = sub { $outbuf .= shift . "\n"; };
  97
  98     eval { run_command($cmd, outfunc => $record, errfunc => $record) };
  99
 100     if (my $err = $@) {
 101         print STDERR $outbuf;
 102         die $err;
 103     }
 104 }
 105
 106 sub check_cfs_quorum {
 107     my ($noerr) = @_;
 108
 109     # note: -w filename always return 1 for root, so wee need
 110     # to use File::lstat here
 111     my $st = File::stat::lstat("$basedir/local");
 112     my $quorate = ($st && (($st->mode & 0200) != 0));
 113
 114     die "cluster not ready - no quorum?\n" if !$quorate && !$noerr;
 115
 116     return $quorate;
 117 }
 118
 119 sub check_cfs_is_mounted {
 120     my ($noerr) = @_;
 121
 122     my $res = -l "$basedir/local";
 123
 124     die "pve configuration filesystem not mounted\n"
 125         if !$res && !$noerr;
 126
 127     return $res;
 128 }
 129
 130 sub gen_local_dirs {
 131     my ($nodename) = @_;
 132
 133     check_cfs_is_mounted();
 134
 135     my @required_dirs = (
 136         "$basedir/priv",
 137         "$basedir/nodes",
 138         "$basedir/nodes/$nodename",
 139         "$basedir/nodes/$nodename/lxc",
 140         "$basedir/nodes/$nodename/qemu-server",
 141         "$basedir/nodes/$nodename/openvz",
 142         "$basedir/nodes/$nodename/priv");
 143
 144     foreach my $dir (@required_dirs) {
 145         if (! -d $dir) {
 146             mkdir($dir) || $! == EEXIST || die "unable to create directory '$dir' - $!\n";
 147         }
 148     }
 149 }
 150
 151 sub gen_auth_key {
 152
 153     return if -f "$authprivkeyfn";
 154
 155     check_cfs_is_mounted();
 156
 157     mkdir $authdir || $! == EEXIST || die "unable to create dir '$authdir' - $!\n";
 158
 159     run_silent_cmd(['openssl', 'genrsa', '-out', $authprivkeyfn, '2048']);
 160
 161     run_silent_cmd(['openssl', 'rsa', '-in', $authprivkeyfn, '-pubout', '-out', $authpubkeyfn]);
 162 }
 163
 164 sub gen_pveca_key {
 165
 166     return if -f $pveca_key_fn;
 167
 168     eval {
 169         run_silent_cmd(['openssl', 'genrsa', '-out', $pveca_key_fn, '4096']);
 170     };
 171
 172     die "unable to generate pve ca key:\n$@" if $@;
 173 }
 174
 175 sub gen_pveca_cert {
 176
 177     if (-f $pveca_key_fn && -f $pveca_cert_fn) {
 178         return 0;
 179     }
 180
 181     gen_pveca_key();
 182
 183     # we try to generate an unique 'subject' to avoid browser problems
 184     # (reused serial numbers, ..)
 185     my $uuid;
 186     UUID::generate($uuid);
 187     my $uuid_str;
 188     UUID::unparse($uuid, $uuid_str);
 189
 190     eval {
 191         # wrap openssl with faketime to prevent bug #904
 192         run_silent_cmd(['faketime', 'yesterday', 'openssl', 'req', '-batch',
 193                         '-days', '3650', '-new', '-x509', '-nodes', '-key',
 194                         $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
 195                         "/CN=Proxmox Virtual Environment/OU=$uuid_str/O=PVE Cluster Manager CA/"]);
 196     };
 197
 198     die "generating pve root certificate failed:\n$@" if $@;
 199
 200     return 1;
 201 }
 202
 203 sub gen_pve_ssl_key {
 204     my ($nodename) = @_;
 205
 206     die "no node name specified" if !$nodename;
 207
 208     my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
 209
 210     return if -f $pvessl_key_fn;
 211
 212     eval {
 213         run_silent_cmd(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
 214     };
 215
 216     die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
 217 }
 218
 219 sub gen_pve_www_key {
 220
 221     return if -f $pvewww_key_fn;
 222
 223     eval {
 224         run_silent_cmd(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
 225     };
 226
 227     die "unable to generate pve www key:\n$@" if $@;
 228 }
 229
 230 sub update_serial {
 231     my ($serial) = @_;
 232
 233     PVE::Tools::file_set_contents($pveca_srl_fn, $serial);
 234 }
 235
 236 sub gen_pve_ssl_cert {
 237     my ($force, $nodename, $ip) = @_;
 238
 239     die "no node name specified" if !$nodename;
 240     die "no IP specified" if !$ip;
 241
 242     my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
 243
 244     return if !$force && -f $pvessl_cert_fn;
 245
 246     my $names = "IP:127.0.0.1,IP:::1,DNS:localhost";
 247
 248     my $rc = PVE::INotify::read_file('resolvconf');
 249
 250     $names .= ",IP:$ip";
 251
 252     my $fqdn = $nodename;
 253
 254     $names .= ",DNS:$nodename";
 255
 256     if ($rc && $rc->{search}) {
 257         $fqdn = $nodename . "." . $rc->{search};
 258         $names .= ",DNS:$fqdn";
 259     }
 260
 261     my $sslconf = <<__EOD;
 262 RANDFILE = /root/.rnd
 263 extensions = v3_req
 264
 265 [ req ]
 266 default_bits = 2048
 267 distinguished_name = req_distinguished_name
 268 req_extensions = v3_req
 269 prompt = no
 270 string_mask = nombstr
 271
 272 [ req_distinguished_name ]
 273 organizationalUnitName = PVE Cluster Node
 274 organizationName = Proxmox Virtual Environment
 275 commonName = $fqdn
 276
 277 [ v3_req ]
 278 basicConstraints = CA:FALSE
 279 extendedKeyUsage = serverAuth
 280 subjectAltName = $names
 281 __EOD
 282
 283     my $cfgfn = "/tmp/pvesslconf-$$.tmp";
 284     my $fh = IO::File->new ($cfgfn, "w");
 285     print $fh $sslconf;
 286     close ($fh);
 287
 288     my $reqfn = "/tmp/pvecertreq-$$.tmp";
 289     unlink $reqfn;
 290
 291     my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
 292     eval {
 293         run_silent_cmd(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
 294                         '-key', $pvessl_key_fn, '-out', $reqfn]);
 295     };
 296
 297     if (my $err = $@) {
 298         unlink $reqfn;
 299         unlink $cfgfn;
 300         die "unable to generate pve certificate request:\n$err";
 301     }
 302
 303     update_serial("0000000000000000") if ! -f $pveca_srl_fn;
 304
 305     eval {
 306         # wrap openssl with faketime to prevent bug #904
 307         run_silent_cmd(['faketime', 'yesterday', 'openssl', 'x509', '-req',
 308                         '-in', $reqfn, '-days', '3650', '-out', $pvessl_cert_fn,
 309                         '-CAkey', $pveca_key_fn, '-CA', $pveca_cert_fn,
 310                         '-CAserial', $pveca_srl_fn, '-extfile', $cfgfn]);
 311     };
 312
 313     if (my $err = $@) {
 314         unlink $reqfn;
 315         unlink $cfgfn;
 316         die "unable to generate pve ssl certificate:\n$err";
 317     }
 318
 319     unlink $cfgfn;
 320     unlink $reqfn;
 321 }
 322
 323 sub gen_pve_node_files {
 324     my ($nodename, $ip, $opt_force) = @_;
 325
 326     gen_local_dirs($nodename);
 327
 328     gen_auth_key();
 329
 330     # make sure we have a (cluster wide) secret
 331     # for CSRFR prevention
 332     gen_pve_www_key();
 333
 334     # make sure we have a (per node) private key
 335     gen_pve_ssl_key($nodename);
 336
 337     # make sure we have a CA
 338     my $force = gen_pveca_cert();
 339
 340     $force = 1 if $opt_force;
 341
 342     gen_pve_ssl_cert($force, $nodename, $ip);
 343 }
 344
 345 my $vzdump_cron_dummy = <<__EOD;
 346 # cluster wide vzdump cron schedule
 347 # Atomatically generated file - do not edit
 348
 349 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
 350
 351 __EOD
 352
 353 sub gen_pve_vzdump_symlink {
 354
 355     my $filename = "/etc/pve/vzdump.cron";
 356
 357     my $link_fn = "/etc/cron.d/vzdump";
 358
 359     if ((-f $filename) && (! -l $link_fn)) {
 360         rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
 361         symlink($filename, $link_fn);
 362     }
 363 }
 364
 365 sub gen_pve_vzdump_files {
 366
 367     my $filename = "/etc/pve/vzdump.cron";
 368
 369     PVE::Tools::file_set_contents($filename, $vzdump_cron_dummy)
 370         if ! -f $filename;
 371
 372     gen_pve_vzdump_symlink();
 373 };
 374
 375 my $versions = {};
 376 my $vmlist = {};
 377 my $clinfo = {};
 378
 379 my $ipcc_send_rec = sub {
 380     my ($msgid, $data) = @_;
 381
 382     my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
 383
 384     die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
 385
 386     return $res;
 387 };
 388
 389 my $ipcc_send_rec_json = sub {
 390     my ($msgid, $data) = @_;
 391
 392     my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
 393
 394     die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
 395
 396     return decode_json($res);
 397 };
 398
 399 my $ipcc_get_config = sub {
 400     my ($path) = @_;
 401
 402     my $bindata = pack "Z*", $path;
 403     my $res = PVE::IPCC::ipcc_send_rec(CFS_IPC_GET_CONFIG, $bindata);
 404     if (!defined($res)) {
 405         if ($! != 0) {
 406             return undef if $! == ENOENT;
 407             die "$!\n";
 408         }
 409         return '';
 410     }
 411
 412     return $res;
 413 };
 414
 415 my $ipcc_get_status = sub {
 416     my ($name, $nodename) = @_;
 417
 418     my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
 419     return PVE::IPCC::ipcc_send_rec(CFS_IPC_GET_STATUS, $bindata);
 420 };
 421
 422 my $ipcc_update_status = sub {
 423     my ($name, $data) = @_;
 424
 425     my $raw = ref($data) ? encode_json($data) : $data;
 426     # update status
 427     my $bindata = pack "Z[256]Z*", $name, $raw;
 428
 429     return &$ipcc_send_rec(CFS_IPC_SET_STATUS, $bindata);
 430 };
 431
 432 my $ipcc_log = sub {
 433     my ($priority, $ident, $tag, $msg) = @_;
 434
 435     my $bindata = pack "CCCZ*Z*Z*", $priority, bytes::length($ident) + 1,
 436     bytes::length($tag) + 1, $ident, $tag, $msg;
 437
 438     return &$ipcc_send_rec(CFS_IPC_LOG_CLUSTER_MSG, $bindata);
 439 };
 440
 441 my $ipcc_get_cluster_log = sub {
 442     my ($user, $max) = @_;
 443
 444     $max = 0 if !defined($max);
 445
 446     my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
 447     return &$ipcc_send_rec(CFS_IPC_GET_CLUSTER_LOG, $bindata);
 448 };
 449
 450 my $ccache = {};
 451
 452 sub cfs_update {
 453     my ($fail) = @_;
 454     eval {
 455         my $res = &$ipcc_send_rec_json(CFS_IPC_GET_FS_VERSION);
 456         #warn "GOT1: " . Dumper($res);
 457         die "no starttime\n" if !$res->{starttime};
 458
 459         if (!$res->{starttime} || !$versions->{starttime} ||
 460             $res->{starttime} != $versions->{starttime}) {
 461             #print "detected changed starttime\n";
 462             $vmlist = {};
 463             $clinfo = {};
 464             $ccache = {};
 465         }
 466
 467         $versions = $res;
 468     };
 469     my $err = $@;
 470     if ($err) {
 471         $versions = {};
 472         $vmlist = {};
 473         $clinfo = {};
 474         $ccache = {};
 475         die $err if $fail;
 476         warn $err;
 477     }
 478
 479     eval {
 480         if (!$clinfo->{version} || $clinfo->{version} != $versions->{clinfo}) {
 481             #warn "detected new clinfo\n";
 482             $clinfo = &$ipcc_send_rec_json(CFS_IPC_GET_CLUSTER_INFO);
 483         }
 484     };
 485     $err = $@;
 486     if ($err) {
 487         $clinfo = {};
 488         die $err if $fail;
 489         warn $err;
 490     }
 491
 492     eval {
 493         if (!$vmlist->{version} || $vmlist->{version} != $versions->{vmlist}) {
 494             #warn "detected new vmlist1\n";
 495             $vmlist = &$ipcc_send_rec_json(CFS_IPC_GET_GUEST_LIST);
 496         }
 497     };
 498     $err = $@;
 499     if ($err) {
 500         $vmlist = {};
 501         die $err if $fail;
 502         warn $err;
 503     }
 504 }
 505
 506 sub get_vmlist {
 507     return $vmlist;
 508 }
 509
 510 sub get_clinfo {
 511     return $clinfo;
 512 }
 513
 514 sub get_members {
 515     return $clinfo->{nodelist};
 516 }
 517
 518 sub get_nodelist {
 519
 520     my $nodelist = $clinfo->{nodelist};
 521
 522     my $result = [];
 523
 524     my $nodename = PVE::INotify::nodename();
 525
 526     if (!$nodelist || !$nodelist->{$nodename}) {
 527         return [ $nodename ];
 528     }
 529
 530     return [ keys %$nodelist ];
 531 }
 532
 533 # $data must be a chronological descending ordered array of tasks
 534 sub broadcast_tasklist {
 535     my ($data) = @_;
 536
 537     # the serialized list may not get bigger than 32kb (CFS_MAX_STATUS_SIZE
 538     # from pmxcfs) - drop older items until we satisfy this constraint
 539     my $size = length(encode_json($data));
 540     while ($size >= (32 * 1024)) {
 541         pop @$data;
 542         $size = length(encode_json($data));
 543     }
 544
 545     eval {
 546         &$ipcc_update_status("tasklist", $data);
 547     };
 548
 549     warn $@ if $@;
 550 }
 551
 552 my $tasklistcache = {};
 553
 554 sub get_tasklist {
 555     my ($nodename) = @_;
 556
 557     my $kvstore = $versions->{kvstore} || {};
 558
 559     my $nodelist = get_nodelist();
 560
 561     my $res = [];
 562     foreach my $node (@$nodelist) {
 563         next if $nodename && ($nodename ne $node);
 564         eval {
 565             my $ver = $kvstore->{$node}->{tasklist} if $kvstore->{$node};
 566             my $cd = $tasklistcache->{$node};
 567             if (!$cd || !$ver || !$cd->{version} ||
 568                 ($cd->{version} != $ver)) {
 569                 my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
 570                 my $data = decode_json($raw);
 571                 push @$res, @$data;
 572                 $cd = $tasklistcache->{$node} = {
 573                     data => $data,
 574                     version => $ver,
 575                 };
 576             } elsif ($cd && $cd->{data}) {
 577                 push @$res, @{$cd->{data}};
 578             }
 579         };
 580         my $err = $@;
 581         syslog('err', $err) if $err;
 582     }
 583
 584     return $res;
 585 }
 586
 587 sub broadcast_rrd {
 588     my ($rrdid, $data) = @_;
 589
 590     eval {
 591         &$ipcc_update_status("rrd/$rrdid", $data);
 592     };
 593     my $err = $@;
 594
 595     warn $err if $err;
 596 }
 597
 598 my $last_rrd_dump = 0;
 599 my $last_rrd_data = "";
 600
 601 sub rrd_dump {
 602
 603     my $ctime = time();
 604
 605     my $diff = $ctime - $last_rrd_dump;
 606     if ($diff < 2) {
 607         return $last_rrd_data;
 608     }
 609
 610     my $raw;
 611     eval {
 612         $raw = &$ipcc_send_rec(CFS_IPC_GET_RRD_DUMP);
 613     };
 614     my $err = $@;
 615
 616     if ($err) {
 617         warn $err;
 618         return {};
 619     }
 620
 621     my $res = {};
 622
 623     if ($raw) {
 624         while ($raw =~ s/^(.*)\n//) {
 625             my ($key, @ela) = split(/:/, $1);
 626             next if !$key;
 627             next if !(scalar(@ela) > 1);
 628             $res->{$key} = [ map { $_ eq 'U' ? undef : $_ } @ela ];
 629         }
 630     }
 631
 632     $last_rrd_dump = $ctime;
 633     $last_rrd_data = $res;
 634
 635     return $res;
 636 }
 637
 638 sub create_rrd_data {
 639     my ($rrdname, $timeframe, $cf) = @_;
 640
 641     my $rrddir = "/var/lib/rrdcached/db";
 642
 643     my $rrd = "$rrddir/$rrdname";
 644
 645     my $setup = {
 646         hour =>  [ 60, 70 ],
 647         day  =>  [ 60*30, 70 ],
 648         week =>  [ 60*180, 70 ],
 649         month => [ 60*720, 70 ],
 650         year =>  [ 60*10080, 70 ],
 651     };
 652
 653     my ($reso, $count) = @{$setup->{$timeframe}};
 654     my $ctime  = $reso*int(time()/$reso);
 655     my $req_start = $ctime - $reso*$count;
 656
 657     $cf = "AVERAGE" if !$cf;
 658
 659     my @args = (
 660         "-s" => $req_start,
 661         "-e" => $ctime - 1,
 662         "-r" => $reso,
 663         );
 664
 665     my $socket = "/var/run/rrdcached.sock";
 666     push @args, "--daemon" => "unix:$socket" if -S $socket;
 667
 668     my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);
 669
 670     my $err = RRDs::error;
 671     die "RRD error: $err\n" if $err;
 672
 673     die "got wrong time resolution ($step != $reso)\n"
 674         if $step != $reso;
 675
 676     my $res = [];
 677     my $fields = scalar(@$names);
 678     for my $line (@$data) {
 679         my $entry = { 'time' => $start };
 680         $start += $step;
 681         for (my $i = 0; $i < $fields; $i++) {
 682             my $name = $names->[$i];
 683             if (defined(my $val = $line->[$i])) {
 684                 $entry->{$name} = $val;
 685             } else {
 686                 # leave empty fields undefined
 687                 # maybe make this configurable?
 688             }
 689         }
 690         push @$res, $entry;
 691     }
 692
 693     return $res;
 694 }
 695
 696 sub create_rrd_graph {
 697     my ($rrdname, $timeframe, $ds, $cf) = @_;
 698
 699     # Using RRD graph is clumsy - maybe it
 700     # is better to simply fetch the data, and do all display
 701     # related things with javascript (new extjs html5 graph library).
 702
 703     my $rrddir = "/var/lib/rrdcached/db";
 704
 705     my $rrd = "$rrddir/$rrdname";
 706
 707     my @ids = PVE::Tools::split_list($ds);
 708
 709     my $ds_txt = join('_', @ids);
 710
 711     my $filename = "${rrd}_${ds_txt}.png";
 712
 713     my $setup = {
 714         hour =>  [ 60, 60 ],
 715         day  =>  [ 60*30, 70 ],
 716         week =>  [ 60*180, 70 ],
 717         month => [ 60*720, 70 ],
 718         year =>  [ 60*10080, 70 ],
 719     };
 720
 721     my ($reso, $count) = @{$setup->{$timeframe}};
 722
 723     my @args = (
 724         "--imgformat" => "PNG",
 725         "--border" => 0,
 726         "--height" => 200,
 727         "--width" => 800,
 728         "--start" => - $reso*$count,
 729         "--end" => 'now' ,
 730         "--lower-limit" => 0,
 731         );
 732
 733     my $socket = "/var/run/rrdcached.sock";
 734     push @args, "--daemon" => "unix:$socket" if -S $socket;
 735
 736     my @coldef = ('#00ddff', '#ff0000');
 737
 738     $cf = "AVERAGE" if !$cf;
 739
 740     my $i = 0;
 741     foreach my $id (@ids) {
 742         my $col = $coldef[$i++] || die "fixme: no color definition";
 743         push @args, "DEF:${id}=$rrd:${id}:$cf";
 744         my $dataid = $id;
 745         if ($id eq 'cpu' || $id eq 'iowait') {
 746             push @args, "CDEF:${id}_per=${id},100,*";
 747             $dataid = "${id}_per";
 748         }
 749         push @args, "LINE2:${dataid}${col}:${id}";
 750     }
 751
 752     push @args, '--full-size-mode';
 753
 754     # we do not really store data into the file
 755     my $res = RRDs::graphv('-', @args);
 756
 757     my $err = RRDs::error;
 758     die "RRD error: $err\n" if $err;
 759
 760     return { filename => $filename, image => $res->{image} };
 761 }
 762
 763 # a fast way to read files (avoid fuse overhead)
 764 sub get_config {
 765     my ($path) = @_;
 766
 767     return &$ipcc_get_config($path);
 768 }
 769
 770 sub get_cluster_log {
 771     my ($user, $max) = @_;
 772
 773     return &$ipcc_get_cluster_log($user, $max);
 774 }
 775
 776 my $file_info = {};
 777
 778 sub cfs_register_file {
 779     my ($filename, $parser, $writer) = @_;
 780
 781     $observed->{$filename} || die "unknown file '$filename'";
 782
 783     die "file '$filename' already registered" if $file_info->{$filename};
 784
 785     $file_info->{$filename} = {
 786         parser => $parser,
 787         writer => $writer,
 788     };
 789 }
 790
 791 my $ccache_read = sub {
 792     my ($filename, $parser, $version) = @_;
 793
 794     $ccache->{$filename} = {} if !$ccache->{$filename};
 795
 796     my $ci = $ccache->{$filename};
 797
 798     if (!$ci->{version} || !$version || $ci->{version} != $version) {
 799         # we always call the parser, even when the file does not exists
 800         # (in that case $data is undef)
 801         my $data = get_config($filename);
 802         $ci->{data} = &$parser("/etc/pve/$filename", $data);
 803         $ci->{version} = $version;
 804     }
 805
 806     my $res = ref($ci->{data}) ? dclone($ci->{data}) : $ci->{data};
 807
 808     return $res;
 809 };
 810
 811 sub cfs_file_version {
 812     my ($filename) = @_;
 813
 814     my $version;
 815     my $infotag;
 816     if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) {
 817         my ($type, $vmid) = ($1, $2);
 818         if ($vmlist && $vmlist->{ids} && $vmlist->{ids}->{$vmid}) {
 819             $version = $vmlist->{ids}->{$vmid}->{version};
 820         }
 821         $infotag = "/$type/";
 822     } else {
 823         $infotag = $filename;
 824         $version = $versions->{$filename};
 825     }
 826
 827     my $info = $file_info->{$infotag} ||
 828         die "unknown file type '$filename'\n";
 829
 830     return wantarray ? ($version, $info) : $version;
 831 }
 832
 833 sub cfs_read_file {
 834     my ($filename) = @_;
 835
 836     my ($version, $info) = cfs_file_version($filename);
 837     my $parser = $info->{parser};
 838
 839     return &$ccache_read($filename, $parser, $version);
 840 }
 841
 842 sub cfs_write_file {
 843     my ($filename, $data) = @_;
 844
 845     my ($version, $info) = cfs_file_version($filename);
 846
 847     my $writer = $info->{writer} || die "no writer defined";
 848
 849     my $fsname = "/etc/pve/$filename";
 850
 851     my $raw = &$writer($fsname, $data);
 852
 853     if (my $ci = $ccache->{$filename}) {
 854         $ci->{version} = undef;
 855     }
 856
 857     PVE::Tools::file_set_contents($fsname, $raw);
 858 }
 859
 860 my $cfs_lock = sub {
 861     my ($lockid, $timeout, $code, @param) = @_;
 862
 863     my $prev_alarm = alarm(0); # suspend outer alarm early
 864
 865     my $res;
 866     my $got_lock = 0;
 867
 868     # this timeout is for acquire the lock
 869     $timeout = 10 if !$timeout;
 870
 871     my $filename = "$lockdir/$lockid";
 872
 873     eval {
 874
 875         mkdir $lockdir;
 876
 877         if (! -d $lockdir) {
 878             die "pve cluster filesystem not online.\n";
 879         }
 880
 881         my $timeout_err = sub { die "got lock request timeout\n"; };
 882         local $SIG{ALRM} = $timeout_err;
 883
 884         while (1) {
 885             alarm ($timeout);
 886             $got_lock = mkdir($filename);
 887             $timeout = alarm(0) - 1; # we'll sleep for 1s, see down below
 888
 889             last if $got_lock;
 890
 891             $timeout_err->() if $timeout <= 0;
 892
 893             print STDERR "trying to acquire cfs lock '$lockid' ...\n";
 894             utime (0, 0, $filename); # cfs unlock request
 895             sleep(1);
 896         }
 897
 898         # fixed command timeout: cfs locks have a timeout of 120
 899         # using 60 gives us another 60 seconds to abort the task
 900         local $SIG{ALRM} = sub { die "got lock timeout - aborting command\n"; };
 901         alarm(60);
 902
 903         cfs_update(); # make sure we read latest versions inside code()
 904
 905         $res = &$code(@param);
 906
 907         alarm(0);
 908     };
 909
 910     my $err = $@;
 911
 912     $err = "no quorum!\n" if !$got_lock && !check_cfs_quorum(1);
 913
 914     rmdir $filename if $got_lock; # if we held the lock always unlock again
 915
 916     alarm($prev_alarm);
 917
 918     if ($err) {
 919         $@ = "error with cfs lock '$lockid': $err";
 920         return undef;
 921     }
 922
 923     $@ = undef;
 924
 925     return $res;
 926 };
 927
 928 sub cfs_lock_file {
 929     my ($filename, $timeout, $code, @param) = @_;
 930
 931     my $info = $observed->{$filename} || die "unknown file '$filename'";
 932
 933     my $lockid = "file-$filename";
 934     $lockid =~ s/[.\/]/_/g;
 935
 936     &$cfs_lock($lockid, $timeout, $code, @param);
 937 }
 938
 939 sub cfs_lock_storage {
 940     my ($storeid, $timeout, $code, @param) = @_;
 941
 942     my $lockid = "storage-$storeid";
 943
 944     &$cfs_lock($lockid, $timeout, $code, @param);
 945 }
 946
 947 sub cfs_lock_domain {
 948     my ($domainname, $timeout, $code, @param) = @_;
 949
 950     my $lockid = "domain-$domainname";
 951
 952     &$cfs_lock($lockid, $timeout, $code, @param);
 953 }
 954
 955 sub cfs_lock_acme {
 956     my ($account, $timeout, $code, @param) = @_;
 957
 958     my $lockid = "acme-$account";
 959
 960     &$cfs_lock($lockid, $timeout, $code, @param);
 961 }
 962
 963 my $log_levels = {
 964     "emerg" => 0,
 965     "alert" => 1,
 966     "crit" => 2,
 967     "critical" => 2,
 968     "err" => 3,
 969     "error" => 3,
 970     "warn" => 4,
 971     "warning" => 4,
 972     "notice" => 5,
 973     "info" => 6,
 974     "debug" => 7,
 975 };
 976
 977 sub log_msg {
 978    my ($priority, $ident, $msg) = @_;
 979
 980    if (my $tmp = $log_levels->{$priority}) {
 981        $priority = $tmp;
 982    }
 983
 984    die "need numeric log priority" if $priority !~ /^\d+$/;
 985
 986    my $tag = PVE::SafeSyslog::tag();
 987
 988    $msg = "empty message" if !$msg;
 989
 990    $ident = "" if !$ident;
 991    $ident = encode("ascii", $ident,
 992                    sub { sprintf "\\u%04x", shift });
 993
 994    my $ascii = encode("ascii", $msg, sub { sprintf "\\u%04x", shift });
 995
 996    if ($ident) {
 997        syslog($priority, "<%s> %s", $ident, $ascii);
 998    } else {
 999        syslog($priority, "%s", $ascii);
1000    }
1001
1002    eval { &$ipcc_log($priority, $ident, $tag, $ascii); };
1003
1004    syslog("err", "writing cluster log failed: $@") if $@;
1005 }
1006
1007 sub check_vmid_unused {
1008     my ($vmid, $noerr) = @_;
1009
1010     my $vmlist = get_vmlist();
1011
1012     my $d = $vmlist->{ids}->{$vmid};
1013     return 1 if !defined($d);
1014
1015     return undef if $noerr;
1016
1017     my $vmtypestr =  $d->{type} eq 'qemu' ? 'VM' : 'CT';
1018     die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
1019 }
1020
1021 sub check_node_exists {
1022     my ($nodename, $noerr) = @_;
1023
1024     my $nodelist = $clinfo->{nodelist};
1025     return 1 if $nodelist && $nodelist->{$nodename};
1026
1027     return undef if $noerr;
1028
1029     die "no such cluster node '$nodename'\n";
1030 }
1031
1032 # this is also used to get the IP of the local node
1033 sub remote_node_ip {
1034     my ($nodename, $noerr) = @_;
1035
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};
1041             if (!$family) {
1042                 $nodelist->{$nodename}->{address_family} =
1043                     $family =
1044                     PVE::Tools::get_host_address_family($ip);
1045             }
1046             return wantarray ? ($ip, $family) : $ip;
1047         }
1048     }
1049
1050     # fallback: try to get IP by other means
1051     return PVE::Network::get_ip_from_hostname($nodename, $noerr);
1052 }
1053
1054 sub get_local_migration_ip {
1055     my ($migration_network, $noerr) = @_;
1056
1057     my $cidr = $migration_network;
1058
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});
1063     }
1064
1065     if (defined($cidr)) {
1066         my $ips = PVE::Network::get_local_ip_from_cidr($cidr);
1067
1068         die "could not get migration ip: no IP address configured on local " .
1069             "node for network '$cidr'\n" if !$noerr && (scalar(@$ips) == 0);
1070
1071         die "could not get migration ip: multiple IP address configured for " .
1072             "network '$cidr'\n" if !$noerr && (scalar(@$ips) > 1);
1073
1074         return @$ips[0];
1075     }
1076
1077     return undef;
1078 };
1079
1080 # ssh related utility functions
1081
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
1085
1086     my $data = '';
1087     if (-f $sshauthkeys) {
1088         $data = PVE::Tools::file_get_contents($sshauthkeys, 128*1024);
1089         chomp($data);
1090     }
1091
1092     my $found_backup;
1093     if (-f $rootsshauthkeysbackup) {
1094         $data .= "\n";
1095         $data .= PVE::Tools::file_get_contents($rootsshauthkeysbackup, 128*1024);
1096         chomp($data);
1097         $found_backup = 1;
1098     }
1099
1100     # always add ourself
1101     if (-f $ssh_rsa_id) {
1102         my $pub = PVE::Tools::file_get_contents($ssh_rsa_id);
1103         chomp($pub);
1104         $data .= "\n$pub\n";
1105     }
1106
1107     my $newdata = "";
1108     my $vhash = {};
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}++;
1113         }
1114         $newdata .= "$line\n";
1115     }
1116
1117     PVE::Tools::file_set_contents($sshauthkeys, $newdata, 0600);
1118
1119     if ($found_backup && -l $rootsshauthkeys) {
1120         # everything went well, so we can remove the backup
1121         unlink $rootsshauthkeysbackup;
1122     }
1123 }
1124
1125 sub setup_sshd_config {
1126     my () = @_;
1127
1128     my $conf = PVE::Tools::file_get_contents($sshd_config_fn);
1129
1130     return if $conf =~ m/^PermitRootLogin\s+yes\s*$/m;
1131
1132     if ($conf !~ s/^#?PermitRootLogin.*$/PermitRootLogin yes/m) {
1133         chomp $conf;
1134         $conf .= "\nPermitRootLogin yes\n";
1135     }
1136
1137     PVE::Tools::file_set_contents($sshd_config_fn, $conf);
1138
1139     PVE::Tools::run_command(['systemctl', 'reload-or-restart', 'sshd']);
1140 }
1141
1142 sub setup_rootsshconfig {
1143
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}");
1148     }
1149
1150     # create ssh config if it does not exist
1151     if (! -f $rootsshconfig) {
1152         mkdir '/root/.ssh';
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";
1157             close($fh);
1158         }
1159     }
1160 }
1161
1162 sub setup_ssh_keys {
1163
1164     mkdir $authdir;
1165
1166     my $import_ok;
1167
1168     if (! -f $sshauthkeys) {
1169         my $old;
1170         if (-f $rootsshauthkeys) {
1171             $old = PVE::Tools::file_get_contents($rootsshauthkeys, 128*1024);
1172         }
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;
1175             close($fh);
1176             $import_ok = 1;
1177         }
1178     }
1179
1180     warn "can't create shared ssh key database '$sshauthkeys'\n"
1181         if ! -f $sshauthkeys;
1182
1183     if (-f $rootsshauthkeys && ! -l $rootsshauthkeys) {
1184         if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
1185             warn "rename $rootsshauthkeys failed - $!\n";
1186         }
1187     }
1188
1189     if (! -l $rootsshauthkeys) {
1190         symlink $sshauthkeys, $rootsshauthkeys;
1191     }
1192
1193     if (! -l $rootsshauthkeys) {
1194         warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
1195     } else {
1196         unlink $rootsshauthkeysbackup if $import_ok;
1197     }
1198 }
1199
1200 sub ssh_unmerge_known_hosts {
1201     return if ! -l $sshglobalknownhosts;
1202
1203     my $old = '';
1204     $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024)
1205         if -f $sshknownhosts;
1206
1207     PVE::Tools::file_set_contents($sshglobalknownhosts, $old);
1208 }
1209
1210 sub ssh_merge_known_hosts {
1211     my ($nodename, $ip_address, $createLink) = @_;
1212
1213     die "no node name specified" if !$nodename;
1214     die "no ip address specified" if !$ip_address;
1215
1216     # ssh lowercases hostnames (aliases) before comparision, so we need too
1217     $nodename = lc($nodename);
1218     $ip_address = lc($ip_address);
1219
1220     mkdir $authdir;
1221
1222     if (! -f $sshknownhosts) {
1223         if (my $fh = IO::File->new($sshknownhosts, O_CREAT|O_WRONLY|O_EXCL, 0600)) {
1224             close($fh);
1225         }
1226     }
1227
1228     my $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024);
1229
1230     my $new = '';
1231
1232     if ((! -l $sshglobalknownhosts) && (-f $sshglobalknownhosts)) {
1233         $new = PVE::Tools::file_get_contents($sshglobalknownhosts, 128*1024);
1234     }
1235
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;
1239     $hostkey = $1;
1240
1241     my $data = '';
1242     my $vhash = {};
1243
1244     my $found_nodename;
1245     my $found_local_ip;
1246
1247     my $merge_line = sub {
1248         my ($line, $all) = @_;
1249
1250         return if $line =~ m/^\s*$/; # skip empty lines
1251         return if $line =~ m/^#/; # skip comments
1252
1253         if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
1254             my $key = $1;
1255             my $rsakey = $2;
1256             if (!$vhash->{$key}) {
1257                 $vhash->{$key} = 1;
1258                 if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
1259                     my $salt = decode_base64($1);
1260                     my $digest = $2;
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;
1267                             $data .= $line;
1268                         }
1269                         return;
1270                     }
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;
1277                             $data .= $line;
1278                         }
1279                         return;
1280                     }
1281                 } else {
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;
1287                     }
1288                 }
1289                 $data .= $line;
1290             }
1291         } elsif ($all) {
1292             $data .= $line;
1293         }
1294     };
1295
1296     while ($old && $old =~ s/^((.*?)(\n|$))//) {
1297         my $line = "$2\n";
1298         &$merge_line($line, 1);
1299     }
1300
1301     while ($new && $new =~ s/^((.*?)(\n|$))//) {
1302         my $line = "$2\n";
1303         &$merge_line($line);
1304     }
1305
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;
1309
1310     PVE::Tools::file_set_contents($sshknownhosts, $data);
1311
1312     return if !$createLink;
1313
1314     unlink $sshglobalknownhosts;
1315     symlink $sshknownhosts, $sshglobalknownhosts;
1316
1317     warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
1318         if ! -l $sshglobalknownhosts;
1319
1320 }
1321
1322 my $migration_format = {
1323     type => {
1324         default_key => 1,
1325         type => 'string',
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',
1331     },
1332     network => {
1333         optional => 1,
1334         type => 'string', format => 'CIDR',
1335         format_description => 'CIDR',
1336         description => "CIDR of the (sub) network that is used for migration."
1337     },
1338 };
1339
1340 my $datacenter_schema = {
1341     type => "object",
1342     additionalProperties => 0,
1343     properties => {
1344         keyboard => {
1345             optional => 1,
1346             type => 'string',
1347             description => "Default keybord layout for vnc server.",
1348             enum => PVE::Tools::kvmkeymaplist(),
1349         },
1350         language => {
1351             optional => 1,
1352             type => 'string',
1353             description => "Default GUI language.",
1354             enum => [
1355                 'zh_CN',
1356                 'zh_TW',
1357                 'ca',
1358                 'en',
1359                 'eu',
1360                 'fr',
1361                 'de',
1362                 'it',
1363                 'es',
1364                 'ja',
1365                 'nb',
1366                 'nn',
1367                 'fa',
1368                 'pl',
1369                 'pt_BR',
1370                 'ru',
1371                 'sl',
1372                 'sv',
1373                 'tr',
1374             ],
1375         },
1376         http_proxy => {
1377             optional => 1,
1378             type => 'string',
1379             description => "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1380             pattern => "http://.*",
1381         },
1382         migration_unsecure => {
1383             optional => 1,
1384             type => 'boolean',
1385             description => "Migration is secure using SSH tunnel by default. " .
1386               "For secure private networks you can disable it to speed up " .
1387               "migration. Deprecated, use the 'migration' property instead!",
1388         },
1389         migration => {
1390             optional => 1,
1391             type => 'string', format => $migration_format,
1392             description => "For cluster wide migration settings.",
1393         },
1394         console => {
1395             optional => 1,
1396             type => 'string',
1397             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), an HTML5 based vnc viewer (noVNC), or an HTML5 based console client (xtermjs). If the selected viewer is not available (e.g. SPICE not activated for the VM), the fallback is noVNC.",
1398             enum => ['applet', 'vv', 'html5', 'xtermjs'],
1399         },
1400         email_from => {
1401             optional => 1,
1402             type => 'string',
1403             format => 'email-opt',
1404             description => "Specify email address to send notification from (default is root@\$hostname)",
1405         },
1406         max_workers => {
1407             optional => 1,
1408             type => 'integer',
1409             minimum => 1,
1410             description => "Defines how many workers (per node) are maximal started ".
1411               " on actions like 'stopall VMs' or task from the ha-manager.",
1412         },
1413         fencing => {
1414             optional => 1,
1415             type => 'string',
1416             default => 'watchdog',
1417             enum => [ 'watchdog', 'hardware', 'both' ],
1418             description => "Set the fencing mode of the HA cluster. Hardware mode " .
1419               "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
1420               " With both all two modes are used." .
1421               "\n\nWARNING: 'hardware' and 'both' are EXPERIMENTAL & WIP",
1422         },
1423         mac_prefix => {
1424             optional => 1,
1425             type => 'string',
1426             pattern => qr/[a-f0-9]{2}(?::[a-f0-9]{2}){0,2}:?/i,
1427             description => 'Prefix for autogenerated MAC addresses.',
1428         },
1429         bwlimit => PVE::JSONSchema::get_standard_option('bwlimit'),
1430     },
1431 };
1432
1433 # make schema accessible from outside (for documentation)
1434 sub get_datacenter_schema { return $datacenter_schema };
1435
1436 sub parse_datacenter_config {
1437     my ($filename, $raw) = @_;
1438
1439     my $res = PVE::JSONSchema::parse_config($datacenter_schema, $filename, $raw // '');
1440
1441     if (my $migration = $res->{migration}) {
1442         $res->{migration} = PVE::JSONSchema::parse_property_string($migration_format, $migration);
1443     }
1444
1445     # for backwards compatibility only, new migration property has precedence
1446     if (defined($res->{migration_unsecure})) {
1447         if (defined($res->{migration}->{type})) {
1448             warn "deprecated setting 'migration_unsecure' and new 'migration: type' " .
1449               "set at same time! Ignore 'migration_unsecure'\n";
1450         } else {
1451             $res->{migration}->{type} = ($res->{migration_unsecure}) ? 'insecure' : 'secure';
1452         }
1453     }
1454
1455     # for backwards compatibility only, applet maps to html5
1456     if (defined($res->{console}) && $res->{console} eq 'applet') {
1457         $res->{console} = 'html5';
1458     }
1459
1460     return $res;
1461 }
1462
1463 sub write_datacenter_config {
1464     my ($filename, $cfg) = @_;
1465
1466     # map deprecated setting to new one
1467     if (defined($cfg->{migration_unsecure}) && !defined($cfg->{migration})) {
1468         my $migration_unsecure = delete $cfg->{migration_unsecure};
1469         $cfg->{migration}->{type} = ($migration_unsecure) ? 'insecure' : 'secure';
1470     }
1471
1472     # map deprecated applet setting to html5
1473     if (defined($cfg->{console}) && $cfg->{console} eq 'applet') {
1474         $cfg->{console} = 'html5';
1475     }
1476
1477     if (my $migration = $cfg->{migration}) {
1478         $cfg->{migration} = PVE::JSONSchema::print_property_string($migration, $migration_format);
1479     }
1480
1481     return PVE::JSONSchema::dump_config($datacenter_schema, $filename, $cfg);
1482 }
1483
1484 cfs_register_file('datacenter.cfg',
1485                   \&parse_datacenter_config,
1486                   \&write_datacenter_config);
1487
1488 # X509 Certificate cache helper
1489
1490 my $cert_cache_nodes = {};
1491 my $cert_cache_timestamp = time();
1492 my $cert_cache_fingerprints = {};
1493
1494 sub update_cert_cache {
1495     my ($update_node, $clear) = @_;
1496
1497     syslog('info', "Clearing outdated entries from certificate cache")
1498         if $clear;
1499
1500     $cert_cache_timestamp = time() if !defined($update_node);
1501
1502     my $node_list = defined($update_node) ?
1503         [ $update_node ] : [ keys %$cert_cache_nodes ];
1504
1505     foreach my $node (@$node_list) {
1506         my $clear_old = sub {
1507             if (my $old_fp = $cert_cache_nodes->{$node}) {
1508                 # distrust old fingerprint
1509                 delete $cert_cache_fingerprints->{$old_fp};
1510                 # ensure reload on next proxied request
1511                 delete $cert_cache_nodes->{$node};
1512             }
1513         };
1514
1515         my $fp = eval { get_node_fingerprint($node) };
1516         if (my $err = $@) {
1517             warn "$err\n";
1518             &$clear_old() if $clear;
1519             next;
1520         }
1521
1522         my $old_fp = $cert_cache_nodes->{$node};
1523         $cert_cache_fingerprints->{$fp} = 1;
1524         $cert_cache_nodes->{$node} = $fp;
1525
1526         if (defined($old_fp) && $fp ne $old_fp) {
1527             delete $cert_cache_fingerprints->{$old_fp};
1528         }
1529     }
1530 }
1531
1532 # load and cache cert fingerprint once
1533 sub initialize_cert_cache {
1534     my ($node) = @_;
1535
1536     update_cert_cache($node)
1537         if defined($node) && !defined($cert_cache_nodes->{$node});
1538 }
1539
1540 sub read_ssl_cert_fingerprint {
1541     my ($cert_path) = @_;
1542
1543     my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
1544         or die "unable to read '$cert_path' - $!\n";
1545
1546     my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
1547     Net::SSLeay::BIO_free($bio);
1548
1549     die "unable to read certificate from '$cert_path'\n" if !$cert;
1550
1551     my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
1552     Net::SSLeay::X509_free($cert);
1553
1554     die "unable to get fingerprint for '$cert_path' - got empty value\n"
1555         if !defined($fp) || $fp eq '';
1556
1557     return $fp;
1558 }
1559
1560 sub get_node_fingerprint {
1561     my ($node) = @_;
1562
1563     my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
1564     my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
1565
1566     $cert_path = $custom_cert_path if -f $custom_cert_path;
1567
1568     return read_ssl_cert_fingerprint($cert_path);
1569 }
1570
1571
1572 sub check_cert_fingerprint {
1573     my ($cert) = @_;
1574
1575     # clear cache every 30 minutes at least
1576     update_cert_cache(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
1577
1578     # get fingerprint of server certificate
1579     my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
1580     return 0 if !defined($fp) || $fp eq ''; # error
1581
1582     my $check = sub {
1583         for my $expected (keys %$cert_cache_fingerprints) {
1584             return 1 if $fp eq $expected;
1585         }
1586         return 0;
1587     };
1588
1589     return 1 if &$check();
1590
1591     # clear cache and retry at most once every minute
1592     if (time() - $cert_cache_timestamp >= 60) {
1593         syslog ('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
1594         update_cert_cache();
1595         return &$check();
1596     }
1597
1598     return 0;
1599 }
1600
1601 # bash completion helpers
1602
1603 sub complete_next_vmid {
1604
1605     my $vmlist = get_vmlist() || {};
1606     my $idlist = $vmlist->{ids} || {};
1607
1608     for (my $i = 100; $i < 10000; $i++) {
1609         return [$i] if !defined($idlist->{$i});
1610     }
1611
1612     return [];
1613 }
1614
1615 sub complete_vmid {
1616
1617     my $vmlist = get_vmlist();
1618     my $ids = $vmlist->{ids} || {};
1619
1620     return [ keys %$ids ];
1621 }
1622
1623 sub complete_local_vmid {
1624
1625     my $vmlist = get_vmlist();
1626     my $ids = $vmlist->{ids} || {};
1627
1628     my $nodename = PVE::INotify::nodename();
1629
1630     my $res = [];
1631     foreach my $vmid (keys %$ids) {
1632         my $d = $ids->{$vmid};
1633         next if !$d->{node} || $d->{node} ne $nodename;
1634         push @$res, $vmid;
1635     }
1636
1637     return $res;
1638 }
1639
1640 sub complete_migration_target {
1641
1642     my $res = [];
1643
1644     my $nodename = PVE::INotify::nodename();
1645
1646     my $nodelist = get_nodelist();
1647     foreach my $node (@$nodelist) {
1648         next if $node eq $nodename;
1649         push @$res, $node;
1650     }
1651
1652     return $res;
1653 }
1654
1655 sub get_ssh_info {
1656     my ($node, $network_cidr) = @_;
1657
1658     my $ip;
1659     if (defined($network_cidr)) {
1660         # Use mtunnel via to get the remote node's ip inside $network_cidr.
1661         # This goes over the regular network (iow. uses get_ssh_info() with
1662         # $network_cidr undefined.
1663         # FIXME: Use the REST API client for this after creating an API entry
1664         # for get_migration_ip.
1665         my $default_remote = get_ssh_info($node, undef);
1666         my $default_ssh = ssh_info_to_command($default_remote);
1667         my $cmd =[@$default_ssh, 'pvecm', 'mtunnel',
1668             '-migration_network', $network_cidr,
1669             '-get_migration_ip'
1670         ];
1671         PVE::Tools::run_command($cmd, outfunc => sub {
1672             my ($line) = @_;
1673             chomp $line;
1674             die "internal error: unexpected output from mtunnel\n"
1675                 if defined($ip);
1676             if ($line =~ /^ip: '(.*)'$/) {
1677                 $ip = $1;
1678             } else {
1679                 die "internal error: bad output from mtunnel\n"
1680                     if defined($ip);
1681             }
1682         });
1683         die "failed to get ip for node '$node' in network '$network_cidr'\n"
1684             if !defined($ip);
1685     } else {
1686         $ip = remote_node_ip($node);
1687     }
1688
1689     return {
1690         ip => $ip,
1691         name => $node,
1692         network => $network_cidr,
1693     };
1694 }
1695
1696 sub ssh_info_to_command_base {
1697     my ($info, @extra_options) = @_;
1698     return [
1699         '/usr/bin/ssh',
1700         '-e', 'none',
1701         '-o', 'BatchMode=yes',
1702         '-o', 'HostKeyAlias='.$info->{name},
1703         @extra_options
1704     ];
1705 }
1706
1707 sub ssh_info_to_command {
1708     my ($info, @extra_options) = @_;
1709     my $cmd = ssh_info_to_command_base($info, @extra_options);
1710     push @$cmd, "root\@$info->{ip}";
1711     return $cmd;
1712 }
1713
1714 sub assert_joinable {
1715     my ($ring0_addr, $ring1_addr, $force) = @_;
1716
1717     my $errors = '';
1718     my $error = sub { $errors .= "* $_[0]\n"; };
1719
1720     if (-f $authfile) {
1721         $error->("authentication key '$authfile' already exists");
1722     }
1723
1724     if (-f $clusterconf)  {
1725         $error->("cluster config '$clusterconf' already exists");
1726     }
1727
1728     my $vmlist = get_vmlist();
1729     if ($vmlist && $vmlist->{ids} && scalar(keys %{$vmlist->{ids}})) {
1730         $error->("this host already contains virtual guests");
1731     }
1732
1733     if (run_command(['corosync-quorumtool', '-l'], noerr => 1, quiet => 1) == 0) {
1734         $error->("corosync is already running, is this node already in a cluster?!");
1735     }
1736
1737     # check if corosync ring IPs are configured on the current nodes interfaces
1738     my $check_ip = sub {
1739         my $ip = shift // return;
1740         if (!PVE::JSONSchema::pve_verify_ip($ip, 1)) {
1741             my $host = $ip;
1742             eval { $ip = PVE::Network::get_ip_from_hostname($host); };
1743             if ($@) {
1744                 $error->("cannot use '$host': $@\n") ;
1745                 return;
1746             }
1747         }
1748
1749         my $cidr = (Net::IP::ip_is_ipv6($ip)) ? "$ip/128" : "$ip/32";
1750         my $configured_ips = PVE::Network::get_local_ip_from_cidr($cidr);
1751
1752         $error->("cannot use IP '$ip', it must be configured exactly once on local node!\n")
1753             if (scalar(@$configured_ips) != 1);
1754     };
1755
1756     $check_ip->($ring0_addr);
1757     $check_ip->($ring1_addr);
1758
1759     if ($errors) {
1760         warn "detected the following error(s):\n$errors";
1761         die "Check if node may join a cluster failed!\n" if !$force;
1762     }
1763 }
1764
1765 # NOTE: filesystem must be offline here, no DB changes allowed
1766 my $backup_cfs_database = sub {
1767     my ($dbfile) = @_;
1768
1769     mkdir $dbbackupdir;
1770
1771     my $ctime = time();
1772     my $backup_fn = "$dbbackupdir/config-$ctime.sql.gz";
1773
1774     print "backup old database to '$backup_fn'\n";
1775
1776     my $cmd = [ ['sqlite3', $dbfile, '.dump'], ['gzip', '-', \ ">${backup_fn}"] ];
1777     run_command($cmd, 'errmsg' => "cannot backup old database\n");
1778
1779     my $maxfiles = 10; # purge older backup
1780     my $backups = [ sort { $b cmp $a } <$dbbackupdir/config-*.sql.gz> ];
1781
1782     if ((my $count = scalar(@$backups)) > $maxfiles) {
1783         foreach my $f (@$backups[$maxfiles..$count-1]) {
1784             next if $f !~ m/^(\S+)$/; # untaint
1785             print "delete old backup '$1'\n";
1786             unlink $1;
1787         }
1788     }
1789 };
1790
1791 sub join {
1792     my ($param) = @_;
1793
1794     my $nodename = PVE::INotify::nodename();
1795
1796     setup_sshd_config();
1797     setup_rootsshconfig();
1798     setup_ssh_keys();
1799
1800     # check if we can join with the given parameters and current node state
1801     my ($ring0_addr, $ring1_addr) = $param->@{'ring0_addr', 'ring1_addr'};
1802     assert_joinable($ring0_addr, $ring1_addr, $param->{force});
1803
1804     # make sure known_hosts is on local filesystem
1805     ssh_unmerge_known_hosts();
1806
1807     my $host = $param->{hostname};
1808     my $local_ip_address = remote_node_ip($nodename);
1809
1810     my $conn_args = {
1811         username => 'root@pam',
1812         password => $param->{password},
1813         cookie_name => 'PVEAuthCookie',
1814         protocol => 'https',
1815         host => $host,
1816         port => 8006,
1817     };
1818
1819     if (my $fp = $param->{fingerprint}) {
1820         $conn_args->{cached_fingerprints} = { uc($fp) => 1 };
1821     } else {
1822         # API schema ensures that we can only get here from CLI handler
1823         $conn_args->{manual_verification} = 1;
1824     }
1825
1826     print "Establishing API connection with host '$host'\n";
1827
1828     my $conn = PVE::APIClient::LWP->new(%$conn_args);
1829     $conn->login();
1830
1831     # login raises an exception on failure, so if we get here we're good
1832     print "Login succeeded.\n";
1833
1834     my $args = {};
1835     $args->{force} = $param->{force} if defined($param->{force});
1836     $args->{nodeid} = $param->{nodeid} if $param->{nodeid};
1837     $args->{votes} = $param->{votes} if defined($param->{votes});
1838     $args->{ring0_addr} = $ring0_addr // $local_ip_address;
1839     $args->{ring1_addr} = $ring1_addr if defined($ring1_addr);
1840
1841     print "Request addition of this node\n";
1842     my $res = $conn->post("/cluster/config/nodes/$nodename", $args);
1843
1844     print "Join request OK, finishing setup locally\n";
1845
1846     # added successfuly - now prepare local node
1847     finish_join($nodename, $res->{corosync_conf}, $res->{corosync_authkey});
1848 }
1849
1850 sub finish_join {
1851     my ($nodename, $corosync_conf, $corosync_authkey) = @_;
1852
1853     mkdir "$localclusterdir";
1854     PVE::Tools::file_set_contents($authfile, $corosync_authkey);
1855     PVE::Tools::file_set_contents($localclusterconf, $corosync_conf);
1856
1857     print "stopping pve-cluster service\n";
1858     my $cmd = ['systemctl', 'stop', 'pve-cluster'];
1859     run_command($cmd, errmsg => "can't stop pve-cluster service");
1860
1861     $backup_cfs_database->($dbfile);
1862     unlink $dbfile;
1863
1864     $cmd = ['systemctl', 'start', 'corosync', 'pve-cluster'];
1865     run_command($cmd, errmsg => "starting pve-cluster failed");
1866
1867     # wait for quorum
1868     my $printqmsg = 1;
1869     while (!check_cfs_quorum(1)) {
1870         if ($printqmsg) {
1871             print "waiting for quorum...";
1872             STDOUT->flush();
1873             $printqmsg = 0;
1874         }
1875         sleep(1);
1876     }
1877     print "OK\n" if !$printqmsg;
1878
1879     updatecerts_and_ssh(1);
1880
1881     print "generated new node certificate, restart pveproxy and pvedaemon services\n";
1882     run_command(['systemctl', 'reload-or-restart', 'pvedaemon', 'pveproxy']);
1883
1884     print "successfully added node '$nodename' to cluster.\n";
1885 }
1886
1887 sub updatecerts_and_ssh {
1888     my ($force_new_cert, $silent) = @_;
1889
1890     my $p = sub { print "$_[0]\n" if !$silent };
1891
1892     setup_rootsshconfig();
1893
1894     gen_pve_vzdump_symlink();
1895
1896     if (!check_cfs_quorum(1)) {
1897         return undef if $silent;
1898         die "no quorum - unable to update files\n";
1899     }
1900
1901     setup_ssh_keys();
1902
1903     my $nodename = PVE::INotify::nodename();
1904     my $local_ip_address = remote_node_ip($nodename);
1905
1906     $p->("(re)generate node files");
1907     $p->("generate new node certificate") if $force_new_cert;
1908     gen_pve_node_files($nodename, $local_ip_address, $force_new_cert);
1909
1910     $p->("merge authorized SSH keys and known hosts");
1911     ssh_merge_keys();
1912     ssh_merge_known_hosts($nodename, $local_ip_address, 1);
1913     gen_pve_vzdump_files();
1914 }
1915
1916 1;