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 XML::Parser;
  12 use Digest::SHA;
  13 use Digest::HMAC_SHA1;
  14 use PVE::Tools;
  15 use PVE::INotify;
  16 use PVE::IPCC;
  17 use PVE::SafeSyslog;
  18 use PVE::JSONSchema;
  19 use JSON;
  20 use RRDs;
  21 use Encode;
  22 use base 'Exporter';
  23
  24 our @EXPORT_OK = qw(
  25 cfs_read_file
  26 cfs_write_file
  27 cfs_register_file
  28 cfs_lock_file);
  29
  30 use Data::Dumper; # fixme: remove
  31
  32 # x509 certificate utils
  33
  34 my $basedir = "/etc/pve";
  35 my $authdir = "$basedir/priv";
  36 my $lockdir = "/etc/pve/priv/lock";
  37
  38 my $authprivkeyfn = "$authdir/authkey.key";
  39 my $authpubkeyfn = "$basedir/authkey.pub";
  40 my $pveca_key_fn = "$authdir/pve-root-ca.key";
  41 my $pveca_srl_fn = "$authdir/pve-root-ca.srl";
  42 my $pveca_cert_fn = "$basedir/pve-root-ca.pem";
  43 # this is just a secret accessable by the web browser
  44 # and is used for CSRF prevention
  45 my $pvewww_key_fn = "$basedir/pve-www.key";
  46
  47 # ssh related files
  48 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa";
  49 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub";
  50 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub";
  51 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts";
  52 my $sshknownhosts = "/etc/pve/priv/known_hosts";
  53 my $sshauthkeys = "/etc/pve/priv/authorized_keys";
  54 my $rootsshauthkeys = "/root/.ssh/authorized_keys";
  55 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org";
  56 my $rootsshconfig = "/root/.ssh/config";
  57
  58 my $observed = {
  59     'vzdump.cron' => 1,
  60     'storage.cfg' => 1,
  61     'datacenter.cfg' => 1,
  62     'corosync.conf' => 1,
  63     'corosync.conf.new' => 1,
  64     'user.cfg' => 1,
  65     'domains.cfg' => 1,
  66     'priv/shadow.cfg' => 1,
  67     '/qemu-server/' => 1,
  68     '/openvz/' => 1,
  69     '/lxc/' => 1,
  70     'ha/crm_commands' => 1,
  71     'ha/manager_status' => 1,
  72     'ha/resources.cfg' => 1,
  73     'ha/groups.cfg' => 1,
  74 };
  75
  76 # only write output if something fails
  77 sub run_silent_cmd {
  78     my ($cmd) = @_;
  79
  80     my $outbuf = '';
  81
  82     my $record_output = sub {
  83         $outbuf .= shift;
  84         $outbuf .= "\n";
  85     };
  86
  87     eval {
  88         PVE::Tools::run_command($cmd, outfunc => $record_output,
  89                                 errfunc => $record_output);
  90     };
  91
  92     my $err = $@;
  93
  94     if ($err) {
  95         print STDERR $outbuf;
  96         die $err;
  97     }
  98 }
  99
 100 sub check_cfs_quorum {
 101     my ($noerr) = @_;
 102
 103     # note: -w filename always return 1 for root, so wee need
 104     # to use File::lstat here
 105     my $st = File::stat::lstat("$basedir/local");
 106     my $quorate = ($st && (($st->mode & 0200) != 0));
 107
 108     die "cluster not ready - no quorum?\n" if !$quorate && !$noerr;
 109
 110     return $quorate;
 111 }
 112
 113 sub check_cfs_is_mounted {
 114     my ($noerr) = @_;
 115
 116     my $res = -l "$basedir/local";
 117
 118     die "pve configuration filesystem not mounted\n"
 119         if !$res && !$noerr;
 120
 121     return $res;
 122 }
 123
 124 sub gen_local_dirs {
 125     my ($nodename) = @_;
 126
 127     check_cfs_is_mounted();
 128
 129     my @required_dirs = (
 130         "$basedir/priv",
 131         "$basedir/nodes",
 132         "$basedir/nodes/$nodename",
 133         "$basedir/nodes/$nodename/lxc",
 134         "$basedir/nodes/$nodename/qemu-server",
 135         "$basedir/nodes/$nodename/openvz",
 136         "$basedir/nodes/$nodename/priv");
 137
 138     foreach my $dir (@required_dirs) {
 139         if (! -d $dir) {
 140             mkdir($dir) || $! == EEXIST || die "unable to create directory '$dir' - $!\n";
 141         }
 142     }
 143 }
 144
 145 sub gen_auth_key {
 146
 147     return if -f "$authprivkeyfn";
 148
 149     check_cfs_is_mounted();
 150
 151     mkdir $authdir || $! == EEXIST || die "unable to create dir '$authdir' - $!\n";
 152
 153     my $cmd = "openssl genrsa -out '$authprivkeyfn' 2048";
 154     run_silent_cmd($cmd);
 155
 156     $cmd = "openssl rsa -in '$authprivkeyfn' -pubout -out '$authpubkeyfn'";
 157     run_silent_cmd($cmd)
 158 }
 159
 160 sub gen_pveca_key {
 161
 162     return if -f $pveca_key_fn;
 163
 164     eval {
 165         run_silent_cmd(['openssl', 'genrsa', '-out', $pveca_key_fn, '2048']);
 166     };
 167
 168     die "unable to generate pve ca key:\n$@" if $@;
 169 }
 170
 171 sub gen_pveca_cert {
 172
 173     if (-f $pveca_key_fn && -f $pveca_cert_fn) {
 174         return 0;
 175     }
 176
 177     gen_pveca_key();
 178
 179     # we try to generate an unique 'subject' to avoid browser problems
 180     # (reused serial numbers, ..)
 181     my $nid = (split (/\s/, `md5sum '$pveca_key_fn'`))[0] || time();
 182
 183     eval {
 184         run_silent_cmd(['openssl', 'req', '-batch', '-days', '3650', '-new',
 185                         '-x509', '-nodes', '-key',
 186                         $pveca_key_fn, '-out', $pveca_cert_fn, '-subj',
 187                         "/CN=Proxmox Virtual Environment/OU=$nid/O=PVE Cluster Manager CA/"]);
 188     };
 189
 190     die "generating pve root certificate failed:\n$@" if $@;
 191
 192     return 1;
 193 }
 194
 195 sub gen_pve_ssl_key {
 196     my ($nodename) = @_;
 197
 198     die "no node name specified" if !$nodename;
 199
 200     my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
 201
 202     return if -f $pvessl_key_fn;
 203
 204     eval {
 205         run_silent_cmd(['openssl', 'genrsa', '-out', $pvessl_key_fn, '2048']);
 206     };
 207
 208     die "unable to generate pve ssl key for node '$nodename':\n$@" if $@;
 209 }
 210
 211 sub gen_pve_www_key {
 212
 213     return if -f $pvewww_key_fn;
 214
 215     eval {
 216         run_silent_cmd(['openssl', 'genrsa', '-out', $pvewww_key_fn, '2048']);
 217     };
 218
 219     die "unable to generate pve www key:\n$@" if $@;
 220 }
 221
 222 sub update_serial {
 223     my ($serial) = @_;
 224
 225     PVE::Tools::file_set_contents($pveca_srl_fn, $serial);
 226 }
 227
 228 sub gen_pve_ssl_cert {
 229     my ($force, $nodename, $ip) = @_;
 230
 231     die "no node name specified" if !$nodename;
 232     die "no IP specified" if !$ip;
 233
 234     my $pvessl_cert_fn = "$basedir/nodes/$nodename/pve-ssl.pem";
 235
 236     return if !$force && -f $pvessl_cert_fn;
 237
 238     my $names = "IP:127.0.0.1,DNS:localhost";
 239
 240     my $rc = PVE::INotify::read_file('resolvconf');
 241
 242     $names .= ",IP:$ip";
 243
 244     my $fqdn = $nodename;
 245
 246     $names .= ",DNS:$nodename";
 247
 248     if ($rc && $rc->{search}) {
 249         $fqdn = $nodename . "." . $rc->{search};
 250         $names .= ",DNS:$fqdn";
 251     }
 252
 253     my $sslconf = <<__EOD;
 254 RANDFILE = /root/.rnd
 255 extensions = v3_req
 256
 257 [ req ]
 258 default_bits = 2048
 259 distinguished_name = req_distinguished_name
 260 req_extensions = v3_req
 261 prompt = no
 262 string_mask = nombstr
 263
 264 [ req_distinguished_name ]
 265 organizationalUnitName = PVE Cluster Node
 266 organizationName = Proxmox Virtual Environment
 267 commonName = $fqdn
 268
 269 [ v3_req ]
 270 basicConstraints = CA:FALSE
 271 nsCertType = server
 272 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
 273 subjectAltName = $names
 274 __EOD
 275
 276     my $cfgfn = "/tmp/pvesslconf-$$.tmp";
 277     my $fh = IO::File->new ($cfgfn, "w");
 278     print $fh $sslconf;
 279     close ($fh);
 280
 281     my $reqfn = "/tmp/pvecertreq-$$.tmp";
 282     unlink $reqfn;
 283
 284     my $pvessl_key_fn = "$basedir/nodes/$nodename/pve-ssl.key";
 285     eval {
 286         run_silent_cmd(['openssl', 'req', '-batch', '-new', '-config', $cfgfn,
 287                         '-key', $pvessl_key_fn, '-out', $reqfn]);
 288     };
 289
 290     if (my $err = $@) {
 291         unlink $reqfn;
 292         unlink $cfgfn;
 293         die "unable to generate pve certificate request:\n$err";
 294     }
 295
 296     update_serial("0000000000000000") if ! -f $pveca_srl_fn;
 297
 298     eval {
 299         run_silent_cmd(['openssl', 'x509', '-req', '-in', $reqfn, '-days', '3650',
 300                         '-out', $pvessl_cert_fn, '-CAkey', $pveca_key_fn,
 301                         '-CA', $pveca_cert_fn, '-CAserial', $pveca_srl_fn,
 302                         '-extfile', $cfgfn]);
 303     };
 304
 305     if (my $err = $@) {
 306         unlink $reqfn;
 307         unlink $cfgfn;
 308         die "unable to generate pve ssl certificate:\n$err";
 309     }
 310
 311     unlink $cfgfn;
 312     unlink $reqfn;
 313 }
 314
 315 sub gen_pve_node_files {
 316     my ($nodename, $ip, $opt_force) = @_;
 317
 318     gen_local_dirs($nodename);
 319
 320     gen_auth_key();
 321
 322     # make sure we have a (cluster wide) secret
 323     # for CSRFR prevention
 324     gen_pve_www_key();
 325
 326     # make sure we have a (per node) private key
 327     gen_pve_ssl_key($nodename);
 328
 329     # make sure we have a CA
 330     my $force = gen_pveca_cert();
 331
 332     $force = 1 if $opt_force;
 333
 334     gen_pve_ssl_cert($force, $nodename, $ip);
 335 }
 336
 337 my $vzdump_cron_dummy = <<__EOD;
 338 # cluster wide vzdump cron schedule
 339 # Atomatically generated file - do not edit
 340
 341 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
 342
 343 __EOD
 344
 345 sub gen_pve_vzdump_symlink {
 346
 347     my $filename = "/etc/pve/vzdump.cron";
 348
 349     my $link_fn = "/etc/cron.d/vzdump";
 350
 351     if ((-f $filename) && (! -l $link_fn)) {
 352         rename($link_fn, "/root/etc_cron_vzdump.org"); # make backup if file exists
 353         symlink($filename, $link_fn);
 354     }
 355 }
 356
 357 sub gen_pve_vzdump_files {
 358
 359     my $filename = "/etc/pve/vzdump.cron";
 360
 361     PVE::Tools::file_set_contents($filename, $vzdump_cron_dummy)
 362         if ! -f $filename;
 363
 364     gen_pve_vzdump_symlink();
 365 };
 366
 367 my $versions = {};
 368 my $vmlist = {};
 369 my $clinfo = {};
 370
 371 my $ipcc_send_rec = sub {
 372     my ($msgid, $data) = @_;
 373
 374     my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
 375
 376     die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
 377
 378     return $res;
 379 };
 380
 381 my $ipcc_send_rec_json = sub {
 382     my ($msgid, $data) = @_;
 383
 384     my $res = PVE::IPCC::ipcc_send_rec($msgid, $data);
 385
 386     die "ipcc_send_rec failed: $!\n" if !defined($res) && ($! != 0);
 387
 388     return decode_json($res);
 389 };
 390
 391 my $ipcc_get_config = sub {
 392     my ($path) = @_;
 393
 394     my $bindata = pack "Z*", $path;
 395     my $res = PVE::IPCC::ipcc_send_rec(6, $bindata);
 396     if (!defined($res)) {
 397         return undef if ($! != 0);
 398         return '';
 399     }
 400
 401     return $res;
 402 };
 403
 404 my $ipcc_get_status = sub {
 405     my ($name, $nodename) = @_;
 406
 407     my $bindata = pack "Z[256]Z[256]", $name, ($nodename || "");
 408     return PVE::IPCC::ipcc_send_rec(5, $bindata);
 409 };
 410
 411 my $ipcc_update_status = sub {
 412     my ($name, $data) = @_;
 413
 414     my $raw = ref($data) ? encode_json($data) : $data;
 415     # update status
 416     my $bindata = pack "Z[256]Z*", $name, $raw;
 417
 418     return &$ipcc_send_rec(4, $bindata);
 419 };
 420
 421 my $ipcc_log = sub {
 422     my ($priority, $ident, $tag, $msg) = @_;
 423
 424     my $bindata = pack "CCCZ*Z*Z*", $priority, bytes::length($ident) + 1,
 425     bytes::length($tag) + 1, $ident, $tag, $msg;
 426
 427     return &$ipcc_send_rec(7, $bindata);
 428 };
 429
 430 my $ipcc_get_cluster_log = sub {
 431     my ($user, $max) = @_;
 432
 433     $max = 0 if !defined($max);
 434
 435     my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || "");
 436     return &$ipcc_send_rec(8, $bindata);
 437 };
 438
 439 my $ccache = {};
 440
 441 sub cfs_update {
 442     eval {
 443         my $res = &$ipcc_send_rec_json(1);
 444         #warn "GOT1: " . Dumper($res);
 445         die "no starttime\n" if !$res->{starttime};
 446
 447         if (!$res->{starttime} || !$versions->{starttime} ||
 448             $res->{starttime} != $versions->{starttime}) {
 449             #print "detected changed starttime\n";
 450             $vmlist = {};
 451             $clinfo = {};
 452             $ccache = {};
 453         }
 454
 455         $versions = $res;
 456     };
 457     my $err = $@;
 458     if ($err) {
 459         $versions = {};
 460         $vmlist = {};
 461         $clinfo = {};
 462         $ccache = {};
 463         warn $err;
 464     }
 465
 466     eval {
 467         if (!$clinfo->{version} || $clinfo->{version} != $versions->{clinfo}) {
 468             #warn "detected new clinfo\n";
 469             $clinfo = &$ipcc_send_rec_json(2);
 470         }
 471     };
 472     $err = $@;
 473     if ($err) {
 474         $clinfo = {};
 475         warn $err;
 476     }
 477
 478     eval {
 479         if (!$vmlist->{version} || $vmlist->{version} != $versions->{vmlist}) {
 480             #warn "detected new vmlist1\n";
 481             $vmlist = &$ipcc_send_rec_json(3);
 482         }
 483     };
 484     $err = $@;
 485     if ($err) {
 486         $vmlist = {};
 487         warn $err;
 488     }
 489 }
 490
 491 sub get_vmlist {
 492     return $vmlist;
 493 }
 494
 495 sub get_clinfo {
 496     return $clinfo;
 497 }
 498
 499 sub get_members {
 500     return $clinfo->{nodelist};
 501 }
 502
 503 sub get_nodelist {
 504
 505     my $nodelist = $clinfo->{nodelist};
 506
 507     my $result = [];
 508
 509     my $nodename = PVE::INotify::nodename();
 510
 511     if (!$nodelist || !$nodelist->{$nodename}) {
 512         return [ $nodename ];
 513     }
 514
 515     return [ keys %$nodelist ];
 516 }
 517
 518 sub broadcast_tasklist {
 519     my ($data) = @_;
 520
 521     eval {
 522         &$ipcc_update_status("tasklist", $data);
 523     };
 524
 525     warn $@ if $@;
 526 }
 527
 528 my $tasklistcache = {};
 529
 530 sub get_tasklist {
 531     my ($nodename) = @_;
 532
 533     my $kvstore = $versions->{kvstore} || {};
 534
 535     my $nodelist = get_nodelist();
 536
 537     my $res = [];
 538     foreach my $node (@$nodelist) {
 539         next if $nodename && ($nodename ne $node);
 540         eval {
 541             my $ver = $kvstore->{$node}->{tasklist} if $kvstore->{$node};
 542             my $cd = $tasklistcache->{$node};
 543             if (!$cd || !$ver || !$cd->{version} ||
 544                 ($cd->{version} != $ver)) {
 545                 my $raw = &$ipcc_get_status("tasklist", $node) || '[]';
 546                 my $data = decode_json($raw);
 547                 push @$res, @$data;
 548                 $cd = $tasklistcache->{$node} = {
 549                     data => $data,
 550                     version => $ver,
 551                 };
 552             } elsif ($cd && $cd->{data}) {
 553                 push @$res, @{$cd->{data}};
 554             }
 555         };
 556         my $err = $@;
 557         syslog('err', $err) if $err;
 558     }
 559
 560     return $res;
 561 }
 562
 563 sub broadcast_rrd {
 564     my ($rrdid, $data) = @_;
 565
 566     eval {
 567         &$ipcc_update_status("rrd/$rrdid", $data);
 568     };
 569     my $err = $@;
 570
 571     warn $err if $err;
 572 }
 573
 574 my $last_rrd_dump = 0;
 575 my $last_rrd_data = "";
 576
 577 sub rrd_dump {
 578
 579     my $ctime = time();
 580
 581     my $diff = $ctime - $last_rrd_dump;
 582     if ($diff < 2) {
 583         return $last_rrd_data;
 584     }
 585
 586     my $raw;
 587     eval {
 588         $raw = &$ipcc_send_rec(10);
 589     };
 590     my $err = $@;
 591
 592     if ($err) {
 593         warn $err;
 594         return {};
 595     }
 596
 597     my $res = {};
 598
 599     if ($raw) {
 600         while ($raw =~ s/^(.*)\n//) {
 601             my ($key, @ela) = split(/:/, $1);
 602             next if !$key;
 603             next if !(scalar(@ela) > 1);
 604             $res->{$key} = \@ela;
 605         }
 606     }
 607
 608     $last_rrd_dump = $ctime;
 609     $last_rrd_data = $res;
 610
 611     return $res;
 612 }
 613
 614 sub create_rrd_data {
 615     my ($rrdname, $timeframe, $cf) = @_;
 616
 617     my $rrddir = "/var/lib/rrdcached/db";
 618
 619     my $rrd = "$rrddir/$rrdname";
 620
 621     my $setup = {
 622         hour =>  [ 60, 70 ],
 623         day  =>  [ 60*30, 70 ],
 624         week =>  [ 60*180, 70 ],
 625         month => [ 60*720, 70 ],
 626         year =>  [ 60*10080, 70 ],
 627     };
 628
 629     my ($reso, $count) = @{$setup->{$timeframe}};
 630     my $ctime  = $reso*int(time()/$reso);
 631     my $req_start = $ctime - $reso*$count;
 632
 633     $cf = "AVERAGE" if !$cf;
 634
 635     my @args = (
 636         "-s" => $req_start,
 637         "-e" => $ctime - 1,
 638         "-r" => $reso,
 639         );
 640
 641     my $socket = "/var/run/rrdcached.sock";
 642     push @args, "--daemon" => "unix:$socket" if -S $socket;
 643
 644     my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);
 645
 646     my $err = RRDs::error;
 647     die "RRD error: $err\n" if $err;
 648
 649     die "got wrong time resolution ($step != $reso)\n"
 650         if $step != $reso;
 651
 652     my $res = [];
 653     my $fields = scalar(@$names);
 654     for my $line (@$data) {
 655         my $entry = { 'time' => $start };
 656         $start += $step;
 657         my $found_undefs;
 658         for (my $i = 0; $i < $fields; $i++) {
 659             my $name = $names->[$i];
 660             if (defined(my $val = $line->[$i])) {
 661                 $entry->{$name} = $val;
 662             } else {
 663                 # we only add entryies with all data defined
 664                 # extjs chart has problems with undefined values
 665                 $found_undefs = 1;
 666             }
 667         }
 668         push @$res, $entry if !$found_undefs;
 669     }
 670
 671     return $res;
 672 }
 673
 674 sub create_rrd_graph {
 675     my ($rrdname, $timeframe, $ds, $cf) = @_;
 676
 677     # Using RRD graph is clumsy - maybe it
 678     # is better to simply fetch the data, and do all display
 679     # related things with javascript (new extjs html5 graph library).
 680
 681     my $rrddir = "/var/lib/rrdcached/db";
 682
 683     my $rrd = "$rrddir/$rrdname";
 684
 685     my @ids = PVE::Tools::split_list($ds);
 686
 687     my $ds_txt = join('_', @ids);
 688
 689     my $filename = "${rrd}_${ds_txt}.png";
 690
 691     my $setup = {
 692         hour =>  [ 60, 60 ],
 693         day  =>  [ 60*30, 70 ],
 694         week =>  [ 60*180, 70 ],
 695         month => [ 60*720, 70 ],
 696         year =>  [ 60*10080, 70 ],
 697     };
 698
 699     my ($reso, $count) = @{$setup->{$timeframe}};
 700
 701     my @args = (
 702         "--imgformat" => "PNG",
 703         "--border" => 0,
 704         "--height" => 200,
 705         "--width" => 800,
 706         "--start" => - $reso*$count,
 707         "--end" => 'now' ,
 708         );
 709
 710     my $socket = "/var/run/rrdcached.sock";
 711     push @args, "--daemon" => "unix:$socket" if -S $socket;
 712
 713     my @coldef = ('#00ddff', '#ff0000');
 714
 715     $cf = "AVERAGE" if !$cf;
 716
 717     my $i = 0;
 718     foreach my $id (@ids) {
 719         my $col = $coldef[$i++] || die "fixme: no color definition";
 720         push @args, "DEF:${id}=$rrd:${id}:$cf";
 721         my $dataid = $id;
 722         if ($id eq 'cpu' || $id eq 'iowait') {
 723             push @args, "CDEF:${id}_per=${id},100,*";
 724             $dataid = "${id}_per";
 725         }
 726         push @args, "LINE2:${dataid}${col}:${id}";
 727     }
 728
 729     push @args, '--full-size-mode';
 730
 731     # we do not really store data into the file
 732     my $res = RRDs::graphv('', @args);
 733
 734     my $err = RRDs::error;
 735     die "RRD error: $err\n" if $err;
 736
 737     return { filename => $filename, image => $res->{image} };
 738 }
 739
 740 # a fast way to read files (avoid fuse overhead)
 741 sub get_config {
 742     my ($path) = @_;
 743
 744     return &$ipcc_get_config($path);
 745 }
 746
 747 sub get_cluster_log {
 748     my ($user, $max) = @_;
 749
 750     return &$ipcc_get_cluster_log($user, $max);
 751 }
 752
 753 my $file_info = {};
 754
 755 sub cfs_register_file {
 756     my ($filename, $parser, $writer) = @_;
 757
 758     $observed->{$filename} || die "unknown file '$filename'";
 759
 760     die "file '$filename' already registered" if $file_info->{$filename};
 761
 762     $file_info->{$filename} = {
 763         parser => $parser,
 764         writer => $writer,
 765     };
 766 }
 767
 768 my $ccache_read = sub {
 769     my ($filename, $parser, $version) = @_;
 770
 771     $ccache->{$filename} = {} if !$ccache->{$filename};
 772
 773     my $ci = $ccache->{$filename};
 774
 775     if (!$ci->{version} || !$version || $ci->{version} != $version) {
 776         # we always call the parser, even when the file does not exists
 777         # (in that case $data is undef)
 778         my $data = get_config($filename);
 779         $ci->{data} = &$parser("/etc/pve/$filename", $data);
 780         $ci->{version} = $version;
 781     }
 782
 783     my $res = ref($ci->{data}) ? dclone($ci->{data}) : $ci->{data};
 784
 785     return $res;
 786 };
 787
 788 sub cfs_file_version {
 789     my ($filename) = @_;
 790
 791     my $version;
 792     my $infotag;
 793     if ($filename =~ m!^nodes/[^/]+/(openvz|qemu-server)/(\d+)\.conf$!) {
 794         my ($type, $vmid) = ($1, $2);
 795         if ($vmlist && $vmlist->{ids} && $vmlist->{ids}->{$vmid}) {
 796             $version = $vmlist->{ids}->{$vmid}->{version};
 797         }
 798         $infotag = "/$type/";
 799     } elsif ($filename =~ m!^nodes/[^/]+/lxc/(\d+)/config$!) {
 800         my $vmid = $1;
 801         if ($vmlist && $vmlist->{ids} && $vmlist->{ids}->{$vmid}) {
 802             $version = $vmlist->{ids}->{$vmid}->{version};
 803         }
 804         $infotag = "/lxc/";
 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 my $log_levels = {
 935     "emerg" => 0,
 936     "alert" => 1,
 937     "crit" => 2,
 938     "critical" => 2,
 939     "err" => 3,
 940     "error" => 3,
 941     "warn" => 4,
 942     "warning" => 4,
 943     "notice" => 5,
 944     "info" => 6,
 945     "debug" => 7,
 946 };
 947
 948 sub log_msg {
 949    my ($priority, $ident, $msg) = @_;
 950
 951    if (my $tmp = $log_levels->{$priority}) {
 952        $priority = $tmp;
 953    }
 954
 955    die "need numeric log priority" if $priority !~ /^\d+$/;
 956
 957    my $tag = PVE::SafeSyslog::tag();
 958
 959    $msg = "empty message" if !$msg;
 960
 961    $ident = "" if !$ident;
 962    $ident = encode("ascii", decode_utf8($ident),
 963                    sub { sprintf "\\u%04x", shift });
 964
 965    my $utf8 = decode_utf8($msg);
 966
 967    my $ascii = encode("ascii", $utf8, sub { sprintf "\\u%04x", shift });
 968
 969    if ($ident) {
 970        syslog($priority, "<%s> %s", $ident, $ascii);
 971    } else {
 972        syslog($priority, "%s", $ascii);
 973    }
 974
 975    eval { &$ipcc_log($priority, $ident, $tag, $ascii); };
 976
 977    syslog("err", "writing cluster log failed: $@") if $@;
 978 }
 979
 980 sub check_vmid_unused {
 981     my ($vmid, $noerr) = @_;
 982
 983     my $vmlist = get_vmlist();
 984
 985     my $d = $vmlist->{ids}->{$vmid};
 986     return 1 if !defined($d);
 987
 988     return undef if $noerr;
 989
 990     die "VM $vmid already exists\n" if $d->{type} eq 'qemu';
 991
 992     die "CT $vmid already exists\n";
 993 }
 994
 995 sub check_node_exists {
 996     my ($nodename, $noerr) = @_;
 997
 998     my $nodelist = $clinfo->{nodelist};
 999     return 1 if $nodelist && $nodelist->{$nodename};
1000
1001     return undef if $noerr;
1002
1003     die "no such cluster node '$nodename'\n";
1004 }
1005
1006 # this is also used to get the IP of the local node
1007 sub remote_node_ip {
1008     my ($nodename, $noerr) = @_;
1009
1010     my $nodelist = $clinfo->{nodelist};
1011     if ($nodelist && $nodelist->{$nodename}) {
1012         if (my $ip = $nodelist->{$nodename}->{ip}) {
1013             return wantarray ? ($ip, PVE::Tools::get_host_address_family($ip))
1014                              : $ip;
1015         }
1016     }
1017
1018     # fallback: try to get IP by other means
1019     my ($family, $packed_ip);
1020
1021     eval {
1022         my @res = PVE::Tools::getaddrinfo_all($nodename);
1023         $family = $res[0]->{family};
1024         $packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
1025     };
1026
1027     if ($@) {
1028         die "hostname lookup failed:\n$@" if !$noerr;
1029         return undef;
1030     }
1031
1032     my $ip = Socket::inet_ntop($family, $packed_ip);
1033     if ($ip =~ m/^127\.|^::1$/) {
1034         die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
1035         return undef;
1036     }
1037
1038     return wantarray ? ($ip, $family) : $ip;
1039 }
1040
1041 # ssh related utility functions
1042
1043 sub ssh_merge_keys {
1044     # remove duplicate keys in $sshauthkeys
1045     # ssh-copy-id simply add keys, so the file can grow to large
1046
1047     my $data = '';
1048     if (-f $sshauthkeys) {
1049         $data = PVE::Tools::file_get_contents($sshauthkeys, 128*1024);
1050         chomp($data);
1051     }
1052
1053     my $found_backup;
1054     if (-f $rootsshauthkeysbackup) {
1055         $data .= "\n";
1056         $data .= PVE::Tools::file_get_contents($rootsshauthkeysbackup, 128*1024);
1057         chomp($data);
1058         $found_backup = 1;
1059     }
1060
1061     # always add ourself
1062     if (-f $ssh_rsa_id) {
1063         my $pub = PVE::Tools::file_get_contents($ssh_rsa_id);
1064         chomp($pub);
1065         $data .= "\n$pub\n";
1066     }
1067
1068     my $newdata = "";
1069     my $vhash = {};
1070     my @lines = split(/\n/, $data);
1071     foreach my $line (@lines) {
1072         if ($line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/) {
1073             next if $vhash->{$3}++;
1074         }
1075         $newdata .= "$line\n";
1076     }
1077
1078     PVE::Tools::file_set_contents($sshauthkeys, $newdata, 0600);
1079
1080     if ($found_backup && -l $rootsshauthkeys) {
1081         # everything went well, so we can remove the backup
1082         unlink $rootsshauthkeysbackup;
1083     }
1084 }
1085
1086 sub setup_rootsshconfig {
1087
1088     # create ssh key if it does not exist
1089     if (! -f $ssh_rsa_id) {
1090         mkdir '/root/.ssh/';
1091         system ("echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}");
1092     }
1093
1094     # create ssh config if it does not exist
1095     if (! -f $rootsshconfig) {
1096         mkdir '/root/.ssh';
1097         if (my $fh = IO::File->new($rootsshconfig, O_CREAT|O_WRONLY|O_EXCL, 0640)) {
1098             # this is the default ciphers list from debian openssl0.9.8 except blowfish is added as prefered
1099             print $fh "Ciphers blowfish-cbc,aes128-ctr,aes192-ctr,aes256-ctr,arcfour256,arcfour128,aes128-cbc,3des-cbc\n";
1100             close($fh);
1101         }
1102     }
1103 }
1104
1105 sub setup_ssh_keys {
1106
1107     mkdir $authdir;
1108
1109     my $import_ok;
1110
1111     if (! -f $sshauthkeys) {
1112         my $old;
1113         if (-f $rootsshauthkeys) {
1114             $old = PVE::Tools::file_get_contents($rootsshauthkeys, 128*1024);
1115         }
1116         if (my $fh = IO::File->new ($sshauthkeys, O_CREAT|O_WRONLY|O_EXCL, 0400)) {
1117             PVE::Tools::safe_print($sshauthkeys, $fh, $old) if $old;
1118             close($fh);
1119             $import_ok = 1;
1120         }
1121     }
1122
1123     warn "can't create shared ssh key database '$sshauthkeys'\n"
1124         if ! -f $sshauthkeys;
1125
1126     if (-f $rootsshauthkeys && ! -l $rootsshauthkeys) {
1127         if (!rename($rootsshauthkeys , $rootsshauthkeysbackup)) {
1128             warn "rename $rootsshauthkeys failed - $!\n";
1129         }
1130     }
1131
1132     if (! -l $rootsshauthkeys) {
1133         symlink $sshauthkeys, $rootsshauthkeys;
1134     }
1135
1136     if (! -l $rootsshauthkeys) {
1137         warn "can't create symlink for ssh keys '$rootsshauthkeys' -> '$sshauthkeys'\n";
1138     } else {
1139         unlink $rootsshauthkeysbackup if $import_ok;
1140     }
1141 }
1142
1143 sub ssh_unmerge_known_hosts {
1144     return if ! -l $sshglobalknownhosts;
1145
1146     my $old = '';
1147     $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024)
1148         if -f $sshknownhosts;
1149
1150     PVE::Tools::file_set_contents($sshglobalknownhosts, $old);
1151 }
1152
1153 sub ssh_merge_known_hosts {
1154     my ($nodename, $ip_address, $createLink) = @_;
1155
1156     die "no node name specified" if !$nodename;
1157     die "no ip address specified" if !$ip_address;
1158
1159     mkdir $authdir;
1160
1161     if (! -f $sshknownhosts) {
1162         if (my $fh = IO::File->new($sshknownhosts, O_CREAT|O_WRONLY|O_EXCL, 0600)) {
1163             close($fh);
1164         }
1165     }
1166
1167     my $old = PVE::Tools::file_get_contents($sshknownhosts, 128*1024);
1168
1169     my $new = '';
1170
1171     if ((! -l $sshglobalknownhosts) && (-f $sshglobalknownhosts)) {
1172         $new = PVE::Tools::file_get_contents($sshglobalknownhosts, 128*1024);
1173     }
1174
1175     my $hostkey = PVE::Tools::file_get_contents($ssh_host_rsa_id);
1176     die "can't parse $ssh_rsa_id" if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/;
1177     $hostkey = $1;
1178
1179     my $data = '';
1180     my $vhash = {};
1181
1182     my $found_nodename;
1183     my $found_local_ip;
1184
1185     my $merge_line = sub {
1186         my ($line, $all) = @_;
1187
1188         if ($line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/) {
1189             my $key = $1;
1190             my $rsakey = $2;
1191             if (!$vhash->{$key}) {
1192                 $vhash->{$key} = 1;
1193                 if ($key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/) {
1194                     my $salt = decode_base64($1);
1195                     my $digest = $2;
1196                     my $hmac = Digest::HMAC_SHA1->new($salt);
1197                     $hmac->add($nodename);
1198                     my $hd = $hmac->b64digest . '=';
1199                     if ($digest eq $hd) {
1200                         if ($rsakey eq $hostkey) {
1201                             $found_nodename = 1;
1202                             $data .= $line;
1203                         }
1204                         return;
1205                     }
1206                     $hmac = Digest::HMAC_SHA1->new($salt);
1207                     $hmac->add($ip_address);
1208                     $hd = $hmac->b64digest . '=';
1209                     if ($digest eq $hd) {
1210                         if ($rsakey eq $hostkey) {
1211                             $found_local_ip = 1;
1212                             $data .= $line;
1213                         }
1214                         return;
1215                     }
1216                 }
1217                 $data .= $line;
1218             }
1219         } elsif ($all) {
1220             $data .= $line;
1221         }
1222     };
1223
1224     while ($old && $old =~ s/^((.*?)(\n|$))//) {
1225         my $line = "$2\n";
1226         next if $line =~ m/^\s*$/; # skip empty lines
1227         next if $line =~ m/^#/; # skip comments
1228         &$merge_line($line, 1);
1229     }
1230
1231     while ($new && $new =~ s/^((.*?)(\n|$))//) {
1232         my $line = "$2\n";
1233         next if $line =~ m/^\s*$/; # skip empty lines
1234         next if $line =~ m/^#/; # skip comments
1235         &$merge_line($line);
1236     }
1237
1238     my $addIndex = $$;
1239     my $add_known_hosts_entry  = sub {
1240         my ($name, $hostkey) = @_;
1241         $addIndex++;
1242         my $hmac = Digest::HMAC_SHA1->new("$addIndex" . time());
1243         my $b64salt = $hmac->b64digest . '=';
1244         $hmac = Digest::HMAC_SHA1->new(decode_base64($b64salt));
1245         $hmac->add($name);
1246         my $digest = $hmac->b64digest . '=';
1247         $data .= "|1|$b64salt|$digest $hostkey\n";
1248     };
1249
1250     if (!$found_nodename || !$found_local_ip) {
1251         &$add_known_hosts_entry($nodename, $hostkey) if !$found_nodename;
1252         &$add_known_hosts_entry($ip_address, $hostkey) if !$found_local_ip;
1253     }
1254
1255     PVE::Tools::file_set_contents($sshknownhosts, $data);
1256
1257     return if !$createLink;
1258
1259     unlink $sshglobalknownhosts;
1260     symlink $sshknownhosts, $sshglobalknownhosts;
1261
1262     warn "can't create symlink for ssh known hosts '$sshglobalknownhosts' -> '$sshknownhosts'\n"
1263         if ! -l $sshglobalknownhosts;
1264
1265 }
1266
1267 my $datacenter_schema = {
1268     type => "object",
1269     additionalProperties => 0,
1270     properties => {
1271         keyboard => {
1272             optional => 1,
1273             type => 'string',
1274             description => "Default keybord layout for vnc server.",
1275             enum => PVE::Tools::kvmkeymaplist(),
1276         },
1277         language => {
1278             optional => 1,
1279             type => 'string',
1280             description => "Default GUI language.",
1281             enum => [ 'en', 'de' ],
1282         },
1283         http_proxy => {
1284             optional => 1,
1285             type => 'string',
1286             description => "Specify external http proxy which is used for downloads (example: 'http://username:password\@host:port/')",
1287             pattern => "http://.*",
1288         },
1289         migration_unsecure => {
1290             optional => 1,
1291             type => 'boolean',
1292             description => "Migration is secure using SSH tunnel by default. For secure private networks you can disable it to speed up migration.",
1293         },
1294         console => {
1295             optional => 1,
1296             type => 'string',
1297             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).",
1298             enum => ['applet', 'vv', 'html5'],
1299         },
1300         email_from => {
1301             optional => 1,
1302             type => 'string',
1303             format => 'email-opt',
1304             description => "Specify email address to send notification from (default is root@\$hostname)",
1305         },
1306     },
1307 };
1308
1309 # make schema accessible from outside (for documentation)
1310 sub get_datacenter_schema { return $datacenter_schema };
1311
1312 sub parse_datacenter_config {
1313     my ($filename, $raw) = @_;
1314
1315     return PVE::JSONSchema::parse_config($datacenter_schema, $filename, $raw);
1316 }
1317
1318 sub write_datacenter_config {
1319     my ($filename, $cfg) = @_;
1320
1321     return PVE::JSONSchema::dump_config($datacenter_schema, $filename, $cfg);
1322 }
1323
1324 cfs_register_file('datacenter.cfg',
1325                   \&parse_datacenter_config,
1326                   \&write_datacenter_config);
1327
1328 # a very simply parser ...
1329 sub parse_corosync_conf {
1330     my ($filename, $raw) = @_;
1331
1332     return {} if !$raw;
1333
1334     my $digest = Digest::SHA::sha1_hex(defined($raw) ? $raw : '');
1335
1336     $raw =~ s/#.*$//mg;
1337     $raw =~ s/\r?\n/ /g;
1338     $raw =~ s/\s+/ /g;
1339     $raw =~ s/^\s+//;
1340     $raw =~ s/\s*$//;
1341
1342     my @tokens = split(/\s/, $raw);
1343
1344     my $conf = { section => 'main', children => [] };
1345
1346     my $stack = [];
1347     my $section = $conf;
1348
1349     while (defined(my $token = shift @tokens)) {
1350         my $nexttok = $tokens[0];
1351
1352         if ($nexttok && ($nexttok eq '{')) {
1353             shift @tokens; # skip '{'
1354             my $new_section = {
1355                 section => $token,
1356                 children => [],
1357             };
1358             push @{$section->{children}}, $new_section;
1359             push @$stack, $section;
1360             $section = $new_section;
1361             next;
1362         }
1363
1364         if ($token eq '}') {
1365             $section = pop @$stack;
1366             die "parse error - uncexpected '}'\n" if !$section;
1367             next;
1368         }
1369
1370         my $key = $token;
1371         die "missing ':' after key '$key'\n" if ! ($key =~ s/:$//);
1372
1373         die "parse error - no value for '$key'\n" if !defined($nexttok);
1374         my $value = shift @tokens;
1375
1376         push @{$section->{children}}, { key => $key, value => $value };
1377     }
1378
1379     $conf->{digest} = $digest;
1380
1381     return $conf;
1382 }
1383
1384 my $dump_corosync_section;
1385 $dump_corosync_section = sub {
1386     my ($section, $prefix) = @_;
1387
1388     my $raw = $prefix . $section->{section} . " {\n";
1389
1390     my @list = grep { defined($_->{key}) } @{$section->{children}};
1391     foreach my $child (sort {$a->{key} cmp $b->{key}} @list) {
1392         $raw .= $prefix . "  $child->{key}: $child->{value}\n";
1393     }
1394
1395     @list = grep { defined($_->{section}) } @{$section->{children}};
1396     foreach my $child (sort {$a->{section} cmp $b->{section}} @list) {
1397         $raw .= &$dump_corosync_section($child, "$prefix  ");
1398     }
1399
1400     $raw .= $prefix . "}\n\n";
1401
1402     return $raw;
1403
1404 };
1405
1406 sub write_corosync_conf {
1407     my ($filename, $conf) = @_;
1408
1409     my $raw = '';
1410
1411     my $prefix = '';
1412
1413     die "no main section" if $conf->{section} ne 'main';
1414
1415     my @list = grep { defined($_->{key}) } @{$conf->{children}};
1416     foreach my $child (sort {$a->{key} cmp $b->{key}} @list) {
1417         $raw .= "$child->{key}: $child->{value}\n";
1418     }
1419
1420     @list = grep { defined($_->{section}) } @{$conf->{children}};
1421     foreach my $child (sort {$a->{section} cmp $b->{section}} @list) {
1422         $raw .= &$dump_corosync_section($child, $prefix);
1423     }
1424
1425     return $raw;
1426 }
1427
1428 sub corosync_conf_version {
1429     my ($conf, $noerr, $new_value) = @_;
1430
1431     foreach my $child (@{$conf->{children}}) {
1432         next if !defined($child->{section});
1433         if ($child->{section} eq 'totem') {
1434             foreach my $e (@{$child->{children}}) {
1435                 next if !defined($e->{key});
1436                 if ($e->{key} eq 'config_version') {
1437                     if ($new_value) {
1438                         $e->{value} = $new_value;
1439                         return $new_value;
1440                     } elsif (my $version = int($e->{value})) {
1441                         return $version;
1442                     }
1443                     last;
1444                 }
1445             }
1446         }
1447     }
1448
1449     return undef if $noerr;
1450
1451     die "invalid corosync config - unable to read version\n";
1452 }
1453
1454 # read only - use "rename corosync.conf.new corosync.conf" to write
1455 PVE::Cluster::cfs_register_file('corosync.conf', \&parse_corosync_conf);
1456 # this is read/write
1457 PVE::Cluster::cfs_register_file('corosync.conf.new', \&parse_corosync_conf,
1458                                 \&write_corosync_conf);
1459
1460 1;