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 PVE::JSONSchema::register_format('mac-prefix', \&pve_verify_mac_prefix);
1352 sub pve_verify_mac_prefix {
1353     my ($mac_prefix, $noerr) = @_;
1354
1355     if ($mac_prefix !~ m/^[a-f0-9][02468ace](?::[a-f0-9]{2}){0,2}:?$/i) {
1356         return undef if $noerr;
1357         die "value is not a valid unicast MAC address prefix\n";
1358     }
1359     return $mac_prefix;
1360 }
1361
1362 my $datacenter_schema = {
1363     type => "object",
1364     additionalProperties => 0,
1365     properties => {
1366         keyboard => {
1367             optional => 1,
1368             type => 'string',
1369             description => "Default keybord layout for vnc server.",
1370             enum => PVE::Tools::kvmkeymaplist(),
1371         },
1372         language => {
1373             optional => 1,
1374             type => 'string',
1375             description => "Default GUI language.",
1376             enum => [
1377                 'zh_CN',
1378                 'zh_TW',
1379                 'ca',
1380                 'en',
1381                 'eu',
1382                 'fr',
1383                 'de',
1384                 'it',
1385                 'es',
1386                 'ja',
1387                 'nb',
1388                 'nn',
1389                 'fa',
1390                 'pl',
1391                 'pt_BR',
1392                 'ru',
1393                 'sl',
1394                 'sv',
1395                 'tr',
1396             ],
1397         },
1398         http_proxy => {
1399             optional => 1,
1400             type => 'string',
1401             description => "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1402             pattern => "http://.*",
1403         },
1404         migration_unsecure => {
1405             optional => 1,
1406             type => 'boolean',
1407             description => "Migration is secure using SSH tunnel by default. " .
1408               "For secure private networks you can disable it to speed up " .
1409               "migration. Deprecated, use the 'migration' property instead!",
1410         },
1411         migration => {
1412             optional => 1,
1413             type => 'string', format => $migration_format,
1414             description => "For cluster wide migration settings.",
1415         },
1416         console => {
1417             optional => 1,
1418             type => 'string',
1419             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.",
1420             enum => ['applet', 'vv', 'html5', 'xtermjs'],
1421         },
1422         email_from => {
1423             optional => 1,
1424             type => 'string',
1425             format => 'email-opt',
1426             description => "Specify email address to send notification from (default is root@\$hostname)",
1427         },
1428         max_workers => {
1429             optional => 1,
1430             type => 'integer',
1431             minimum => 1,
1432             description => "Defines how many workers (per node) are maximal started ".
1433               " on actions like 'stopall VMs' or task from the ha-manager.",
1434         },
1435         fencing => {
1436             optional => 1,
1437             type => 'string',
1438             default => 'watchdog',
1439             enum => [ 'watchdog', 'hardware', 'both' ],
1440             description => "Set the fencing mode of the HA cluster. Hardware mode " .
1441               "needs a valid configuration of fence devices in /etc/pve/ha/fence.cfg." .
1442               " With both all two modes are used." .
1443               "\n\nWARNING: 'hardware' and 'both' are EXPERIMENTAL & WIP",
1444         },
1445         ha => {
1446             optional => 1,
1447             type => 'string', format => $ha_format,
1448             description => "Cluster wide HA settings.",
1449         },
1450         mac_prefix => {
1451             optional => 1,
1452             type => 'string',
1453             format => 'mac-prefix',
1454             description => 'Prefix for autogenerated MAC addresses.',
1455         },
1456         bwlimit => PVE::JSONSchema::get_standard_option('bwlimit'),
1457     },
1458 };
1459
1460 # make schema accessible from outside (for documentation)
1461 sub get_datacenter_schema { return $datacenter_schema };
1462
1463 sub parse_datacenter_config {
1464     my ($filename, $raw) = @_;
1465
1466     my $res = PVE::JSONSchema::parse_config($datacenter_schema, $filename, $raw // '');
1467
1468     if (my $migration = $res->{migration}) {
1469         $res->{migration} = PVE::JSONSchema::parse_property_string($migration_format, $migration);
1470     }
1471
1472     if (my $ha = $res->{ha}) {
1473         $res->{ha} = PVE::JSONSchema::parse_property_string($ha_format, $ha);
1474     }
1475
1476     # for backwards compatibility only, new migration property has precedence
1477     if (defined($res->{migration_unsecure})) {
1478         if (defined($res->{migration}->{type})) {
1479             warn "deprecated setting 'migration_unsecure' and new 'migration: type' " .
1480               "set at same time! Ignore 'migration_unsecure'\n";
1481         } else {
1482             $res->{migration}->{type} = ($res->{migration_unsecure}) ? 'insecure' : 'secure';
1483         }
1484     }
1485
1486     # for backwards compatibility only, applet maps to html5
1487     if (defined($res->{console}) && $res->{console} eq 'applet') {
1488         $res->{console} = 'html5';
1489     }
1490
1491     return $res;
1492 }
1493
1494 sub write_datacenter_config {
1495     my ($filename, $cfg) = @_;
1496
1497     # map deprecated setting to new one
1498     if (defined($cfg->{migration_unsecure}) && !defined($cfg->{migration})) {
1499         my $migration_unsecure = delete $cfg->{migration_unsecure};
1500         $cfg->{migration}->{type} = ($migration_unsecure) ? 'insecure' : 'secure';
1501     }
1502
1503     # map deprecated applet setting to html5
1504     if (defined($cfg->{console}) && $cfg->{console} eq 'applet') {
1505         $cfg->{console} = 'html5';
1506     }
1507
1508     if (my $migration = $cfg->{migration}) {
1509         $cfg->{migration} = PVE::JSONSchema::print_property_string($migration, $migration_format);
1510     }
1511
1512     if (my $ha = $cfg->{ha}) {
1513         $cfg->{ha} = PVE::JSONSchema::print_property_string($ha, $ha_format);
1514     }
1515
1516     return PVE::JSONSchema::dump_config($datacenter_schema, $filename, $cfg);
1517 }
1518
1519 cfs_register_file('datacenter.cfg',
1520                   \&parse_datacenter_config,
1521                   \&write_datacenter_config);
1522
1523 # X509 Certificate cache helper
1524
1525 my $cert_cache_nodes = {};
1526 my $cert_cache_timestamp = time();
1527 my $cert_cache_fingerprints = {};
1528
1529 sub update_cert_cache {
1530     my ($update_node, $clear) = @_;
1531
1532     syslog('info', "Clearing outdated entries from certificate cache")
1533         if $clear;
1534
1535     $cert_cache_timestamp = time() if !defined($update_node);
1536
1537     my $node_list = defined($update_node) ?
1538         [ $update_node ] : [ keys %$cert_cache_nodes ];
1539
1540     foreach my $node (@$node_list) {
1541         my $clear_old = sub {
1542             if (my $old_fp = $cert_cache_nodes->{$node}) {
1543                 # distrust old fingerprint
1544                 delete $cert_cache_fingerprints->{$old_fp};
1545                 # ensure reload on next proxied request
1546                 delete $cert_cache_nodes->{$node};
1547             }
1548         };
1549
1550         my $fp = eval { get_node_fingerprint($node) };
1551         if (my $err = $@) {
1552             warn "$err\n";
1553             &$clear_old() if $clear;
1554             next;
1555         }
1556
1557         my $old_fp = $cert_cache_nodes->{$node};
1558         $cert_cache_fingerprints->{$fp} = 1;
1559         $cert_cache_nodes->{$node} = $fp;
1560
1561         if (defined($old_fp) && $fp ne $old_fp) {
1562             delete $cert_cache_fingerprints->{$old_fp};
1563         }
1564     }
1565 }
1566
1567 # load and cache cert fingerprint once
1568 sub initialize_cert_cache {
1569     my ($node) = @_;
1570
1571     update_cert_cache($node)
1572         if defined($node) && !defined($cert_cache_nodes->{$node});
1573 }
1574
1575 sub read_ssl_cert_fingerprint {
1576     my ($cert_path) = @_;
1577
1578     my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
1579         or die "unable to read '$cert_path' - $!\n";
1580
1581     my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
1582     Net::SSLeay::BIO_free($bio);
1583
1584     die "unable to read certificate from '$cert_path'\n" if !$cert;
1585
1586     my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
1587     Net::SSLeay::X509_free($cert);
1588
1589     die "unable to get fingerprint for '$cert_path' - got empty value\n"
1590         if !defined($fp) || $fp eq '';
1591
1592     return $fp;
1593 }
1594
1595 sub get_node_fingerprint {
1596     my ($node) = @_;
1597
1598     my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
1599     my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
1600
1601     $cert_path = $custom_cert_path if -f $custom_cert_path;
1602
1603     return read_ssl_cert_fingerprint($cert_path);
1604 }
1605
1606
1607 sub check_cert_fingerprint {
1608     my ($cert) = @_;
1609
1610     # clear cache every 30 minutes at least
1611     update_cert_cache(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
1612
1613     # get fingerprint of server certificate
1614     my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
1615     return 0 if !defined($fp) || $fp eq ''; # error
1616
1617     my $check = sub {
1618         for my $expected (keys %$cert_cache_fingerprints) {
1619             return 1 if $fp eq $expected;
1620         }
1621         return 0;
1622     };
1623
1624     return 1 if &$check();
1625
1626     # clear cache and retry at most once every minute
1627     if (time() - $cert_cache_timestamp >= 60) {
1628         syslog ('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
1629         update_cert_cache();
1630         return &$check();
1631     }
1632
1633     return 0;
1634 }
1635
1636 # bash completion helpers
1637
1638 sub complete_next_vmid {
1639
1640     my $vmlist = get_vmlist() || {};
1641     my $idlist = $vmlist->{ids} || {};
1642
1643     for (my $i = 100; $i < 10000; $i++) {
1644         return [$i] if !defined($idlist->{$i});
1645     }
1646
1647     return [];
1648 }
1649
1650 sub complete_vmid {
1651
1652     my $vmlist = get_vmlist();
1653     my $ids = $vmlist->{ids} || {};
1654
1655     return [ keys %$ids ];
1656 }
1657
1658 sub complete_local_vmid {
1659
1660     my $vmlist = get_vmlist();
1661     my $ids = $vmlist->{ids} || {};
1662
1663     my $nodename = PVE::INotify::nodename();
1664
1665     my $res = [];
1666     foreach my $vmid (keys %$ids) {
1667         my $d = $ids->{$vmid};
1668         next if !$d->{node} || $d->{node} ne $nodename;
1669         push @$res, $vmid;
1670     }
1671
1672     return $res;
1673 }
1674
1675 sub complete_migration_target {
1676
1677     my $res = [];
1678
1679     my $nodename = PVE::INotify::nodename();
1680
1681     my $nodelist = get_nodelist();
1682     foreach my $node (@$nodelist) {
1683         next if $node eq $nodename;
1684         push @$res, $node;
1685     }
1686
1687     return $res;
1688 }
1689
1690 sub get_ssh_info {
1691     my ($node, $network_cidr) = @_;
1692
1693     my $ip;
1694     if (defined($network_cidr)) {
1695         # Use mtunnel via to get the remote node's ip inside $network_cidr.
1696         # This goes over the regular network (iow. uses get_ssh_info() with
1697         # $network_cidr undefined.
1698         # FIXME: Use the REST API client for this after creating an API entry
1699         # for get_migration_ip.
1700         my $default_remote = get_ssh_info($node, undef);
1701         my $default_ssh = ssh_info_to_command($default_remote);
1702         my $cmd =[@$default_ssh, 'pvecm', 'mtunnel',
1703             '-migration_network', $network_cidr,
1704             '-get_migration_ip'
1705         ];
1706         PVE::Tools::run_command($cmd, outfunc => sub {
1707             my ($line) = @_;
1708             chomp $line;
1709             die "internal error: unexpected output from mtunnel\n"
1710                 if defined($ip);
1711             if ($line =~ /^ip: '(.*)'$/) {
1712                 $ip = $1;
1713             } else {
1714                 die "internal error: bad output from mtunnel\n"
1715                     if defined($ip);
1716             }
1717         });
1718         die "failed to get ip for node '$node' in network '$network_cidr'\n"
1719             if !defined($ip);
1720     } else {
1721         $ip = remote_node_ip($node);
1722     }
1723
1724     return {
1725         ip => $ip,
1726         name => $node,
1727         network => $network_cidr,
1728     };
1729 }
1730
1731 sub ssh_info_to_command_base {
1732     my ($info, @extra_options) = @_;
1733     return [
1734         '/usr/bin/ssh',
1735         '-e', 'none',
1736         '-o', 'BatchMode=yes',
1737         '-o', 'HostKeyAlias='.$info->{name},
1738         @extra_options
1739     ];
1740 }
1741
1742 sub ssh_info_to_command {
1743     my ($info, @extra_options) = @_;
1744     my $cmd = ssh_info_to_command_base($info, @extra_options);
1745     push @$cmd, "root\@$info->{ip}";
1746     return $cmd;
1747 }
1748
1749 sub assert_joinable {
1750     my ($ring0_addr, $ring1_addr, $force) = @_;
1751
1752     my $errors = '';
1753     my $error = sub { $errors .= "* $_[0]\n"; };
1754
1755     if (-f $authfile) {
1756         $error->("authentication key '$authfile' already exists");
1757     }
1758
1759     if (-f $clusterconf)  {
1760         $error->("cluster config '$clusterconf' already exists");
1761     }
1762
1763     my $vmlist = get_vmlist();
1764     if ($vmlist && $vmlist->{ids} && scalar(keys %{$vmlist->{ids}})) {
1765         $error->("this host already contains virtual guests");
1766     }
1767
1768     if (run_command(['corosync-quorumtool', '-l'], noerr => 1, quiet => 1) == 0) {
1769         $error->("corosync is already running, is this node already in a cluster?!");
1770     }
1771
1772     # check if corosync ring IPs are configured on the current nodes interfaces
1773     my $check_ip = sub {
1774         my $ip = shift // return;
1775         if (!PVE::JSONSchema::pve_verify_ip($ip, 1)) {
1776             my $host = $ip;
1777             eval { $ip = PVE::Network::get_ip_from_hostname($host); };
1778             if ($@) {
1779                 $error->("cannot use '$host': $@\n") ;
1780                 return;
1781             }
1782         }
1783
1784         my $cidr = (Net::IP::ip_is_ipv6($ip)) ? "$ip/128" : "$ip/32";
1785         my $configured_ips = PVE::Network::get_local_ip_from_cidr($cidr);
1786
1787         $error->("cannot use IP '$ip', it must be configured exactly once on local node!\n")
1788             if (scalar(@$configured_ips) != 1);
1789     };
1790
1791     $check_ip->($ring0_addr);
1792     $check_ip->($ring1_addr);
1793
1794     if ($errors) {
1795         warn "detected the following error(s):\n$errors";
1796         die "Check if node may join a cluster failed!\n" if !$force;
1797     }
1798 }
1799
1800 # NOTE: filesystem must be offline here, no DB changes allowed
1801 my $backup_cfs_database = sub {
1802     my ($dbfile) = @_;
1803
1804     mkdir $dbbackupdir;
1805
1806     my $ctime = time();
1807     my $backup_fn = "$dbbackupdir/config-$ctime.sql.gz";
1808
1809     print "backup old database to '$backup_fn'\n";
1810
1811     my $cmd = [ ['sqlite3', $dbfile, '.dump'], ['gzip', '-', \ ">${backup_fn}"] ];
1812     run_command($cmd, 'errmsg' => "cannot backup old database\n");
1813
1814     my $maxfiles = 10; # purge older backup
1815     my $backups = [ sort { $b cmp $a } <$dbbackupdir/config-*.sql.gz> ];
1816
1817     if ((my $count = scalar(@$backups)) > $maxfiles) {
1818         foreach my $f (@$backups[$maxfiles..$count-1]) {
1819             next if $f !~ m/^(\S+)$/; # untaint
1820             print "delete old backup '$1'\n";
1821             unlink $1;
1822         }
1823     }
1824 };
1825
1826 sub join {
1827     my ($param) = @_;
1828
1829     my $nodename = PVE::INotify::nodename();
1830
1831     setup_sshd_config();
1832     setup_rootsshconfig();
1833     setup_ssh_keys();
1834
1835     # check if we can join with the given parameters and current node state
1836     my ($ring0_addr, $ring1_addr) = $param->@{'ring0_addr', 'ring1_addr'};
1837     assert_joinable($ring0_addr, $ring1_addr, $param->{force});
1838
1839     # make sure known_hosts is on local filesystem
1840     ssh_unmerge_known_hosts();
1841
1842     my $host = $param->{hostname};
1843     my $local_ip_address = remote_node_ip($nodename);
1844
1845     my $conn_args = {
1846         username => 'root@pam',
1847         password => $param->{password},
1848         cookie_name => 'PVEAuthCookie',
1849         protocol => 'https',
1850         host => $host,
1851         port => 8006,
1852     };
1853
1854     if (my $fp = $param->{fingerprint}) {
1855         $conn_args->{cached_fingerprints} = { uc($fp) => 1 };
1856     } else {
1857         # API schema ensures that we can only get here from CLI handler
1858         $conn_args->{manual_verification} = 1;
1859     }
1860
1861     print "Establishing API connection with host '$host'\n";
1862
1863     my $conn = PVE::APIClient::LWP->new(%$conn_args);
1864     $conn->login();
1865
1866     # login raises an exception on failure, so if we get here we're good
1867     print "Login succeeded.\n";
1868
1869     my $args = {};
1870     $args->{force} = $param->{force} if defined($param->{force});
1871     $args->{nodeid} = $param->{nodeid} if $param->{nodeid};
1872     $args->{votes} = $param->{votes} if defined($param->{votes});
1873     $args->{ring0_addr} = $ring0_addr // $local_ip_address;
1874     $args->{ring1_addr} = $ring1_addr if defined($ring1_addr);
1875
1876     print "Request addition of this node\n";
1877     my $res = $conn->post("/cluster/config/nodes/$nodename", $args);
1878
1879     print "Join request OK, finishing setup locally\n";
1880
1881     # added successfuly - now prepare local node
1882     finish_join($nodename, $res->{corosync_conf}, $res->{corosync_authkey});
1883 }
1884
1885 sub finish_join {
1886     my ($nodename, $corosync_conf, $corosync_authkey) = @_;
1887
1888     mkdir "$localclusterdir";
1889     PVE::Tools::file_set_contents($authfile, $corosync_authkey);
1890     PVE::Tools::file_set_contents($localclusterconf, $corosync_conf);
1891
1892     print "stopping pve-cluster service\n";
1893     my $cmd = ['systemctl', 'stop', 'pve-cluster'];
1894     run_command($cmd, errmsg => "can't stop pve-cluster service");
1895
1896     $backup_cfs_database->($dbfile);
1897     unlink $dbfile;
1898
1899     $cmd = ['systemctl', 'start', 'corosync', 'pve-cluster'];
1900     run_command($cmd, errmsg => "starting pve-cluster failed");
1901
1902     # wait for quorum
1903     my $printqmsg = 1;
1904     while (!check_cfs_quorum(1)) {
1905         if ($printqmsg) {
1906             print "waiting for quorum...";
1907             STDOUT->flush();
1908             $printqmsg = 0;
1909         }
1910         sleep(1);
1911     }
1912     print "OK\n" if !$printqmsg;
1913
1914     updatecerts_and_ssh(1);
1915
1916     print "generated new node certificate, restart pveproxy and pvedaemon services\n";
1917     run_command(['systemctl', 'reload-or-restart', 'pvedaemon', 'pveproxy']);
1918
1919     print "successfully added node '$nodename' to cluster.\n";
1920 }
1921
1922 sub updatecerts_and_ssh {
1923     my ($force_new_cert, $silent) = @_;
1924
1925     my $p = sub { print "$_[0]\n" if !$silent };
1926
1927     setup_rootsshconfig();
1928
1929     gen_pve_vzdump_symlink();
1930
1931     if (!check_cfs_quorum(1)) {
1932         return undef if $silent;
1933         die "no quorum - unable to update files\n";
1934     }
1935
1936     setup_ssh_keys();
1937
1938     my $nodename = PVE::INotify::nodename();
1939     my $local_ip_address = remote_node_ip($nodename);
1940
1941     $p->("(re)generate node files");
1942     $p->("generate new node certificate") if $force_new_cert;
1943     gen_pve_node_files($nodename, $local_ip_address, $force_new_cert);
1944
1945     $p->("merge authorized SSH keys and known hosts");
1946     ssh_merge_keys();
1947     ssh_merge_known_hosts($nodename, $local_ip_address, 1);
1948     gen_pve_vzdump_files();
1949 }
1950
1951 1;