data/PVE/Cluster.pm

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