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