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