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