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