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 JSON;
  21 use RRDs;
  22 use Encode;
  23 use UUID;
  24 use base 'Exporter';
  25
  26 our @EXPORT_OK = qw(
  27 cfs_read_file
  28 cfs_write_file
  29 cfs_register_file
  30 cfs_lock_file);
  31
  32 use Data::Dumper; # fixme: remove
  33
  34 # x509 certificate utils
  35
  36 my $basedir = "/etc/pve";
  37 my $authdir = "$basedir/priv";
  38 my $lockdir = "/etc/pve/priv/lock";
  39
  40 # cfs and corosync files
  41 my $dbfile = "/var/lib/pve-cluster/config.db";
  42 my $dbbackupdir = "/var/lib/pve-cluster/backup";
  43 my $localclusterdir = "/etc/corosync";
  44 my $localclusterconf = "$localclusterdir/corosync.conf";
  45 my $authfile = "$localclusterdir/authkey";
  46 my $clusterconf = "$basedir/corosync.conf";
  47
  48 my $authprivkeyfn = "$authdir/authkey.key";
  49 my $authpubkeyfn = "$basedir/authkey.pub";
  50 my $pveca_key_fn = "$authdir/pve-root-ca.key";
  51 my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
  52 my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
  53 # this is just a secret accessable by the web browser
  54 # and is used for CSRF prevention
  55 my $pvewww_key_fn = "$basedir/pve-www.key";
  56
  57 # ssh related files
  58 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
  59 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
  60 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
  61 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
  62 my $sshknownhosts = "/etc/pve/priv/known_hosts";
  63 my $sshauthkeys = "/etc/pve/priv/authorized_keys";
  64 my $sshd_config_fn = "/etc/ssh/sshd_config";
  65 my $rootsshauthkeys = "/root/.ssh/authorized_keys";
  66 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
  67 my $rootsshconfig = "/root/.ssh/config";
  68
  69 my $observed = {
  70     'vzdump.cron' => 1,
  71     'storage.cfg' => 1,
  72     'datacenter.cfg' => 1,
  73     'replication.cfg' => 1,
  74     'corosync.conf' => 1,
  75     'corosync.conf.new' => 1,
  76     'user.cfg' => 1,
  77     'domains.cfg' => 1,
  78     'priv/shadow.cfg' => 1,
  79     '/qemu-server/' => 1,
  80     '/openvz/' => 1,
  81     '/lxc/' => 1,
  82     'ha/crm_commands' => 1,
  83     'ha/manager_status' => 1,
  84     'ha/resources.cfg' => 1,
  85     'ha/groups.cfg' => 1,
  86     'ha/fence.cfg' => 1,
  87     'status.cfg' => 1,
  88 };
  89
  90 # only write output if something fails
  91 sub run_silent_cmd {
  92     my ($cmd) = @_;
  93
  94     my $outbuf = '';
  95
  96     my $record_output = sub {
  97         $outbuf .= shift;
  98         $outbuf .= "\n";
  99     };
 100
 101     eval {
 102         PVE::Tools::run_command($cmd, outfunc => $record_output,
 103                                 errfunc => $record_output);
 104     };
 105
 106     my $err = $@;
 107
 108     if ($err) {
 109         print STDERR $outbuf;
 110         die $err;
 111     }
 112 }
 113
 114 sub check_cfs_quorum {
 115     my ($noerr) = @_;
 116
 117     # note: -w filename always return 1 for root, so wee need
 118     # to use File::lstat here
 119     my $st = File::stat::lstat("$basedir/local");
 120     my $quorate = ($st && (($st->mode & 0200) != 0));
 121
 122     die "cluster not ready - no quorum?\n" if !$quorate && !$noerr;
 123
 124     return $quorate;
 125 }
 126
 127 sub check_cfs_is_mounted {
 128     my ($noerr) = @_;
 129
 130     my $res = -l "$basedir/local";
 131
 132     die "pve configuration filesystem not mounted\n"
 133         if !$res && !$noerr;
 134
 135     return $res;
 136 }
 137
 138 sub gen_local_dirs {
 139     my ($nodename) = @_;
 140
 141     check_cfs_is_mounted();
 142
 143     my @required_dirs = (
 144         "$basedir/priv",
 145         "$basedir/nodes",
 146         "$basedir/nodes/$nodename",
 147         "$basedir/nodes/$nodename/lxc",
 148         "$basedir/nodes/$nodename/qemu-server",
 149         "$basedir/nodes/$nodename/openvz",
 150         "$basedir/nodes/$nodename/priv");
 151
 152     foreach my $dir (@required_dirs) {
 153         if (! -d $dir) {
 154             mkdir($dir) || $! == EEXIST || die "unable to create directory '$dir' - $!\n";
 155         }
 156     }
 157 }
 158
 159 sub gen_auth_key {
 160
 161     return if -f "$authprivkeyfn";
 162
 163     check_cfs_is_mounted();
 164
 165     mkdir $authdir || $! == EEXIST || die "unable to create dir '$authdir' - $!\n";
 166
 167     run_silent_cmd(['openssl', 'genrsa', '-out', $authprivkeyfn, '2048']);
 168
 169     run_silent_cmd(['openssl', 'rsa', '-in', $authprivkeyfn, '-pubout', '-out', $authpubkeyfn]);
 170 }
 171
 172 sub gen_pveca_key {
 173
 174     return if -f $pveca_key_fn;
 175
 176     eval {
 177         run_silent_cmd(['openssl', 'genrsa', '-out', $pveca_key_fn, '4096']);
 178     };
 179
 180     die "unable to generate pve ca key:\n$@" if $@;
 181 }
 182
 183 sub gen_pveca_cert {
 184
 185     if (-f $pveca_key_fn && -f $pveca_cert_fn) {
 186         return 0;
 187     }
 188
 189     gen_pveca_key();
 190
 191     # we try to generate an unique 'subject' to avoid browser problems
 192     # (reused serial numbers, ..)
 193     my $uuid;
 194     UUID::generate($uuid);
 195     my $uuid_str;
 196     UUID::unparse($uuid, $uuid_str);
 197
 198     eval {
 199         # wrap openssl with faketime to prevent bug #904
 200         run_silent_cmd(['faketime', 'yesterday', 'openssl', 'req', '-batch',
 201                         '-days', '3650', '-new', '-x509', '-nodes', '-key',
 202                         $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
 203                         "/CN=Proxmox Virtual Environment/OU=$uuid_str/O=PVE Cluster Manager CA/"]);
 204     };
 205
 206     die "generating pve root certificate failed:\n$@" if $@;
 207
 208     return 1;
 209 }
 210
 211 sub gen_pve_ssl_key {
 212     my ($nodename) = @_;
 213
 214     die "no node name specified" if !$nodename;
 215
 216     my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
 217
 218     return if -f $pvessl_key_fn;
 219
 220     eval {
 221         run_silent_cmd(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
 222     };
 223
 224     die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
 225 }
 226
 227 sub gen_pve_www_key {
 228
 229     return if -f $pvewww_key_fn;
 230
 231     eval {
 232         run_silent_cmd(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
 233     };
 234
 235     die "unable to generate pve www key:\n$@" if $@;
 236 }
 237
 238 sub update_serial {
 239     my ($serial) = @_;
 240
 241     PVE::Tools::file_set_contents($pveca_srl_fn, $serial);
 242 }
 243
 244 sub gen_pve_ssl_cert {
 245     my ($force, $nodename, $ip) = @_;
 246
 247     die "no node name specified" if !$nodename;
 248     die "no IP specified" if !$ip;
 249
 250     my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
 251
 252     return if !$force && -f $pvessl_cert_fn;
 253
 254     my $names = "IP:127.0.0.1,IP:::1,DNS:localhost";
 255
 256     my $rc = PVE::INotify::read_file('resolvconf');
 257
 258     $names .= ",IP:$ip";
 259
 260     my $fqdn = $nodename;
 261
 262     $names .= ",DNS:$nodename";
 263
 264     if ($rc && $rc->{search}) {
 265         $fqdn = $nodename . "." . $rc->{search};
 266         $names .= ",DNS:$fqdn";
 267     }
 268
 269     my $sslconf = <<__EOD;
 270 RANDFILE = /root/.rnd
 271 extensions = v3_req
 272
 273 [ req ]
 274 default_bits = 2048
 275 distinguished_name = req_distinguished_name
 276 req_extensions = v3_req
 277 prompt = no
 278 string_mask = nombstr
 279
 280 [ req_distinguished_name ]
 281 organizationalUnitName = PVE Cluster Node
 282 organizationName = Proxmox Virtual Environment
 283 commonName = $fqdn
 284
 285 [ v3_req ]
 286 basicConstraints = CA:FALSE
 287 extendedKeyUsage = serverAuth
 288 subjectAltName = $names
 289 __EOD
 290
 291     my $cfgfn = "/tmp/pvesslconf-$$.tmp";
 292     my $fh = IO::File->new ($cfgfn, "w");
 293     print $fh $sslconf;
 294     close ($fh);
 295
 296     my $reqfn = "/tmp/pvecertreq-$$.tmp";
 297     unlink $reqfn;
 298
 299     my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
 300     eval {
 301         run_silent_cmd(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
 302                         '-key', $pvessl_key_fn, '-out', $reqfn]);
 303     };
 304
 305     if (my $err = $@) {
 306         unlink $reqfn;
 307         unlink $cfgfn;
 308         die "unable to generate pve certificate request:\n$err";
 309     }
 310
 311     update_serial("0000000000000000") if ! -f $pveca_srl_fn;
 312
 313     eval {
 314         # wrap openssl with faketime to prevent bug #904
 315         run_silent_cmd(['faketime', 'yesterday', 'openssl', 'x509', '-req',
 316                         '-in', $reqfn, '-days', '3650', '-out', $pvessl_cert_fn,
 317                         '-CAkey', $pveca_key_fn, '-CA', $pveca_cert_fn,
 318                         '-CAserial', $pveca_srl_fn, '-extfile', $cfgfn]);
 319     };
 320
 321     if (my $err = $@) {
 322         unlink $reqfn;
 323         unlink $cfgfn;
 324         die "unable to generate pve ssl certificate:\n$err";
 325     }
 326
 327     unlink $cfgfn;
 328     unlink $reqfn;
 329 }
 330
 331 sub gen_pve_node_files {
 332     my ($nodename, $ip, $opt_force) = @_;
 333
 334     gen_local_dirs($nodename);
 335
 336     gen_auth_key();
 337
 338     # make sure we have a (cluster wide) secret
 339     # for CSRFR prevention
 340     gen_pve_www_key();
 341
 342     # make sure we have a (per node) private key
 343     gen_pve_ssl_key($nodename);
 344
 345     # make sure we have a CA
 346     my $force = gen_pveca_cert();
 347
 348     $force = 1 if $opt_force;
 349
 350     gen_pve_ssl_cert($force, $nodename, $ip);
 351 }
 352
 353 my $vzdump_cron_dummy = <<__EOD;
 354 # cluster wide vzdump cron schedule
 355 # Atomatically generated file - do not edit
 356
 357 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
 358
 359 __EOD
 360
 361 sub gen_pve_vzdump_symlink {
 362
 363     my $filename = "/etc/pve/vzdump.cron";
 364
 365     my $link_fn = "/etc/cron.d/vzdump";
 366
 367     if ((-f $filename) && (! -l $link_fn)) {
 368         rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
 369         symlink($filename, $link_fn);
 370     }
 371 }
 372
 373 sub gen_pve_vzdump_files {
 374
 375     my $filename = "/etc/pve/vzdump.cron";
 376
 377     PVE::Tools::file_set_contents($filename, $vzdump_cron_dummy)
 378         if ! -f $filename;
 379
 380     gen_pve_vzdump_symlink();
 381 };
 382
 383 my $versions = {};
 384 my $vmlist = {};
 385 my $clinfo = {};
 386
 387 my $ipcc_send_rec = sub {
 388     my ($msgid, $data) = @_;
 389
 390     my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
 391
 392     die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
 393
 394     return $res;
 395 };
 396
 397 my $ipcc_send_rec_json = sub {
 398     my ($msgid, $data) = @_;
 399
 400     my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
 401
 402     die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0);
 403
 404     return decode_json($res);
 405 };
 406
 407 my $ipcc_get_config = sub {
 408     my ($path) = @_;
 409
 410     my $bindata = pack "Z*", $path;
 411     my $res = PVE::IPCC::ipcc_send_rec(6, $bindata);
 412     if (!defined($res)) {
 413         if ($! != 0) {
 414             return undef if $! == ENOENT;
 415             die "$!\n";
 416         }
 417         return '';
 418     }
 419
 420     return $res;
 421 };
 422
 423 my $ipcc_get_status = sub {
 424     my ($name, $nodename) = @_;
 425
 426     my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
 427     return PVE::IPCC::ipcc_send_rec(5, $bindata);
 428 };
 429
 430 my $ipcc_update_status = sub {
 431     my ($name, $data) = @_;
 432
 433     my $raw = ref($data) ? encode_json($data) : $data;
 434     # update status
 435     my $bindata = pack "Z[256]Z*", $name, $raw;
 436
 437     return &$ipcc_send_rec(4, $bindata);
 438 };
 439
 440 my $ipcc_log = sub {
 441     my ($priority, $ident, $tag, $msg) = @_;
 442
 443     my $bindata = pack "CCCZ*Z*Z*", $priority, bytes::length($ident) + 1,
 444     bytes::length($tag) + 1, $ident, $tag, $msg;
 445
 446     return &$ipcc_send_rec(7, $bindata);
 447 };
 448
 449 my $ipcc_get_cluster_log = sub {
 450     my ($user, $max) = @_;
 451
 452     $max = 0 if !defined($max);
 453
 454     my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
 455     return &$ipcc_send_rec(8, $bindata);
 456 };
 457
 458 my $ccache = {};
 459
 460 sub cfs_update {
 461     my ($fail) = @_;
 462     eval {
 463         my $res = &$ipcc_send_rec_json(1);
 464         #warn "GOT1: " . Dumper($res);
 465         die "no starttime\n" if !$res->{starttime};
 466
 467         if (!$res->{starttime} || !$versions->{starttime} ||
 468             $res->{starttime} != $versions->{starttime}) {
 469             #print "detected changed starttime\n";
 470             $vmlist = {};
 471             $clinfo = {};
 472             $ccache = {};
 473         }
 474
 475         $versions = $res;
 476     };
 477     my $err = $@;
 478     if ($err) {
 479         $versions = {};
 480         $vmlist = {};
 481         $clinfo = {};
 482         $ccache = {};
 483         die $err if $fail;
 484         warn $err;
 485     }
 486
 487     eval {
 488         if (!$clinfo->{version} || $clinfo->{version} != $versions->{clinfo}) {
 489             #warn "detected new clinfo\n";
 490             $clinfo = &$ipcc_send_rec_json(2);
 491         }
 492     };
 493     $err = $@;
 494     if ($err) {
 495         $clinfo = {};
 496         die $err if $fail;
 497         warn $err;
 498     }
 499
 500     eval {
 501         if (!$vmlist->{version} || $vmlist->{version} != $versions->{vmlist}) {
 502             #warn "detected new vmlist1\n";
 503             $vmlist = &$ipcc_send_rec_json(3);
 504         }
 505     };
 506     $err = $@;
 507     if ($err) {
 508         $vmlist = {};
 509         die $err if $fail;
 510         warn $err;
 511     }
 512 }
 513
 514 sub get_vmlist {
 515     return $vmlist;
 516 }
 517
 518 sub get_clinfo {
 519     return $clinfo;
 520 }
 521
 522 sub get_members {
 523     return $clinfo->{nodelist};
 524 }
 525
 526 sub get_nodelist {
 527
 528     my $nodelist = $clinfo->{nodelist};
 529
 530     my $result = [];
 531
 532     my $nodename = PVE::INotify::nodename();
 533
 534     if (!$nodelist || !$nodelist->{$nodename}) {
 535         return [ $nodename ];
 536     }
 537
 538     return [ keys %$nodelist ];
 539 }
 540
 541 # $data must be a chronological descending ordered array of tasks
 542 sub broadcast_tasklist {
 543     my ($data) = @_;
 544
 545     # the serialized list may not get bigger than 32kb (CFS_MAX_STATUS_SIZE
 546     # from pmxcfs) - drop older items until we satisfy this constraint
 547     my $size = length(encode_json($data));
 548     while ($size >= (32 * 1024)) {
 549         pop @$data;
 550         $size = length(encode_json($data));
 551     }
 552
 553     eval {
 554         &$ipcc_update_status("tasklist", $data);
 555     };
 556
 557     warn $@ if $@;
 558 }
 559
 560 my $tasklistcache = {};
 561
 562 sub get_tasklist {
 563     my ($nodename) = @_;
 564
 565     my $kvstore = $versions->{kvstore} || {};
 566
 567     my $nodelist = get_nodelist();
 568
 569     my $res = [];
 570     foreach my $node (@$nodelist) {
 571         next if $nodename && ($nodename ne $node);
 572         eval {
 573             my $ver = $kvstore->{$node}->{tasklist} if $kvstore->{$node};
 574             my $cd = $tasklistcache->{$node};
 575             if (!$cd || !$ver || !$cd->{version} ||
 576                 ($cd->{version} != $ver)) {
 577                 my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
 578                 my $data = decode_json($raw);
 579                 push @$res, @$data;
 580                 $cd = $tasklistcache->{$node} = {
 581                     data => $data,
 582                     version => $ver,
 583                 };
 584             } elsif ($cd && $cd->{data}) {
 585                 push @$res, @{$cd->{data}};
 586             }
 587         };
 588         my $err = $@;
 589         syslog('err', $err) if $err;
 590     }
 591
 592     return $res;
 593 }
 594
 595 sub broadcast_rrd {
 596     my ($rrdid, $data) = @_;
 597
 598     eval {
 599         &$ipcc_update_status("rrd/$rrdid", $data);
 600     };
 601     my $err = $@;
 602
 603     warn $err if $err;
 604 }
 605
 606 my $last_rrd_dump = 0;
 607 my $last_rrd_data = "";
 608
 609 sub rrd_dump {
 610
 611     my $ctime = time();
 612
 613     my $diff = $ctime - $last_rrd_dump;
 614     if ($diff < 2) {
 615         return $last_rrd_data;
 616     }
 617
 618     my $raw;
 619     eval {
 620         $raw = &$ipcc_send_rec(10);
 621     };
 622     my $err = $@;
 623
 624     if ($err) {
 625         warn $err;
 626         return {};
 627     }
 628
 629     my $res = {};
 630
 631     if ($raw) {
 632         while ($raw =~ s/^(.*)\n//) {
 633             my ($key, @ela) = split(/:/, $1);
 634             next if !$key;
 635             next if !(scalar(@ela) > 1);
 636             $res->{$key} = [ map { $_ eq 'U' ? undef : $_ } @ela ];
 637         }
 638     }
 639
 640     $last_rrd_dump = $ctime;
 641     $last_rrd_data = $res;
 642
 643     return $res;
 644 }
 645
 646 sub create_rrd_data {
 647     my ($rrdname, $timeframe, $cf) = @_;
 648
 649     my $rrddir = "/var/lib/rrdcached/db";
 650
 651     my $rrd = "$rrddir/$rrdname";
 652
 653     my $setup = {
 654         hour =>  [ 60, 70 ],
 655         day  =>  [ 60*30, 70 ],
 656         week =>  [ 60*180, 70 ],
 657         month => [ 60*720, 70 ],
 658         year =>  [ 60*10080, 70 ],
 659     };
 660
 661     my ($reso, $count) = @{$setup->{$timeframe}};
 662     my $ctime  = $reso*int(time()/$reso);
 663     my $req_start = $ctime - $reso*$count;
 664
 665     $cf = "AVERAGE" if !$cf;
 666
 667     my @args = (
 668         "-s" => $req_start,
 669         "-e" => $ctime - 1,
 670         "-r" => $reso,
 671         );
 672
 673     my $socket = "/var/run/rrdcached.sock";
 674     push @args, "--daemon" => "unix:$socket" if -S $socket;
 675
 676     my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);
 677
 678     my $err = RRDs::error;
 679     die "RRD error: $err\n" if $err;
 680
 681     die "got wrong time resolution ($step != $reso)\n"
 682         if $step != $reso;
 683
 684     my $res = [];
 685     my $fields = scalar(@$names);
 686     for my $line (@$data) {
 687         my $entry = { 'time' => $start };
 688         $start += $step;
 689         for (my $i = 0; $i < $fields; $i++) {
 690             my $name = $names->[$i];
 691             if (defined(my $val = $line->[$i])) {
 692                 $entry->{$name} = $val;
 693             } else {
 694                 # leave empty fields undefined
 695                 # maybe make this configurable?
 696             }
 697         }
 698         push @$res, $entry;
 699     }
 700
 701     return $res;
 702 }
 703
 704 sub create_rrd_graph {
 705     my ($rrdname, $timeframe, $ds, $cf) = @_;
 706
 707     # Using RRD graph is clumsy - maybe it
 708     # is better to simply fetch the data, and do all display
 709     # related things with javascript (new extjs html5 graph library).
 710
 711     my $rrddir = "/var/lib/rrdcached/db";
 712
 713     my $rrd = "$rrddir/$rrdname";
 714
 715     my @ids = PVE::Tools::split_list($ds);
 716
 717     my $ds_txt = join('_', @ids);
 718
 719     my $filename = "${rrd}_${ds_txt}.png";
 720
 721     my $setup = {
 722         hour =>  [ 60, 60 ],
 723         day  =>  [ 60*30, 70 ],
 724         week =>  [ 60*180, 70 ],
 725         month => [ 60*720, 70 ],
 726         year =>  [ 60*10080, 70 ],
 727     };
 728
 729     my ($reso, $count) = @{$setup->{$timeframe}};
 730
 731     my @args = (
 732         "--imgformat" => "PNG",
 733         "--border" => 0,
 734         "--height" => 200,
 735         "--width" => 800,
 736         "--start" => - $reso*$count,
 737         "--end" => 'now' ,
 738         "--lower-limit" => 0,
 739         );
 740
 741     my $socket = "/var/run/rrdcached.sock";
 742     push @args, "--daemon" => "unix:$socket" if -S $socket;
 743
 744     my @coldef = ('#00ddff', '#ff0000');
 745
 746     $cf = "AVERAGE" if !$cf;
 747
 748     my $i = 0;
 749     foreach my $id (@ids) {
 750         my $col = $coldef[$i++] || die "fixme: no color definition";
 751         push @args, "DEF:${id}=$rrd:${id}:$cf";
 752         my $dataid = $id;
 753         if ($id eq 'cpu' || $id eq 'iowait') {
 754             push @args, "CDEF:${id}_per=${id},100,*";
 755             $dataid = "${id}_per";
 756         }
 757         push @args, "LINE2:${dataid}${col}:${id}";
 758     }
 759
 760     push @args, '--full-size-mode';
 761
 762     # we do not really store data into the file
 763     my $res = RRDs::graphv('-', @args);
 764
 765     my $err = RRDs::error;
 766     die "RRD error: $err\n" if $err;
 767
 768     return { filename => $filename, image => $res->{image} };
 769 }
 770
 771 # a fast way to read files (avoid fuse overhead)
 772 sub get_config {
 773     my ($path) = @_;
 774
 775     return &$ipcc_get_config($path);
 776 }
 777
 778 sub get_cluster_log {
 779     my ($user, $max) = @_;
 780
 781     return &$ipcc_get_cluster_log($user, $max);
 782 }
 783
 784 my $file_info = {};
 785
 786 sub cfs_register_file {
 787     my ($filename, $parser, $writer) = @_;
 788
 789     $observed->{$filename} || die "unknown file '$filename'";
 790
 791     die "file '$filename' already registered" if $file_info->{$filename};
 792
 793     $file_info->{$filename} = {
 794         parser => $parser,
 795         writer => $writer,
 796     };
 797 }
 798
 799 my $ccache_read = sub {
 800     my ($filename, $parser, $version) = @_;
 801
 802     $ccache->{$filename} = {} if !$ccache->{$filename};
 803
 804     my $ci = $ccache->{$filename};
 805
 806     if (!$ci->{version} || !$version || $ci->{version} != $version) {
 807         # we always call the parser, even when the file does not exists
 808         # (in that case $data is undef)
 809         my $data = get_config($filename);
 810         $ci->{data} = &$parser("/etc/pve/$filename", $data);
 811         $ci->{version} = $version;
 812     }
 813
 814     my $res = ref($ci->{data}) ? dclone($ci->{data}) : $ci->{data};
 815
 816     return $res;
 817 };
 818
 819 sub cfs_file_version {
 820     my ($filename) = @_;
 821
 822     my $version;
 823     my $infotag;
 824     if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) {
 825         my ($type, $vmid) = ($1, $2);
 826         if ($vmlist && $vmlist->{ids} && $vmlist->{ids}->{$vmid}) {
 827             $version = $vmlist->{ids}->{$vmid}->{version};
 828         }
 829         $infotag = "/$type/";
 830     } else {
 831         $infotag = $filename;
 832         $version = $versions->{$filename};
 833     }
 834
 835     my $info = $file_info->{$infotag} ||
 836         die "unknown file type '$filename'\n";
 837
 838     return wantarray ? ($version, $info) : $version;
 839 }
 840
 841 sub cfs_read_file {
 842     my ($filename) = @_;
 843
 844     my ($version, $info) = cfs_file_version($filename);
 845     my $parser = $info->{parser};
 846
 847     return &$ccache_read($filename, $parser, $version);
 848 }
 849
 850 sub cfs_write_file {
 851     my ($filename, $data) = @_;
 852
 853     my ($version, $info) = cfs_file_version($filename);
 854
 855     my $writer = $info->{writer} || die "no writer defined";
 856
 857     my $fsname = "/etc/pve/$filename";
 858
 859     my $raw = &$writer($fsname, $data);
 860
 861     if (my $ci = $ccache->{$filename}) {
 862         $ci->{version} = undef;
 863     }
 864
 865     PVE::Tools::file_set_contents($fsname, $raw);
 866 }
 867
 868 my $cfs_lock = sub {
 869     my ($lockid, $timeout, $code, @param) = @_;
 870
 871     my $prev_alarm = alarm(0); # suspend outer alarm early
 872
 873     my $res;
 874     my $got_lock = 0;
 875
 876     # this timeout is for aquire the lock
 877     $timeout = 10 if !$timeout;
 878
 879     my $filename = "$lockdir/$lockid";
 880
 881     eval {
 882
 883         mkdir $lockdir;
 884
 885         if (! -d $lockdir) {
 886             die "pve cluster filesystem not online.\n";
 887         }
 888
 889         my $timeout_err = sub { die "got lock request timeout\n"; };
 890         local $SIG{ALRM} = $timeout_err;
 891
 892         while (1) {
 893             alarm ($timeout);
 894             $got_lock = mkdir($filename);
 895             $timeout = alarm(0) - 1; # we'll sleep for 1s, see down below
 896
 897             last if $got_lock;
 898
 899             $timeout_err->() if $timeout <= 0;
 900
 901             print STDERR "trying to aquire cfs lock '$lockid' ...\n";
 902             utime (0, 0, $filename); # cfs unlock request
 903             sleep(1);
 904         }
 905
 906         # fixed command timeout: cfs locks have a timeout of 120
 907         # using 60 gives us another 60 seconds to abort the task
 908         local $SIG{ALRM} = sub { die "got lock timeout - aborting command\n"; };
 909         alarm(60);
 910
 911         cfs_update(); # make sure we read latest versions inside code()
 912
 913         $res = &$code(@param);
 914
 915         alarm(0);
 916     };
 917
 918     my $err = $@;
 919
 920     $err = "no quorum!\n" if !$got_lock && !check_cfs_quorum(1);
 921
 922     rmdir $filename if $got_lock; # if we held the lock always unlock again
 923
 924     alarm($prev_alarm);
 925
 926     if ($err) {
 927         $@ = "error with cfs lock '$lockid': $err";
 928         return undef;
 929     }
 930
 931     $@ = undef;
 932
 933     return $res;
 934 };
 935
 936 sub cfs_lock_file {
 937     my ($filename, $timeout, $code, @param) = @_;
 938
 939     my $info = $observed->{$filename} || die "unknown file '$filename'";
 940
 941     my $lockid = "file-$filename";
 942     $lockid =~ s/[.\/]/_/g;
 943
 944     &$cfs_lock($lockid, $timeout, $code, @param);
 945 }
 946
 947 sub cfs_lock_storage {
 948     my ($storeid, $timeout, $code, @param) = @_;
 949
 950     my $lockid = "storage-$storeid";
 951
 952     &$cfs_lock($lockid, $timeout, $code, @param);
 953 }
 954
 955 sub cfs_lock_domain {
 956     my ($domainname, $timeout, $code, @param) = @_;
 957
 958     my $lockid = "domain-$domainname";
 959
 960     &$cfs_lock($lockid, $timeout, $code, @param);
 961 }
 962
 963 sub cfs_lock_acme {
 964     my ($account, $timeout, $code, @param) = @_;
 965
 966     my $lockid = "acme-$account";
 967
 968     &$cfs_lock($lockid, $timeout, $code, @param);
 969 }
 970
 971 my $log_levels = {
 972     "emerg" => 0,
 973     "alert" => 1,
 974     "crit" => 2,
 975     "critical" => 2,
 976     "err" => 3,
 977     "error" => 3,
 978     "warn" => 4,
 979     "warning" => 4,
 980     "notice" => 5,
 981     "info" => 6,
 982     "debug" => 7,
 983 };
 984
 985 sub log_msg {
 986    my ($priority, $ident, $msg) = @_;
 987
 988    if (my $tmp = $log_levels->{$priority}) {
 989        $priority = $tmp;
 990    }
 991
 992    die "need numeric log priority" if $priority !~ /^\d+$/;
 993
 994    my $tag = PVE::SafeSyslog::tag();
 995
 996    $msg = "empty message" if !$msg;
 997
 998    $ident = "" if !$ident;
 999    $ident = encode("ascii", $ident,
1000                    sub { sprintf "\\u%04x", shift });
1001
1002    my $ascii = encode("ascii", $msg, sub { sprintf "\\u%04x", shift });
1003
1004    if ($ident) {
1005        syslog($priority, "<%s> %s", $ident, $ascii);
1006    } else {
1007        syslog($priority, "%s", $ascii);
1008    }
1009
1010    eval { &$ipcc_log($priority, $ident, $tag, $ascii); };
1011
1012    syslog("err", "writing cluster log failed: $@") if $@;
1013 }
1014
1015 sub check_vmid_unused {
1016     my ($vmid, $noerr) = @_;
1017
1018     my $vmlist = get_vmlist();
1019
1020     my $d = $vmlist->{ids}->{$vmid};
1021     return 1 if !defined($d);
1022
1023     return undef if $noerr;
1024
1025     my $vmtypestr =  $d->{type} eq 'qemu' ? 'VM' : 'CT';
1026     die "$vmtypestr $vmid already exists on node '$d->{node}'\n";
1027 }
1028
1029 sub check_node_exists {
1030     my ($nodename, $noerr) = @_;
1031
1032     my $nodelist = $clinfo->{nodelist};
1033     return 1 if $nodelist && $nodelist->{$nodename};
1034
1035     return undef if $noerr;
1036
1037     die "no such cluster node '$nodename'\n";
1038 }
1039
1040 # this is also used to get the IP of the local node
1041 sub remote_node_ip {
1042     my ($nodename, $noerr) = @_;
1043
1044     my $nodelist = $clinfo->{nodelist};
1045     if ($nodelist && $nodelist->{$nodename}) {
1046         if (my $ip = $nodelist->{$nodename}->{ip}) {
1047             return $ip if !wantarray;
1048             my $family = $nodelist->{$nodename}->{address_family};
1049             if (!$family) {
1050                 $nodelist->{$nodename}->{address_family} =
1051                     $family =
1052                     PVE::Tools::get_host_address_family($ip);
1053             }
1054             return wantarray ? ($ip, $family) : $ip;
1055         }
1056     }
1057
1058     # fallback: try to get IP by other means
1059     return PVE::Network::get_ip_from_hostname($nodename, $noerr);
1060 }
1061
1062 sub get_local_migration_ip {
1063     my ($migration_network, $noerr) = @_;
1064
1065     my $cidr = $migration_network;
1066
1067     if (!defined($cidr)) {
1068         my $dc_conf = cfs_read_file('datacenter.cfg');
1069         $cidr = $dc_conf->{migration}->{network}
1070           if defined($dc_conf->{migration}->{network});
1071     }
1072
1073     if (defined($cidr)) {
1074         my $ips = PVE::Network::get_local_ip_from_cidr($cidr);
1075
1076         die "could not get migration ip: no IP address configured on local " .
1077             "node for network '$cidr'\n" if !$noerr && (scalar(@$ips) == 0);
1078
1079         die "could not get migration ip: multiple IP address configured for " .
1080             "network '$cidr'\n" if !$noerr && (scalar(@$ips) > 1);
1081
1082         return @$ips[0];
1083     }
1084
1085     return undef;
1086 };
1087
1088 # ssh related utility functions
1089
1090 sub ssh_merge_keys {
1091     # remove duplicate keys in $sshauthkeys
1092     # ssh-copy-id simply add keys, so the file can grow to large
1093
1094     my $data = '';
1095     if (-f $sshauthkeys) {
1096         $data = PVE::Tools::file_get_contents($sshauthkeys, 128*1024);
1097         chomp($data);
1098     }
1099
1100     my $found_backup;
1101     if (-f $rootsshauthkeysbackup) {
1102         $data .= "\n";
1103         $data .= PVE::Tools::file_get_contents($rootsshauthkeysbackup, 128*1024);
1104         chomp($data);
1105         $found_backup = 1;
1106     }
1107
1108     # always add ourself
1109     if (-f $ssh_rsa_id) {
1110         my $pub = PVE::Tools::file_get_contents($ssh_rsa_id);
1111         chomp($pub);
1112         $data .= "\n$pub\n";
1113     }
1114
1115     my $newdata = "";
1116     my $vhash = {};
1117     my @lines = split(/\n/, $data);
1118     foreach my $line (@lines) {
1119         if ($line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/) {
1120             next if $vhash->{$3}++;
1121         }
1122         $newdata .= "$line\n";
1123     }
1124
1125     PVE::Tools::file_set_contents($sshauthkeys, $newdata, 0600);
1126
1127     if ($found_backup && -l $rootsshauthkeys) {
1128         # everything went well, so we can remove the backup
1129         unlink $rootsshauthkeysbackup;
1130     }
1131 }
1132
1133 sub setup_sshd_config {
1134     my () = @_;
1135
1136     my $conf = PVE::Tools::file_get_contents($sshd_config_fn);
1137
1138     return if $conf =~ m/^PermitRootLogin\s+yes\s*$/m;
1139
1140     if ($conf !~ s/^#?PermitRootLogin.*$/PermitRootLogin yes/m) {
1141         chomp $conf;
1142         $conf .= "\nPermitRootLogin yes\n";
1143     }
1144
1145     PVE::Tools::file_set_contents($sshd_config_fn, $conf);
1146
1147     PVE::Tools::run_command(['systemctl', 'reload-or-restart', 'sshd']);
1148 }
1149
1150 sub setup_rootsshconfig {
1151
1152     # create ssh key if it does not exist
1153     if (! -f $ssh_rsa_id) {
1154         mkdir '/root/.ssh/';
1155         system ("echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}");
1156     }
1157
1158     # create ssh config if it does not exist
1159     if (! -f $rootsshconfig) {
1160         mkdir '/root/.ssh';
1161         if (my $fh = IO::File->new($rootsshconfig, O_CREAT|O_WRONLY|O_EXCL, 0640)) {
1162             # this is the default ciphers list from Debian's OpenSSH package (OpenSSH_7.4p1 Debian-10, OpenSSL 1.0.2k  26 Jan 2017)
1163             # changed order to put AES before Chacha20 (most hardware has AESNI)
1164             print $fh "Ciphers aes128-ctr,aes192-ctr,aes256-ctr,aes128-gcm\@openssh.com,aes256-gcm\@openssh.com,chacha20-poly1305\@openssh.com\n";
1165             close($fh);
1166         }
1167     }
1168 }
1169
1170 sub setup_ssh_keys {
1171
1172     mkdir $authdir;
1173
1174     my $import_ok;
1175
1176     if (! -f $sshauthkeys) {
1177         my $old;
1178         if (-f $rootsshauthkeys) {
1179             $old = PVE::Tools::file_get_contents($rootsshauthkeys, 128*1024);
1180         }
1181         if (my $fh = IO::File->new ($sshauthkeys, O_CREAT|O_WRONLY|O_EXCL, 0400)) {
1182             PVE::Tools::safe_print($sshauthkeys, $fh, $old) if $old;
1183             close($fh);
1184             $import_ok = 1;
1185         }
1186     }
1187
1188     warn "can't create shared ssh key database '$sshauthkeys'\n"
1189         if ! -f $sshauthkeys;
1190
1191     if (-f $rootsshauthkeys && ! -l $rootsshauthkeys) {
1192         if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
1193             warn "rename $rootsshauthkeys failed - $!\n";
1194         }
1195     }
1196
1197     if (! -l $rootsshauthkeys) {
1198         symlink $sshauthkeys, $rootsshauthkeys;
1199     }
1200
1201     if (! -l $rootsshauthkeys) {
1202         warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
1203     } else {
1204         unlink $rootsshauthkeysbackup if $import_ok;
1205     }
1206 }
1207
1208 sub ssh_unmerge_known_hosts {
1209     return if ! -l $sshglobalknownhosts;
1210
1211     my $old = '';
1212     $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024)
1213         if -f $sshknownhosts;
1214
1215     PVE::Tools::file_set_contents($sshglobalknownhosts, $old);
1216 }
1217
1218 sub ssh_merge_known_hosts {
1219     my ($nodename, $ip_address, $createLink) = @_;
1220
1221     die "no node name specified" if !$nodename;
1222     die "no ip address specified" if !$ip_address;
1223
1224     # ssh lowercases hostnames (aliases) before comparision, so we need too
1225     $nodename = lc($nodename);
1226     $ip_address = lc($ip_address);
1227
1228     mkdir $authdir;
1229
1230     if (! -f $sshknownhosts) {
1231         if (my $fh = IO::File->new($sshknownhosts, O_CREAT|O_WRONLY|O_EXCL, 0600)) {
1232             close($fh);
1233         }
1234     }
1235
1236     my $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024);
1237
1238     my $new = '';
1239
1240     if ((! -l $sshglobalknownhosts) && (-f $sshglobalknownhosts)) {
1241         $new = PVE::Tools::file_get_contents($sshglobalknownhosts, 128*1024);
1242     }
1243
1244     my $hostkey = PVE::Tools::file_get_contents($ssh_host_rsa_id);
1245     # Note: file sometimes containe emty lines at start, so we use multiline match
1246     die "can't parse $ssh_host_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/m;
1247     $hostkey = $1;
1248
1249     my $data = '';
1250     my $vhash = {};
1251
1252     my $found_nodename;
1253     my $found_local_ip;
1254
1255     my $merge_line = sub {
1256         my ($line, $all) = @_;
1257
1258         return if $line =~ m/^\s*$/; # skip empty lines
1259         return if $line =~ m/^#/; # skip comments
1260
1261         if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
1262             my $key = $1;
1263             my $rsakey = $2;
1264             if (!$vhash->{$key}) {
1265                 $vhash->{$key} = 1;
1266                 if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
1267                     my $salt = decode_base64($1);
1268                     my $digest = $2;
1269                     my $hmac = Digest::HMAC_SHA1->new($salt);
1270                     $hmac->add($nodename);
1271                     my $hd = $hmac->b64digest . '=';
1272                     if ($digest eq $hd) {
1273                         if ($rsakey eq $hostkey) {
1274                             $found_nodename = 1;
1275                             $data .= $line;
1276                         }
1277                         return;
1278                     }
1279                     $hmac = Digest::HMAC_SHA1->new($salt);
1280                     $hmac->add($ip_address);
1281                     $hd = $hmac->b64digest . '=';
1282                     if ($digest eq $hd) {
1283                         if ($rsakey eq $hostkey) {
1284                             $found_local_ip = 1;
1285                             $data .= $line;
1286                         }
1287                         return;
1288                     }
1289                 } else {
1290                     $key = lc($key); # avoid duplicate entries, ssh compares lowercased
1291                     if ($key eq $ip_address) {
1292                         $found_local_ip = 1 if $rsakey eq $hostkey;
1293                     } elsif ($key eq $nodename) {
1294                         $found_nodename = 1 if $rsakey eq $hostkey;
1295                     }
1296                 }
1297                 $data .= $line;
1298             }
1299         } elsif ($all) {
1300             $data .= $line;
1301         }
1302     };
1303
1304     while ($old && $old =~ s/^((.*?)(\n|$))//) {
1305         my $line = "$2\n";
1306         &$merge_line($line, 1);
1307     }
1308
1309     while ($new && $new =~ s/^((.*?)(\n|$))//) {
1310         my $line = "$2\n";
1311         &$merge_line($line);
1312     }
1313
1314     # add our own key if not already there
1315     $data .= "$nodename $hostkey\n" if !$found_nodename;
1316     $data .= "$ip_address $hostkey\n" if !$found_local_ip;
1317
1318     PVE::Tools::file_set_contents($sshknownhosts, $data);
1319
1320     return if !$createLink;
1321
1322     unlink $sshglobalknownhosts;
1323     symlink $sshknownhosts, $sshglobalknownhosts;
1324
1325     warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
1326         if ! -l $sshglobalknownhosts;
1327
1328 }
1329
1330 my $migration_format = {
1331     type => {
1332         default_key => 1,
1333         type => 'string',
1334         enum => ['secure', 'insecure'],
1335         description => "Migration traffic is encrypted using an SSH tunnel by " .
1336           "default. On secure, completely private networks this can be " .
1337           "disabled to increase performance.",
1338         default => 'secure',
1339     },
1340     network => {
1341         optional => 1,
1342         type => 'string', format => 'CIDR',
1343         format_description => 'CIDR',
1344         description => "CIDR of the (sub) network that is used for migration."
1345     },
1346 };
1347
1348 my $datacenter_schema = {
1349     type => "object",
1350     additionalProperties => 0,
1351     properties => {
1352         keyboard => {
1353             optional => 1,
1354             type => 'string',
1355             description => "Default keybord layout for vnc server.",
1356             enum => PVE::Tools::kvmkeymaplist(),
1357         },
1358         language => {
1359             optional => 1,
1360             type => 'string',
1361             description => "Default GUI language.",
1362             enum => [ 'en', 'de' ],
1363         },
1364         http_proxy => {
1365             optional => 1,
1366             type => 'string',
1367             description => "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1368             pattern => "http://.*",
1369         },
1370         migration_unsecure => {
1371             optional => 1,
1372             type => 'boolean',
1373             description => "Migration is secure using SSH tunnel by default. " .
1374               "For secure private networks you can disable it to speed up " .
1375               "migration. Deprecated, use the 'migration' property instead!",
1376         },
1377         migration => {
1378             optional => 1,
1379             type => 'string', format => $migration_format,
1380             description => "For cluster wide migration settings.",
1381         },
1382         console => {
1383             optional => 1,
1384             type => 'string',
1385             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.",
1386             enum => ['applet', 'vv', 'html5', 'xtermjs'],
1387         },
1388         email_from => {
1389             optional => 1,
1390             type => 'string',
1391             format => 'email-opt',
1392             description => "Specify email address to send notification from (default is root@\$hostname)",
1393         },
1394         max_workers => {
1395             optional => 1,
1396             type => 'integer',
1397             minimum => 1,
1398             description => "Defines how many workers (per node) are maximal started ".
1399               " on actions like 'stopall VMs' or task from the ha-manager.",
1400         },
1401         fencing => {
1402             optional => 1,
1403             type => 'string',
1404             default => 'watchdog',
1405             enum => [ 'watchdog', 'hardware', 'both' ],
1406             description => "Set the fencing mode of the HA cluster. Hardware mode " .
1407               "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
1408               " With both all two modes are used." .
1409               "\n\nWARNING: 'hardware' and 'both' are EXPERIMENTAL & WIP",
1410         },
1411         mac_prefix => {
1412             optional => 1,
1413             type => 'string',
1414             pattern => qr/[a-f0-9]{2}(?::[a-f0-9]{2}){0,2}:?/i,
1415             description => 'Prefix for autogenerated MAC addresses.',
1416         },
1417         bwlimit => PVE::JSONSchema::get_standard_option('bwlimit'),
1418     },
1419 };
1420
1421 # make schema accessible from outside (for documentation)
1422 sub get_datacenter_schema { return $datacenter_schema };
1423
1424 sub parse_datacenter_config {
1425     my ($filename, $raw) = @_;
1426
1427     my $res = PVE::JSONSchema::parse_config($datacenter_schema, $filename, $raw // '');
1428
1429     if (my $migration = $res->{migration}) {
1430         $res->{migration} = PVE::JSONSchema::parse_property_string($migration_format, $migration);
1431     }
1432
1433     # for backwards compatibility only, new migration property has precedence
1434     if (defined($res->{migration_unsecure})) {
1435         if (defined($res->{migration}->{type})) {
1436             warn "deprecated setting 'migration_unsecure' and new 'migration: type' " .
1437               "set at same time! Ignore 'migration_unsecure'\n";
1438         } else {
1439             $res->{migration}->{type} = ($res->{migration_unsecure}) ? 'insecure' : 'secure';
1440         }
1441     }
1442
1443     # for backwards compatibility only, applet maps to html5
1444     if (defined($res->{console}) && $res->{console} eq 'applet') {
1445         $res->{console} = 'html5';
1446     }
1447
1448     return $res;
1449 }
1450
1451 sub write_datacenter_config {
1452     my ($filename, $cfg) = @_;
1453
1454     # map deprecated setting to new one
1455     if (defined($cfg->{migration_unsecure}) && !defined($cfg->{migration})) {
1456         my $migration_unsecure = delete $cfg->{migration_unsecure};
1457         $cfg->{migration}->{type} = ($migration_unsecure) ? 'insecure' : 'secure';
1458     }
1459
1460     # map deprecated applet setting to html5
1461     if (defined($cfg->{console}) && $cfg->{console} eq 'applet') {
1462         $cfg->{console} = 'html5';
1463     }
1464
1465     if (my $migration = $cfg->{migration}) {
1466         $cfg->{migration} = PVE::JSONSchema::print_property_string($migration, $migration_format);
1467     }
1468
1469     return PVE::JSONSchema::dump_config($datacenter_schema, $filename, $cfg);
1470 }
1471
1472 cfs_register_file('datacenter.cfg',
1473                   \&parse_datacenter_config,
1474                   \&write_datacenter_config);
1475
1476 # X509 Certificate cache helper
1477
1478 my $cert_cache_nodes = {};
1479 my $cert_cache_timestamp = time();
1480 my $cert_cache_fingerprints = {};
1481
1482 sub update_cert_cache {
1483     my ($update_node, $clear) = @_;
1484
1485     syslog('info', "Clearing outdated entries from certificate cache")
1486         if $clear;
1487
1488     $cert_cache_timestamp = time() if !defined($update_node);
1489
1490     my $node_list = defined($update_node) ?
1491         [ $update_node ] : [ keys %$cert_cache_nodes ];
1492
1493     foreach my $node (@$node_list) {
1494         my $clear_old = sub {
1495             if (my $old_fp = $cert_cache_nodes->{$node}) {
1496                 # distrust old fingerprint
1497                 delete $cert_cache_fingerprints->{$old_fp};
1498                 # ensure reload on next proxied request
1499                 delete $cert_cache_nodes->{$node};
1500             }
1501         };
1502
1503         my $fp = eval { get_node_fingerprint($node) };
1504         if (my $err = $@) {
1505             warn "$err\n";
1506             &$clear_old() if $clear;
1507             next;
1508         }
1509
1510         my $old_fp = $cert_cache_nodes->{$node};
1511         $cert_cache_fingerprints->{$fp} = 1;
1512         $cert_cache_nodes->{$node} = $fp;
1513
1514         if (defined($old_fp) && $fp ne $old_fp) {
1515             delete $cert_cache_fingerprints->{$old_fp};
1516         }
1517     }
1518 }
1519
1520 # load and cache cert fingerprint once
1521 sub initialize_cert_cache {
1522     my ($node) = @_;
1523
1524     update_cert_cache($node)
1525         if defined($node) && !defined($cert_cache_nodes->{$node});
1526 }
1527
1528 sub read_ssl_cert_fingerprint {
1529     my ($cert_path) = @_;
1530
1531     my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
1532         or die "unable to read '$cert_path' - $!\n";
1533
1534     my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
1535     if (!$cert) {
1536         Net::SSLeay::BIO_free($bio);
1537         die "unable to read certificate from '$cert_path'\n";
1538     }
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;