lib/PVE.old/ConfigServer.pm

   1 use PVE::SourceFilter;
   2
   3 package PVE::ConfigServer;
   4
   5 use strict;
   6 use vars qw(@ISA);
   7 use Carp;
   8 use PVE::SafeSyslog;
   9 use File::stat;
  10 use IO::File;
  11 use Fcntl qw(:flock);
  12 use MIME::Base64;
  13 use PVE::Cluster;
  14 use PVE::Utils;
  15 use PVE::Config;
  16 use IO::Socket::INET;
  17 use Digest::SHA1;
  18 use PVE::QemuServer;
  19 use PVE::APLInfo;
  20 use IPC::Open2;
  21 use PVE::OpenVZ;
  22 use PVE::Qemu;
  23 use PVE::Storage;
  24
  25 use base 'Exporter';
  26 our @EXPORT = qw($pve_config_daemon);
  27 our $pve_config_daemon;
  28
  29 my $get_userid = sub { # private method
  30     my ($class) = @_;
  31
  32     if ($pve_config_daemon) {
  33         return $pve_config_daemon->{pve}->{username};
  34     }
  35
  36     die "internal error";
  37 };
  38
  39 my $get_ticket = sub { # private method
  40     my ($class) = @_;
  41
  42     if ($pve_config_daemon) {
  43         return $pve_config_daemon->{pve}->{ticket};
  44     }
  45
  46     die "internal error";
  47 };
  48
  49 sub alive { ##SOAP_EXPORT##
  50     my ($class) = @_;
  51
  52     return 1;
  53 }
  54
  55 sub update_ticket { ##SOAP_EXPORT##
  56     my ($class) = @_;
  57
  58     # ticket is magically updated by the server before
  59     # this function is called.
  60     my $ticket = $class->$get_ticket();
  61
  62     return $ticket;
  63 }
  64
  65 sub ping { ##SOAP_EXPORT##
  66     my ($class) = @_;
  67
  68     my $userid = $class->$get_userid();
  69
  70     my $cinfo = PVE::Cluster::clusterinfo ();
  71
  72     my $status = { time => time (), insync => 1 };
  73
  74     $status->{uptime} = PVE::Utils::get_uptime ();
  75     $status->{cpuinfo} = PVE::Utils::get_cpu_info ();
  76     $status->{meminfo} = PVE::Utils::get_memory_info ();
  77     $status->{hdinfo}->{root} = PVE::Utils::get_hd_info ('/');
  78
  79     my $procstat = PVE::Utils::read_proc_stat();
  80     $status->{cpu} = $procstat->{cpu};
  81     $status->{wait} = $procstat->{wait};
  82
  83     my $syncstatus = PVE::Config::read_file ("syncstatus");
  84
  85     foreach my $ni (@{$cinfo->{nodes}}) {
  86         my $cid = $ni->{cid};
  87         next if $cinfo->{local}->{cid} == $cid; # skip local CID
  88         my $lastsync = defined ($syncstatus->{$cid}) ?
  89             $syncstatus->{$cid}->{lastsync} : 0;
  90         $status->{"lastsync_$cid"} = $lastsync;
  91         my $sdiff = time() - $lastsync;
  92         $sdiff = 0 if $sdiff < 0;
  93         $status->{insync} = 0 if ($sdiff > (60*3));
  94     }
  95
  96     return $status;
  97 }
  98
  99 sub vzlist { ##SOAP_EXPORT##
 100     my ($class) = @_;
 101
 102     my $userid = $class->$get_userid();
 103
 104     my $res = {};
 105
 106     # openvz
 107     eval {
 108         $res = PVE::OpenVZ::vmlist();
 109     };
 110
 111     my $err = $@;
 112
 113     if ($err) {
 114         syslog ('err', "ERROR: $err");
 115     } else {
 116         $res->{openvz} = 1;
 117     }
 118
 119     # qemu
 120     eval {
 121
 122         my $qmlist = PVE::Qemu::vmlist();
 123
 124         foreach my $vekey (keys %$qmlist) {
 125             if (!$res->{$vekey}) {
 126                 $res->{$vekey} = $qmlist->{$vekey};
 127             } else {
 128                 syslog ('err', "found duplicated ID '$vekey' - ignoring qemu instance\n");
 129             }
 130         }
 131     };
 132
 133     $err = $@;
 134
 135     if ($err) {
 136         syslog ('err', "ERROR: $err");
 137     } else {
 138         $res->{qemu} = 1;
 139     }
 140
 141     $res->{lasttime} = time();
 142
 143     my $pc = PVE::Config::update_file ('pcounter', 'vzlist');
 144     $res->{version} = $pc->{vzlist};
 145
 146     return $res;
 147 }
 148
 149 sub vmlogview {  ##SOAP_EXPORT##
 150     my ($class, $cid, $veid, $service) = @_;
 151
 152     my $userid = $class->$get_userid();
 153
 154     my $filename = "/var/lib/vz/private/$veid/var/log/syslog";
 155
 156     if ($service eq 'init') {
 157         $filename = "/var/lib/vz/private/$veid/var/log/init.log";
 158     } elsif ($service eq 'syslog') {
 159         # some systems (rh,centos) logs to messages instead
 160         my $msglog = "/var/lib/vz/private/$veid/var/log/messages";
 161         if ((! -f $filename) && (-f $msglog)) {
 162             $filename = $msglog;
 163         }
 164     }
 165
 166     my $lines = [];
 167
 168     my $limit = 200;
 169
 170     open (TMP, "tail -$limit $filename|");
 171     while (my $line = <TMP>) {
 172         chomp $line;
 173         push @$lines, $line;
 174     }
 175     close (TMP);
 176
 177     return $lines;
 178 }
 179
 180 sub vmconfig { ##SOAP_EXPORT##
 181     my ($class, $veid, $type) = @_;
 182
 183     my $userid = $class->$get_userid();
 184
 185     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 186
 187     my $res;
 188
 189     $res->{vzlist} = $class->vzlist();
 190
 191     if (($type eq 'qemu') && !$res->{vzlist}->{qemu}) {
 192         die "unable to get qemu-server vm list - server not running?\n";
 193     }
 194     if (($type eq 'openvz') && !$res->{vzlist}->{openvz}) {
 195         die "unable to get openvz vm list?\n";
 196     }
 197
 198     if (my $d = $res->{vzlist}->{"VEID_$veid"}) {
 199         die "virtualization type mismatch" if $type ne $d->{type};
 200
 201         if ($d->{type} eq 'openvz') {
 202             $res->{config} = PVE::Config::get_veconfig ($veid);
 203         } elsif ($d->{type} eq 'qemu') {
 204             $res->{config} = PVE::Config::get_qmconfig  ($veid);
 205         } else {
 206             die "internal error";
 207         }
 208     } else {
 209         die "unable to get configuration data for VEID '$veid'";
 210     }
 211
 212     return $res;
 213 }
 214
 215 sub cluster_vzlist { ##SOAP_EXPORT##
 216     my ($class, $cid, $vzlist) = @_;
 217
 218     my $userid = $class->$get_userid();
 219
 220     my $newlist = PVE::Config::update_file ('vzlist', $vzlist, $cid);
 221
 222     my $vmops = PVE::Config::read_file ("vmops");
 223
 224     PVE::Utils::foreach_vmrec ($vmops, sub {
 225         my ($cid, $vmid, $d, $ckey, $vmkey) = @_;
 226         my $old = $newlist->{$ckey}->{$vmkey};
 227
 228         # command still running ?
 229         my $pstart;
 230         if ($old && PVE::Utils::check_process ($d->{pid}, $d->{pstart})) {
 231
 232             $old->{status} = $d->{command};
 233
 234             if ($d->{command} eq 'migrate') {
 235                 PVE::Utils::foreach_vmrec ($newlist, sub {
 236                     my ($ncid, $nvmid, $nd) = @_;
 237                     $nd->{status} = 'migrate' if ($nvmid eq $vmid);
 238                 });
 239             }
 240         }
 241     });
 242
 243     return $newlist;
 244 }
 245
 246 # start long running workers
 247 # $data append to the returned uniquely identifier, which
 248 # has the following format: "UPID:$pid-$pstart:$startime:$dtype:$data"
 249 # STDIN is redirected to /dev/null
 250 # STDOUT,STDERR are redirected to the filename returned by upid_decode
 251 # that file is locked wit flock to make sure only one process
 252 # is writing it
 253
 254 my $fork_worker = sub { # private method
 255     my ($class, $dtype, $data, $function) = @_;
 256
 257     my $cpid;
 258
 259     $dtype = 'unknown' if !defined ($dtype);
 260
 261     $data = '' if !defined ($data);
 262
 263     my $starttime = time ();
 264
 265     my @psync = POSIX::pipe();
 266
 267     # detect filename with faked PID
 268     my $tmp = PVE::Utils::upid_decode ("UPID:0-0:0:$dtype:$data");
 269     my $filename = $tmp->{filename};
 270
 271     my $lockfh;
 272     # lock output file
 273     if ($filename) {
 274
 275         $lockfh = IO::File->new ($filename, O_WRONLY|O_CREAT) ||
 276             die "unable to open output file - $!\n";
 277
 278         my $wwwid = getpwnam('www-data');
 279         chown $wwwid,  $filename;
 280
 281         if (!flock ($lockfh, LOCK_EX|LOCK_NB)) {
 282             undef $lockfh; # close
 283             die "unable to lock output file\n";
 284         }
 285
 286         if (!truncate ($lockfh, 0)) {
 287             die "unable to truncate output file - $!\n";
 288         }
 289     }
 290
 291     if (($cpid = fork()) == 0) {
 292
 293         $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { die "received interrupt\n"; };
 294
 295         $SIG{CHLD} = $SIG{PIPE} = 'DEFAULT';
 296
 297         # set sess/process group - we want to be able to kill the
 298         # whole process group
 299         POSIX::setsid();
 300
 301         POSIX::close ($psync[0]);
 302
 303         PVE::Config::inotify_close();
 304
 305         # we close the socket
 306         my $httpd = $pve_config_daemon->{_daemon};
 307         $httpd->close();
 308
 309         # same algorythm as used inside SA
 310
 311         # STDIN = /dev/null
 312         my $fd = fileno (STDIN);
 313         close STDIN;
 314         POSIX::close(0) if $fd != 0;
 315
 316         if (!open (STDIN, "</dev/null")) {
 317             POSIX::_exit (1);
 318             kill ('KILL', $$);
 319         }
 320
 321         # redirect STDOUT
 322         $fd = fileno(STDOUT);
 323         close STDOUT;
 324         POSIX::close (1) if $fd != 1;
 325
 326         if ($filename) {
 327             if (!open (STDOUT, ">&", $lockfh)) {
 328                 POSIX::_exit (1);
 329                 kill ('KILL', $$);
 330             }
 331
 332             STDOUT->autoflush (1);
 333         } else {
 334             if (!open (STDOUT, ">/dev/null")) {
 335                 POSIX::_exit (1);
 336                 kill ('KILL', $$);
 337             }
 338         }
 339
 340         #  redirect STDERR to STDOUT
 341         $fd = fileno (STDERR);
 342         close STDERR;
 343         POSIX::close(2) if $fd != 2;
 344
 345         if (!open (STDERR, ">&1")) {
 346             POSIX::_exit (1);
 347               kill ('KILL', $$);
 348           }
 349
 350         STDERR->autoflush (1);
 351
 352         my $pstart = PVE::Utils::read_proc_starttime ($$) ||
 353             die "unable to read process starttime";
 354
 355         my $upid = PVE::Utils::upid_encode ({
 356             pid => $$, pstart => $pstart, starttime => $starttime,
 357             type => $dtype, data => $data });
 358
 359         # sync with parent
 360         POSIX::write ($psync[1], $upid, length ($upid));
 361         POSIX::close ($psync[1]);
 362
 363         &$function ($upid);
 364
 365         die "should not be reached";
 366     }
 367
 368     POSIX::close ($psync[1]);
 369
 370     # sync with child (wait until child starts)
 371     my $upid = '';
 372     POSIX::read($psync[0], $upid, 4096);
 373     POSIX::close ($psync[0]);
 374
 375     if ($lockfh) {
 376         undef $lockfh; # close
 377     }
 378
 379     my $uh = PVE::Utils::upid_decode ($upid);
 380     if (!$uh ||
 381         !($uh->{pid} == $cpid && $uh->{starttime} == $starttime &&
 382           $uh->{type} eq $dtype && $uh->{data} eq $data)) {
 383         syslog ('err', "got strange upid - $upid\n");
 384     }
 385
 386     PVE::Utils::register_worker ($cpid);
 387
 388     return $upid;
 389 };
 390
 391 # UPID: unique worker process descriptor
 392 #
 393 # general format used by fork_worker is
 394 # UPID:$pid-$pstart:$start:$type:$data
 395 #
 396 # $pid    ... process id of worker
 397 # $pstart ... process start time from /proc/pid/stat
 398 # $start  ... time (epoch) when process started
 399 # $type   ... string to identity format of $data
 400 # $data   ... arbitrary text
 401 #
 402 # speicalized format we use is
 403 # UPID:$pid-$pstart:$start:vmops:$command:$cid:$veid
 404 #
 405 # $command    ... create, start, stop, destroy
 406 # $cid,$veid  ... cluster identity of VE
 407 #
 408 # Note: PIDs are recycled, so to test if a process is still running
 409 # we use (PID,PSTART) pair.
 410
 411 my $vmcommand = sub { # private method
 412     my ($class, $userid, $command, $cid, $veid, $code) = @_;
 413
 414     my $remip;
 415     my $remcmd = [];
 416
 417     $userid = 'unknown' if !$userid;
 418
 419     my $cinfo = PVE::Cluster::clusterinfo ();
 420
 421     if ($cid != $cinfo->{local}->{cid}) {
 422         $remip = $cinfo->{"CID_$cid"}->{ip};
 423         # we force tty allocation in order to tranfer signals (kill)
 424         $remcmd = ['/usr/bin/ssh', '-t', '-t', '-n', '-o', 'BatchMode=yes', $remip];
 425     }
 426
 427     my $realcmd = sub {
 428         my $upid = shift;
 429
 430         print "$upid\n";
 431
 432         my $res = -1;
 433
 434         eval {
 435             $res = &$code ($upid, $remip, $remcmd, $cinfo);
 436
 437             my $ticket = $class->$get_ticket();
 438
 439             my $rcon = PVE::ConfigClient::connect ($ticket, $cinfo, $cid);
 440             if (my $vzlist = $rcon->vzlist()->result) {
 441                 PVE::Config::update_file ('vzlist', $vzlist, $cid);
 442             }
 443         };
 444
 445         my $err = $@;
 446
 447         if ($err) {
 448             syslog ('err', $err);
 449             print STDERR "\n$err";
 450             exit (-1);
 451         }
 452
 453         print STDERR "\n"; # flush
 454         exit ($res);
 455     };
 456
 457     if (my $uid = $class->$fork_worker ('vmops', "$command:$cid:$veid:$userid", $realcmd)) {
 458
 459         PVE::Config::update_file ("vmops", $uid);
 460
 461         return $uid;                 ;
 462     }
 463
 464     return undef;
 465 };
 466
 467 sub apl_start_download {  ##SOAP_EXPORT##
 468     my ($class, $aplname) = @_;
 469
 470     my $userid = $class->$get_userid();
 471
 472     my $pkglist = PVE::APLInfo::load_data();
 473
 474     my $data;
 475
 476     if (!$pkglist || !$aplname || !($data = $pkglist->{'all'}->{$aplname})) {
 477         syslog ('err', "download failed: no aplinfo for appliance '$aplname'");
 478         return;
 479     }
 480
 481     my $realcmd = sub {
 482         my $upid = shift;
 483
 484         print "$upid\n";
 485
 486         my $tmp = "/tmp/apldownload-$$-tmp.dat";
 487
 488         eval {
 489             my $msg = "starting download: $aplname";
 490             syslog ('info', $msg);
 491             print STDERR "$msg\n";
 492
 493             my $src = $data->{location};
 494             my $dest = "/var/lib/vz/template/cache/$aplname";
 495
 496             if (-f $dest) {
 497                 my $md5 = (split (/\s/, `md5sum '$dest'`))[0];
 498
 499                 if ($md5 && (lc($md5) eq lc($data->{md5sum}))) {
 500                     $msg = "file already exists $md5 - no need to download";
 501                     syslog ('info', $msg);
 502                     print STDERR "$msg\n";
 503                     return;
 504                 }
 505             }
 506
 507             local %ENV;
 508             my $pvecfg = PVE::Config::read_file('pvecfg');
 509             if ($pvecfg && $pvecfg->{http_proxy}) {
 510                 $ENV{http_proxy} = $pvecfg->{http_proxy};
 511             }
 512
 513             my @cmd = ('/usr/bin/wget', '--progress=dot:mega', '-O', $tmp, $src);
 514             if (system (@cmd) != 0) {
 515                 die "download failed - $!\n";
 516             }
 517
 518             my $md5 = (split (/\s/, `md5sum '$tmp'`))[0];
 519
 520             if (!$md5 || (lc($md5) ne lc($data->{md5sum}))) {
 521                 die "wrong checksum: $md5 != $data->{md5sum}\n";
 522             }
 523
 524             if (system ('mv', $tmp, $dest) != 0) {
 525                 die "unable to save file - $!\n";
 526             }
 527         };
 528
 529         my $err = $@;
 530
 531         unlink $tmp;
 532
 533         if ($err) {
 534             syslog ('err', $err);
 535             print STDERR "\n\ndownload failed: $err";
 536             exit (-1);
 537         }
 538
 539         syslog ('info', "download finished");
 540         print STDERR "download finished\n";
 541
 542         exit (0);
 543     };
 544
 545     if (my $uid = $class->$fork_worker ('apldownload', "$userid:$aplname", $realcmd)) {
 546         return $uid;
 547     }
 548
 549     return undef;
 550 }
 551
 552 sub vmconfig_set {  ##SOAP_EXPORT##
 553     my ($class, $cid, $veid, $type, $settings) = @_;
 554
 555     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 556
 557     my $userid = $class->$get_userid();
 558
 559     my $cinfo = PVE::Cluster::clusterinfo ();
 560
 561     my $remip;
 562     my $remcmd = [];
 563
 564     if ($cid != $cinfo->{local}->{cid}) {
 565         $remip = $cinfo->{"CID_$cid"}->{ip};
 566         $remcmd = ['/usr/bin/ssh', '-n', '-o', 'BatchMode=yes', $remip];
 567     }
 568
 569     return if !$settings;
 570
 571     my $param;
 572
 573     foreach my $key (keys %$settings) {
 574         die "invalid key '$key'" if $key !~ m/^\w+$/;
 575         my $v = $settings->{$key};
 576         next if !defined ($v);
 577         if (ref ($v) eq 'ARRAY') {
 578             foreach my $v1 (@$v) {
 579                 push @$param, "--$key", $remip ? PVE::Utils::shellquote ($v1) : $v1;
 580             }
 581         } else {
 582             push @$param, "--$key", $remip ?  PVE::Utils::shellquote ($v) : $v;
 583         }
 584     }
 585
 586     return if scalar (@$param) == 0;
 587
 588     $remip = 'localhost' if !$remip;
 589
 590     syslog ('info', "apply settings to VM $veid on node $cid ($remip)");
 591
 592     my @cmd;
 593
 594     if ($type eq 'openvz') {
 595         @cmd = (@$remcmd, '/usr/bin/pvectl', 'vzset', $veid, @$param);
 596     } else {
 597         @cmd = (@$remcmd, '/usr/sbin/qm', 'set', $veid, @$param);
 598     }
 599
 600     if (system (@cmd) != 0) {
 601         my $cmdstr = join (' ', @cmd);
 602         my $msg = "unable to apply VM settings, command failed: $cmdstr\n";
 603         syslog ('err', $msg);
 604         die "$msg\n";
 605     }
 606
 607     my $msg = "VM $veid settings applied";
 608     syslog ('info', $msg);
 609 }
 610
 611 # set cdrom for qemu/kvm
 612 sub vmconfig_setcdrom { ##SOAP_EXPORT##
 613     my ($class, $cid, $veid, $device, $volid) = @_;
 614
 615     my $userid = $class->$get_userid();
 616
 617     my $cinfo = PVE::Cluster::clusterinfo ();
 618
 619     my $remip;
 620     my $remcmd = [];
 621
 622     if ($cid != $cinfo->{local}->{cid}) {
 623         $remip = $cinfo->{"CID_$cid"}->{ip};
 624         $remcmd = ['/usr/bin/ssh', '-n', '-o', 'BatchMode=yes', $remip];
 625     }
 626
 627     my $param;
 628
 629     die "invalid device name '$device'" if $device !~ m/^\w+$/;
 630
 631     push @$param, "--$device",  $remip ?  PVE::Utils::shellquote ($volid) : $volid;
 632
 633     return if scalar (@$param) == 0;
 634
 635     $remip = 'localhost' if !$remip;
 636
 637     syslog ('info', "setting cdrom on VM $veid on node $cid ($remip)");
 638
 639     my @cmd = (@$remcmd, '/usr/sbin/qm', 'cdrom', $veid, @$param);
 640
 641     if (system (@cmd) != 0) {
 642         my $cmdstr = join (' ', @cmd);
 643         my $msg = "unable to set cdrom, command failed: $cmdstr\n";
 644         syslog ('err', $msg);
 645         die "$msg\n";
 646     }
 647
 648     my $msg = "VM $veid set cdrom";
 649     syslog ('info', $msg);
 650 }
 651
 652 # delete unused qemu/kvm disk images
 653 sub qemu_unlink_disk { ##SOAP_EXPORT##
 654     my ($class, $cid, $veid, $filename) = @_;
 655
 656     my $userid = $class->$get_userid();
 657
 658     my $cinfo = PVE::Cluster::clusterinfo ();
 659
 660     my $remip;
 661     my $remcmd = [];
 662
 663     if ($cid != $cinfo->{local}->{cid}) {
 664         $remip = $cinfo->{"CID_$cid"}->{ip};
 665         $remcmd = ['/usr/bin/ssh', '-n', '-o', 'BatchMode=yes', $remip];
 666     }
 667
 668     $remip = 'localhost' if !$remip;
 669
 670     syslog ('info', "delete image '$filename' on VM $veid on node $cid ($remip)");
 671
 672     my @cmd = (@$remcmd, '/usr/sbin/qm', 'unlink', $veid, $filename);
 673
 674     if (system (@cmd) != 0) {
 675         my $cmdstr = join (' ', @cmd);
 676         my $msg = "unable to delete image, command failed: $cmdstr\n";
 677         syslog ('err', $msg);
 678         die "$msg\n";
 679     }
 680
 681     my $msg = "VM $veid image '$filename' successfuly deleted";
 682     syslog ('info', $msg);
 683 }
 684
 685 sub vmcommand_create { ##SOAP_EXPORT##
 686     my ($class, $cid, $veid, $type, $settings) = @_;
 687
 688     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 689
 690     my $userid = $class->$get_userid();
 691
 692     return $class->$vmcommand ($userid, 'create', $cid, $veid, sub {
 693         my ($upid, $remip, $remcmd, $cinfo) = @_;
 694
 695
 696         my @cmd;
 697
 698         if ($type eq 'openvz') {
 699             @cmd = (@$remcmd, '/usr/bin/pvectl', 'vzcreate', $veid);
 700         } else {
 701             @cmd = (@$remcmd, '/usr/sbin/qm', 'create', $veid);
 702         }
 703
 704         foreach my $key (keys %$settings) {
 705             die "invalid key '$key'" if $key !~ m/^\w+$/;
 706             my $v = $settings->{$key};
 707             next if !defined ($v);
 708             if (ref ($v) eq 'ARRAY') {
 709                 foreach my $v1 (@$v) {
 710                     push @cmd, "--$key", $remip ?  PVE::Utils::shellquote ($v1) : $v1;
 711                 }
 712             } else {
 713                 push @cmd, "--$key", $remip ?  PVE::Utils::shellquote ($v) : $v;
 714             }
 715         }
 716
 717         $remip = 'localhost' if !$remip;
 718
 719         syslog ('info', "creating new VM $veid on node $cid ($remip)");
 720
 721         my $cmdstr = join (' ', @cmd);
 722         print "$cmdstr\n";
 723
 724         if (system (@cmd) != 0) {
 725
 726             my $msg = "unable to apply VM settings - $!";
 727             syslog ('err', $msg);
 728             print "$msg\n";
 729             return -1;
 730         }
 731
 732         my $msg = "VM $veid created";
 733         syslog ('info', $msg);
 734         print "$msg\n";
 735
 736         return 0;
 737     });
 738 }
 739
 740 sub vmcommand_destroy { ##SOAP_EXPORT##
 741     my ($class, $cid, $veid, $type) = @_;
 742
 743     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 744
 745     my $userid = $class->$get_userid();
 746
 747     return $class->$vmcommand ($userid, 'destroy', $cid, $veid, sub {
 748         my ($upid, $remip, $remcmd, $cinfo) = @_;
 749
 750         $remip = 'localhost' if !$remip;
 751
 752         syslog ('info', "destroying VM $veid on node $cid ($remip)");
 753
 754         my @cmd;
 755
 756         if ($type eq 'openvz') {
 757             @cmd = (@$remcmd, '/usr/sbin/vzctl', 'destroy', $veid);
 758         } else {
 759             @cmd = (@$remcmd, '/usr/sbin/qm', 'destroy', $veid);
 760         }
 761
 762         my $cmdstr = join (' ', @cmd);
 763
 764         print "$cmdstr\n";
 765
 766         if (system (@cmd) != 0) {
 767             my $msg = "VM $veid destroy failed - $!";
 768             syslog ('err', $msg);
 769             print "$msg\n";
 770             return -1;
 771         }
 772
 773         my $msg = "VM $veid destroyed";
 774         syslog ('info', $msg);
 775         print "$msg\n";
 776
 777         return 0;
 778     });
 779 }
 780
 781 sub vmcommand_stop { ##SOAP_EXPORT##
 782     my ($class, $cid, $veid, $type, $force) = @_;
 783
 784     my $userid = $class->$get_userid();
 785
 786     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 787
 788     return $class->$vmcommand ($userid, 'stop', $cid, $veid, sub {
 789         my ($upid, $remip, $remcmd, $cinfo) = @_;
 790
 791         $remip = 'localhost' if !$remip;
 792
 793         syslog ('info', "stopping VM $veid on node $cid ($remip)");
 794
 795         my @cmd;
 796
 797         if ($type eq 'openvz') {
 798             @cmd = (@$remcmd, '/usr/sbin/vzctl', 'stop', $veid);
 799             push @cmd, '--fast' if $force;
 800         } else {
 801             @cmd = (@$remcmd, '/usr/sbin/qm', $force ? 'stop' : 'shutdown', $veid);
 802         }
 803
 804         my $cmdstr = join (' ', @cmd);
 805
 806         print "$cmdstr\n";
 807
 808         if (system (@cmd) != 0) {
 809             my $msg = "VM $veid stop failed - $!";
 810             syslog ('err', $msg);
 811             print "$msg\n";
 812             return -1;
 813         }
 814
 815         my $msg = "VM $veid stopped";
 816         syslog ('info', $msg);
 817         print "$msg\n";
 818
 819         return 0;
 820     });
 821 }
 822
 823 sub vmcommand_umount { ##SOAP_EXPORT##
 824     my ($class, $cid, $veid, $type) = @_;
 825
 826     die "unknown virtualization type '$type'\n" if $type ne 'openvz';
 827
 828     my $userid = $class->$get_userid();
 829
 830     return $class->$vmcommand ($userid, 'umount', $cid, $veid, sub {
 831         my ($upid, $remip, $remcmd, $cinfo) = @_;
 832
 833         $remip = 'localhost' if !$remip;
 834
 835         syslog ('info', "unmounting VM $veid on node $cid ($remip)");
 836
 837         my @cmd;
 838
 839         @cmd = (@$remcmd, '/usr/sbin/vzctl', 'umount', $veid);
 840
 841         my $cmdstr = join (' ', @cmd);
 842
 843         print "$cmdstr\n";
 844
 845         if (system (@cmd) != 0) {
 846             my $msg = "VM $veid umount failed - $!";
 847             syslog ('err', $msg);
 848             print "$msg\n";
 849             return -1;
 850         }
 851
 852         my $msg = "VM $veid unmounted";
 853         syslog ('info', $msg);
 854         print "$msg\n";
 855
 856         return 0;
 857     });
 858 }
 859
 860 sub vmcommand_start { ##SOAP_EXPORT##
 861     my ($class, $cid, $veid, $type) = @_;
 862
 863     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 864
 865     my $userid = $class->$get_userid();
 866
 867     return $class->$vmcommand ($userid, 'start', $cid, $veid, sub {
 868         my ($upid, $remip, $remcmd, $cinfo) = @_;
 869
 870         $remip = 'localhost' if !$remip;
 871
 872         syslog ('info', "starting VM $veid on node $cid ($remip)");
 873
 874         my @cmd;
 875
 876         if ($type eq 'openvz') {
 877             @cmd = (@$remcmd, '/usr/sbin/vzctl', 'start', $veid);
 878         } else {
 879             @cmd = (@$remcmd, '/usr/sbin/qm', 'start', $veid);
 880         }
 881
 882         my $cmdstr = join (' ', @cmd);
 883
 884         print "$cmdstr\n";
 885
 886         if (system (@cmd) != 0) {
 887             my $msg = "VM $veid start failed - $!";
 888             syslog ('err', $msg);
 889             print "$msg\n";
 890             return -1;
 891         }
 892
 893         my $msg = "VM $veid started";
 894         syslog ('info', $msg);
 895         print "$msg\n";
 896
 897         return 0;
 898     });
 899 }
 900
 901 sub vmcommand_restart {  ##SOAP_EXPORT##
 902     my ($class, $cid, $veid, $type) = @_;
 903
 904     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 905
 906     my $userid = $class->$get_userid();
 907
 908     return $class->$vmcommand ($userid, 'restart', $cid, $veid, sub {
 909         my ($upid, $remip, $remcmd, $cinfo) = @_;
 910
 911         $remip = 'localhost' if !$remip;
 912
 913         syslog ('info', "restarting VM $veid on node $cid ($remip)");
 914
 915         my @cmd;
 916
 917         if ($type eq 'openvz') {
 918             @cmd = (@$remcmd, '/usr/sbin/vzctl', 'restart', $veid);
 919         } else {
 920             @cmd = (@$remcmd, '/usr/sbin/qm', 'reset', $veid);
 921         }
 922         my $cmdstr = join (' ', @cmd);
 923
 924         print "$cmdstr\n";
 925
 926         if (system (@cmd) != 0) {
 927             my $msg = "VM $veid restart failed - $!";
 928             syslog ('err', $msg);
 929             print "$msg\n";
 930             return -1;
 931         }
 932
 933         my $msg = "VM $veid restarted";
 934         syslog ('info', $msg);
 935         print "$msg\n";
 936
 937         return 0;
 938     });
 939 }
 940
 941 sub vmcommand_migrate { ##SOAP_EXPORT##
 942     my ($class, $cid, $veid, $type, $target, $online) = @_;
 943
 944     die "unknown virtualization type '$type'\n" if !($type eq 'openvz' || $type eq 'qemu');
 945
 946     my $userid = $class->$get_userid();
 947
 948     my $cinfo = PVE::Cluster::clusterinfo ();
 949
 950     return $class->$vmcommand ($userid, 'migrate', $cid, $veid, sub {
 951         my ($upid, $remip, $remcmd, $cinfo) = @_;
 952
 953         $remip = 'localhost' if !$remip;
 954
 955         my $targetip = $cinfo->{"CID_$target"}->{ip};
 956
 957         syslog ('info', "migrating VM $veid from node $cid ($remip) to node $target ($targetip)");
 958
 959         my @cmd;
 960
 961         if ($type eq 'openvz') {
 962             @cmd = (@$remcmd, '/usr/sbin/vzmigrate');
 963             push @cmd, '--online' if $online;
 964             push @cmd, $targetip;
 965             push @cmd, $veid;
 966         } else {
 967             @cmd = (@$remcmd, '/usr/sbin/qmigrate');
 968             push @cmd, '--online' if $online;
 969             push @cmd, $targetip;
 970             push @cmd, $veid;
 971         }
 972
 973         my $cmdstr = join (' ', @cmd);
 974
 975         print "$cmdstr\n";
 976
 977         if (system (@cmd) != 0) {
 978             my $msg = "VM $veid migration failed - $!";
 979             syslog ('err', $msg);
 980             print "$msg\n";
 981             return -1;
 982         }
 983
 984         my $msg = "VM $veid migration done";
 985         syslog ('info', $msg);
 986         print "$msg\n";
 987
 988         return 0;
 989     });
 990 }
 991
 992 my $next_vnc_port = sub { # private method
 993
 994     for (my $p = 5900; $p < 6000; $p++) {
 995
 996         my $sock = IO::Socket::INET->new (Listen => 5,
 997                                           LocalAddr => 'localhost',
 998                                           LocalPort => $p,
 999                                           ReuseAddr => 1,
1000                                           Proto     => 0);
1001
1002         if ($sock) {
1003             close ($sock);
1004             return $p;
1005         }
1006     }
1007
1008     die "unable to find free vnc port";
1009 };
1010
1011 sub create_vnc_proxy {  ##SOAP_EXPORT##
1012     my ($class, $cid, $veid) = @_;
1013
1014     my $remip;
1015     my $remcmd = [];
1016
1017     my $userid = $class->$get_userid();
1018
1019     my $cinfo = PVE::Cluster::clusterinfo ();
1020
1021     if ($cid != $cinfo->{local}->{cid}) {
1022         $remip = $cinfo->{"CID_$cid"}->{ip};
1023         $remcmd = ['/usr/bin/ssh', '-T', '-o', 'BatchMode=yes', $remip];
1024     }
1025
1026     my $port = $class->$next_vnc_port();
1027     # generate ticket, olny first 8 character used by vnc
1028     my $ticket = Digest::SHA1::sha1_base64 ($userid, rand(), time());
1029
1030     my $timeout = 30;
1031
1032     my $realcmd = sub {
1033         my $upid = shift;
1034
1035         syslog ('info', "starting vnc proxy $upid\n");
1036
1037         my $qmcmd = [@$remcmd, "/usr/sbin/qm", 'vncproxy', $veid , $ticket];
1038
1039         my $qmstr = join (' ', @$qmcmd);
1040
1041         # also redirect stderr (else we get RFB protocol errors)
1042         my @cmd = ('/bin/nc', '-l', '-p', $port, '-w', $timeout, '-c', "$qmstr 2>/dev/null");
1043
1044         my $cmdstr = join (' ', @cmd);
1045         syslog ('info', "CMD: $cmdstr");
1046
1047         if (system (@cmd) != 0) {
1048             my $msg = "VM $veid vnc proxy failed - $?";
1049             syslog ('err', $msg);
1050             exit (-1);
1051         }
1052
1053         exit (0);
1054     };
1055
1056     if (my $uid = $class->$fork_worker ('vncproxy', "$cid:$veid:$userid:$port:$ticket", $realcmd)) {
1057         return { port => $port, ticket => $ticket};
1058     }
1059
1060     return undef;
1061
1062 }
1063
1064 sub create_vnc_console { ##SOAP_EXPORT##
1065     my ($class, $cid, $veid, $type, $status) = @_;
1066
1067     my $userid = $class->$get_userid();
1068
1069     my $remip;
1070     my $remcmd = [];
1071
1072     $userid = 'unknown' if !$userid;
1073
1074     my $cinfo = PVE::Cluster::clusterinfo ();
1075
1076     if ($cid != $cinfo->{local}->{cid}) {
1077         $remip = $cinfo->{"CID_$cid"}->{ip};
1078         $remcmd = ['/usr/bin/ssh', '-t', $remip];
1079     }
1080
1081     my $port = $class->$next_vnc_port();
1082     # generate ticket, olny first 8 character used by vnc
1083     my $ticket = Digest::SHA1::sha1_base64 ($userid, rand(), time());
1084
1085     my $timeout = 1; # immediately exit when last client disconnects
1086
1087     my $realcmd = sub {
1088         my $upid = shift;
1089
1090         syslog ('info', "starting vnc console $upid\n");
1091
1092         # fixme: use ssl
1093
1094         my $pwfile = "/tmp/.vncpwfile.$$";
1095
1096         my $vzcmd;
1097
1098         if ($type eq 'openvz') {
1099             if ($status eq 'running') {
1100                 $vzcmd = [ '/usr/sbin/vzctl', 'enter', $veid ];
1101             } elsif ($status eq 'mounted') {
1102                 $vzcmd = [ "/usr/bin/pvebash", $veid, 'root'];
1103             } else {
1104                 $vzcmd = [ "/usr/bin/pvebash", $veid, 'private'];
1105             }
1106         } elsif ($type eq 'qemu') {
1107             $vzcmd = [ "/usr/sbin/qm", 'monitor', $veid ];
1108         } else {
1109             $vzcmd = [ '/bin/true' ]; # should not be reached
1110         }
1111
1112         my @cmd = ('/usr/bin/vncterm', '-rfbport', $port,
1113                    '-passwdfile', "rm:$pwfile",
1114                    '-timeout', $timeout, '-c', @$remcmd, @$vzcmd);
1115
1116         my $cmdstr = join (' ', @cmd);
1117         syslog ('info', "CMD: $cmdstr");
1118
1119         my $fh = IO::File->new ($pwfile, "w", 0600);
1120         print $fh "$ticket\n";
1121         $fh->close;
1122
1123         if (system (@cmd) != 0) {
1124             my $msg = "VM $veid console viewer failed - $?";
1125             syslog ('err', $msg);
1126             exit (-1);
1127         }
1128
1129         exit (0);
1130     };
1131
1132     if (my $uid = $class->$fork_worker ('vncview', "$cid:$veid:$userid:$port:$ticket", $realcmd)) {
1133
1134         #PVE::Config::update_file ("vncview", $uid);
1135
1136         return { port => $port, ticket => $ticket};
1137     }
1138
1139     return undef;
1140
1141 }
1142
1143 sub service_cmd { ##SOAP_EXPORT##
1144     my ($class, $service, $cmd) = @_;
1145
1146     my $userid = $class->$get_userid();
1147
1148     eval {
1149         my $res = PVE::Utils::service_cmd ($service, $cmd);
1150         syslog ('info', $res) if $res;
1151         syslog ('info', "service command '$service $cmd' successful");
1152     };
1153
1154     if (my $err = $@) {
1155         syslog ('err', "service command '$service $cmd' failed : $err");
1156     }
1157 }
1158
1159 my $service_list = {
1160     apache => { short => 'WWW', long => 'Web Server' },
1161     pvetunnel => { short => 'ClusterTunnel',
1162                    long => 'PVE Cluster Tunnel Daemon' },
1163     pvemirror => { short => 'ClusterSync',
1164                    long => 'PVE Cluster Synchronization Daemon' },
1165     postfix => { short => 'SMTP', long => 'Simple Mail Tranfer Protocol' },
1166     ntpd => { short => 'NTP', long => 'Network Time Protocol' },
1167     sshd => { short => 'SSH', long => 'Secure Shell Daemon' },
1168     # bind => { short => 'BIND', long => 'Local DNS Cache' },
1169     # pvedaemon => { short => 'NodeManager', long => 'PVE Node Manager Daemon' },
1170 };
1171
1172 sub service_state_all { ##SOAP_EXPORT##
1173     my ($class) = @_;
1174
1175     my $userid = $class->$get_userid();
1176
1177     my $res = {};
1178
1179     foreach my $s (keys %{$service_list}) {
1180         $res->{$s} = $service_list->{$s};
1181         $res->{$s}->{status} = PVE::Utils::service_state ($s);
1182     }
1183
1184     return $res;
1185 }
1186
1187 sub restart_server {  ##SOAP_EXPORT##
1188     my ($class, $poweroff) = @_;
1189
1190     my $userid = $class->$get_userid();
1191
1192     if ($poweroff) {
1193         system ("(sleep 2;/sbin/poweroff)&");
1194     } else {
1195         system ("(sleep 2;shutdown -r now)&");
1196     }
1197 }
1198
1199 sub check_worker { ##SOAP_EXPORT##
1200     my ($class, $upid, $killit) = @_;
1201
1202     my $userid = $class->$get_userid();
1203
1204     if (my $upid_hash = PVE::Utils::upid_decode ($upid)) {
1205
1206         my $pid = $upid_hash->{pid};
1207
1208         # test if still running
1209         return 0 if !PVE::Utils::check_process ($pid, $upid_hash->{pstart});
1210
1211         if ($killit) {
1212
1213             # send kill to process group (negative pid)
1214             my $kpid = -$pid;
1215
1216             kill (15, $kpid); # send TERM signal
1217
1218             # give max 5 seconds to shut down
1219             # note: waitpid only work for child processes, but not
1220             # for processes spanned by other processes, so we use
1221             # kill to detect if the worker is still running
1222             for (my $i = 0; $i < 5; $i++) {
1223                 last if !kill (0, $kpid);
1224                 sleep (1);
1225             }
1226
1227             if (kill (0, $kpid)) {
1228                 kill (9, $kpid); # kill if still alive
1229             }
1230
1231             return 0; # killed, not running
1232         } else {
1233             return 1; # running
1234         }
1235     }
1236
1237     return 0;
1238 }
1239
1240 sub kvm_version { ##SOAP_EXPORT##
1241     my ($class) = @_;
1242
1243     my $userid = $class->$get_userid();
1244
1245     return PVE::QemuServer::kvm_version();
1246 }
1247
1248 sub install_template { ##SOAP_EXPORT##
1249     my ($class, $storeid, $type, $tmpname, $filename) = @_;
1250
1251     my $userid = $class->$get_userid();
1252
1253     my $cfg = PVE::Config::read_file ("storagecfg");
1254
1255     PVE::Storage::install_template ($cfg, $storeid, $type, $tmpname, $filename);
1256 }
1257
1258 sub delete_volume { ##SOAP_EXPORT##
1259     my ($class, $volid) = @_;
1260
1261     my $userid = $class->$get_userid();
1262
1263     my $cfg = PVE::Config::read_file ("storagecfg");
1264
1265     PVE::Storage::vdisk_free ($cfg, $volid);
1266 }
1267
1268 sub get_config_data { ##SOAP_EXPORT##
1269     my ($class, $id, $full) = @_;
1270
1271     my $userid = $class->$get_userid();
1272
1273     return PVE::Config::read_file ($id, $full);
1274 }
1275
1276 sub set_config_data { ##SOAP_EXPORT##
1277     my ($class, $id, $data, $full) = @_;
1278
1279     my $userid = $class->$get_userid();
1280
1281     return PVE::Config::write_file ($id, $data, $full);
1282 }
1283
1284 sub update_config_data { ##SOAP_EXPORT##
1285     my ($class, $id, $data, @param) = @_;
1286
1287     my $userid = $class->$get_userid();
1288
1289     return PVE::Config::update_file ($id, $data, @param);
1290 }
1291
1292 sub discard_config_changes { ##SOAP_EXPORT##
1293     my ($class, $id, $full) = @_;
1294
1295     my $userid = $class->$get_userid();
1296
1297     return PVE::Config::discard_changes ($id, $full);
1298 }
1299
1300 sub modify_user { ##SOAP_EXPORT##
1301     my ($class, $username, $group, $pw, $comment) = @_;
1302
1303     my $userid = $class->$get_userid();
1304
1305     return PVE::Utils::modify_user ($username, $group, $pw, $comment);
1306 }
1307
1308 sub storage_list_volumes { ##SOAP_EXPORT##
1309     my ($class, $storeid) = @_;
1310
1311     my $userid = $class->$get_userid();
1312
1313     my $cfg = PVE::Config::read_file ("storagecfg");
1314
1315     return PVE::Storage::vdisk_list ($cfg, $storeid);
1316 }
1317
1318 sub storage_list_iso {  ##SOAP_EXPORT##
1319     my ($class, $storeid) = @_;
1320
1321     my $userid = $class->$get_userid();
1322
1323     my $cfg = PVE::Config::read_file ("storagecfg");
1324
1325     return PVE::Storage::template_list ($cfg, $storeid, 'iso');
1326 }
1327
1328 sub storage_list_vztmpl {  ##SOAP_EXPORT##
1329     my ($class, $storeid) = @_;
1330
1331     my $userid = $class->$get_userid();
1332
1333     my $cfg = PVE::Config::read_file ("storagecfg");
1334
1335     return PVE::Storage::template_list ($cfg, $storeid, 'vztmpl');
1336 }
1337
1338 sub storage_list_backups {  ##SOAP_EXPORT##
1339     my ($class, $storeid) = @_;
1340
1341     my $userid = $class->$get_userid();
1342
1343     my $cfg = PVE::Config::read_file ("storagecfg");
1344
1345     return PVE::Storage::template_list ($cfg, $storeid, 'backup');
1346 }
1347
1348 sub storage_list_vgs {  ##SOAP_EXPORT##
1349     my ($class) = @_;
1350
1351     my $userid = $class->$get_userid();
1352
1353     my $cfg = PVE::Config::read_file ("storagecfg");
1354
1355     return PVE::Storage::lvm_vgs ();
1356 }
1357
1358 sub storage_add { ##SOAP_EXPORT##
1359     my ($class, $storeid, $type, $param) = @_;
1360
1361     my $userid = $class->$get_userid();
1362
1363     PVE::Storage::storage_add ($storeid, $type, $param);
1364 }
1365
1366 sub storage_set { ##SOAP_EXPORT##
1367     my ($class, $storeid, $param, $digest) = @_;
1368
1369     my $userid = $class->$get_userid();
1370
1371     PVE::Storage::storage_set ($storeid, $param, $digest);
1372 }
1373
1374 sub storage_remove { ##SOAP_EXPORT##
1375     my ($class, $storeid, $digest) = @_;
1376
1377     my $userid = $class->$get_userid();
1378
1379     PVE::Storage::storage_remove ($storeid, $digest);
1380 }
1381
1382 sub storage_enable { ##SOAP_EXPORT##
1383     my ($class, $storeid, $digest) = @_;
1384
1385     my $userid = $class->$get_userid();
1386
1387     PVE::Storage::storage_enable ($storeid, $digest);
1388 }
1389
1390 sub storage_disable { ##SOAP_EXPORT##
1391     my ($class, $storeid, $digest) = @_;
1392
1393     my $userid = $class->$get_userid();
1394
1395     PVE::Storage::storage_disable ($storeid, $digest);
1396 }
1397
1398 sub storage_scan_nfs { ##SOAP_EXPORT##
1399     my ($class, $server) = @_;
1400
1401     my $userid = $class->$get_userid();
1402
1403     return PVE::Storage::scan_nfs ($server);
1404 }
1405
1406 sub storage_scan_iscsi { ##SOAP_EXPORT##
1407     my ($class, $portal, $skip_used) = @_;
1408
1409     my $userid = $class->$get_userid();
1410
1411     my $res = PVE::Storage::scan_iscsi ($portal);
1412
1413     return $res if !$skip_used;
1414
1415     my $cfg = PVE::Config::read_file ("storagecfg");
1416
1417     my $unused = {};
1418     foreach my $target (keys %$res) {
1419         if (!PVE::Storage::target_is_used ($cfg, $target)) {
1420             $unused->{$target} = $res->{target}
1421         }
1422     }
1423     return $unused;
1424 }
1425
1426 sub storage_user_info { ##SOAP_EXPORT##
1427     my ($class, $vmid) = @_;
1428
1429     my $userid = $class->$get_userid();
1430
1431     my $cfg = PVE::Config::read_file ("storagecfg");
1432
1433     my $info = PVE::Storage::storage_info ($cfg);
1434
1435     my $res = { cfg => $cfg };
1436
1437     foreach my $storeid (PVE::Storage::storage_ids ($cfg)) {
1438         my $scfg = PVE::Storage::storage_config ($cfg, $storeid);
1439
1440         next if $scfg->{disable};
1441
1442         # fixme: check user access rights - pass username with connection?
1443
1444         $res->{info}->{$storeid} = $info->{$storeid};
1445
1446         if ($scfg->{content}->{rootdir}) {
1447             $res->{rootdir}->{$storeid} = 1;
1448             $res->{rootdir_default} = $storeid
1449                 if !$res->{rootdir_default};
1450         }
1451
1452         if ($scfg->{content}->{vztmpl}) {
1453             $res->{vztmpl}->{$storeid} = 1;
1454             $res->{vztmpl_default} = $storeid
1455                 if !$res->{vztmpl_default};
1456         }
1457
1458         if ($scfg->{content}->{images}) {
1459             $res->{images}->{$storeid} = 1;
1460             $res->{images_default} = $storeid
1461                 if !$res->{images_default};
1462         }
1463
1464         if ($scfg->{content}->{iso}) {
1465             $res->{iso}->{$storeid} = 1;
1466             $res->{iso_default} = $storeid
1467                 if !$res->{iso_default};
1468         }
1469
1470         if ($scfg->{content}->{backup}) {
1471             $res->{backup}->{$storeid} = 1;
1472             $res->{backup_default} = $storeid
1473                 if !$res->{backup_default};
1474         }
1475     }
1476
1477     # include disk list
1478     if ($vmid) {
1479         $res->{imagelist} = PVE::Storage::vdisk_list ($cfg, undef, $vmid);
1480     }
1481
1482
1483     return $res;
1484 }
1485
1486 sub get_storage_status { ##SOAP_EXPORT##
1487     my ($class) = @_;
1488
1489     my $userid = $class->$get_userid();
1490
1491     # fixme: check user access rights
1492
1493     my $cfg = PVE::Config::read_file ("storagecfg");
1494
1495     my $info = PVE::Storage::storage_info ($cfg);
1496
1497     return { cfg => $cfg, info => $info };
1498 }
1499
1500 ##FILTER_DATA## do not remove this line
1501
1502 package PVE::SOAPSerializer;
1503
1504 use strict;
1505 use SOAP::Lite;
1506 use vars qw(@ISA);
1507 use HTML::Entities;
1508
1509 @ISA = qw (SOAP::Serializer);
1510
1511 sub new {
1512     my $class = shift;
1513
1514     my $self = $class->SUPER::new (@_);
1515
1516 # SOAP Serializer bug fix:
1517 # "a string with embeded URI 'http://exsample.com'" is encoded as URI!
1518 # should be a string instead
1519 #        'anyURI' =>
1520 #             [95, sub { $_[0] =~ /^(urn:)|(http:\/\/)/i; }, 'as_anyURI'],
1521 # regex should be: /^((urn:)|(http:\/\/))/i;
1522 # so we disbale that
1523     delete $self->{_typelookup}->{'anyURI'};
1524
1525 # SOAP Serializer bug fix:
1526 # by default utf8 strings are serialized as base64Binary - unfortunately
1527 # that way the utf8 flags gets lost, so we provide our own encoding
1528 # see bug #2860559 on sourgeforge project page
1529     $self->{_typelookup}->{'utf8string'} =
1530         [5, sub { Encode::is_utf8($_[0]) }, 'as_utf8string'],
1531
1532     return $self;
1533 }
1534
1535 sub as_utf8string {
1536     my ($self, $value, $name, $type, $attr) = @_;
1537
1538     return [
1539         $name,
1540         {'xsi:type' => 'xsd:string', %$attr},
1541         HTML::Entities::encode_entities_numeric ($value)
1542     ];
1543 }
1544
1545 package PVE::SOAPTransport;
1546
1547 use strict;
1548 use vars qw(@ISA);
1549 use SOAP::Transport::HTTP;
1550 use MIME::Base64;
1551 use PVE::SafeSyslog;
1552 use PVE::Config;
1553 use POSIX qw(EINTR);
1554 use POSIX ":sys_wait_h";
1555 use IO::Handle;
1556 use IO::Select;
1557 use vars qw(@ISA);
1558
1559 # This is a quite simple pre-fork server
1560
1561 @ISA = qw(SOAP::Transport::HTTP::Daemon);
1562
1563 my $workers = {};
1564
1565 my $max_workers = 2;    # pre-forked worker processes
1566 my $max_requests = 500; # max requests per worker
1567
1568 sub worker_finished {
1569     my $cpid = shift;
1570
1571     syslog ('info', "worker $cpid finished");
1572 }
1573
1574 sub finish_workers {
1575     local $!; local $?;
1576     foreach my $cpid (keys %$workers) {
1577         my $waitpid = waitpid ($cpid, WNOHANG);
1578         if (defined($waitpid) && ($waitpid == $cpid)) {
1579             delete ($workers->{$cpid});
1580             worker_finished ($cpid);
1581         }
1582     }
1583 }
1584
1585 sub test_workers {
1586     foreach my $cpid (keys %$workers) {
1587         if (!kill(0, $cpid)) {
1588             waitpid($cpid, POSIX::WNOHANG());
1589             delete $workers->{$cpid};
1590             worker_finished ($cpid);
1591         }
1592     }
1593 }
1594
1595 sub start_workers {
1596     my $self = shift;
1597
1598     my $count = 0;
1599     foreach my $cpid (keys %$workers) {
1600         $count++;
1601     }
1602
1603     my $need = $max_workers - $count;
1604
1605     return if $need <= 0;
1606
1607     syslog ('info', "starting $need worker(s)");
1608
1609     while ($need > 0) {
1610         my $pid = fork;
1611
1612         if (!defined ($pid)) {
1613             syslog ('err', "can't fork worker");
1614             sleep (1);
1615         } elsif ($pid) { #parent
1616             $workers->{$pid} = 1;
1617             $0 = 'pvedaemon worker';
1618             syslog ('info', "worker $pid started");
1619             $need--;
1620         } else {
1621             $SIG{TERM} = $SIG{QUIT} = 'DEFAULT';
1622
1623             $SIG{USR1} = sub {
1624                 $self->{reload_config} = 1;
1625             };
1626
1627             eval {
1628                 # try to init inotify
1629                 PVE::Config::inotify_init();
1630
1631                 $self->handle_requests ();
1632             };
1633             syslog ('err', $@) if $@;
1634
1635
1636             exit (0);
1637         }
1638     }
1639 }
1640
1641 sub terminate_server {
1642
1643     foreach my $cpid (keys %$workers) {
1644         kill (15, $cpid); # TERM childs
1645     }
1646
1647     # nicely shutdown childs (give them max 10 seconds to shut down)
1648     my $previous_alarm = alarm (10);
1649     eval {
1650         local $SIG{ALRM} = sub { die "Timed Out!\n" };
1651
1652         1 while ((my $pid = waitpid (-1, 0)) > 0);
1653
1654     };
1655     alarm ($previous_alarm);
1656
1657     foreach my $cpid (keys %$workers) {
1658         !kill (0, $cpid) || kill (9, $cpid); # KILL childs still alive!
1659     }
1660 }
1661
1662 sub handle {
1663     my $self = shift;
1664     my $daemon = $self->new;
1665
1666     $self->{httpdaemon} = $daemon;
1667
1668     eval {
1669         my $old_sig_chld = $SIG{CHLD};
1670         local $SIG{CHLD} = sub {
1671             finish_workers ();
1672             &$old_sig_chld(@_);
1673         };
1674
1675         my $old_sig_term = $SIG{TERM};
1676         local $SIG{TERM} = sub {
1677             terminate_server ();
1678             &$old_sig_term(@_);
1679         };
1680         local $SIG{QUIT} = sub {
1681             terminate_server();
1682             &$old_sig_term(@_);
1683         };
1684
1685         local $SIG{USR1} = 'IGNORE';
1686
1687         local $SIG{HUP} = sub {
1688             syslog ("info", "received reload request");
1689             foreach my $cpid (keys %$workers) {
1690                 kill (10, $cpid); # SIGUSR1 childs
1691             }
1692         };
1693
1694         for (;;) { # forever
1695             $self->start_workers ();
1696             sleep (5);
1697             $self->test_workers ();
1698         }
1699     };
1700     my $err = $@;
1701
1702     if ($err) {
1703         syslog ('err', "ERROR: $err");
1704     }
1705 }
1706
1707 sub send_basic_auth_request {
1708     my ($c) = @_;
1709
1710     my $realm = 'PVE SOAP Server';
1711     my $auth_request_res = HTTP::Response->new(401, 'Unauthorized');
1712     $auth_request_res->header('WWW-Authenticate' => qq{Basic realm="$realm"});
1713     $auth_request_res->is_error(1);
1714     $auth_request_res->error_as_HTML(1);
1715     $c->send_response($auth_request_res);
1716 }
1717
1718 sub send_error {
1719     my ($c, $code, $msg) = @_;
1720
1721     $c->send_response(HTTP::Response->new($code, $msg));
1722 }
1723
1724 sub decode_basic_auth {
1725     my ($h) = @_;
1726
1727     my $authtxt = $h->header('Authorization');
1728     return undef if !$authtxt;
1729     my ($test, $auth) = split /\s+/, $authtxt;
1730     return undef if !$auth;
1731
1732     my $enc = MIME::Base64::decode ($auth);
1733
1734     return $enc;
1735 }
1736
1737 sub extract_auth_cookie {
1738     my ($h) = @_;
1739
1740     my $txt = $h->header('Cookie') || '';
1741
1742     return ($txt =~ /(?:^|\s)PVEAuthTicket=([^;]*)/)[0];
1743 }
1744
1745 sub ident_user {
1746     my ($peerport, $sockport) = @_;
1747
1748     my $filename = "/proc/net/tcp";
1749
1750     my $fh = IO::File->new($filename, "r") ||
1751         die "unable to open file '$filename'\n";
1752
1753     my $user;
1754
1755     my $remoteaddr = sprintf "0100007F:%04X", $sockport;
1756     my $localaddr = sprintf "0100007F:%04X", $peerport;
1757
1758     while (defined (my $line = <$fh>)) {
1759         $line =~ s/^\s+//;
1760         my @data = split (/\s+/, $line);
1761         if ($data[1] eq $localaddr &&
1762             $data[2] eq  $remoteaddr) {
1763             my $uid = $data[7];
1764             $user = getpwuid ($uid);
1765             last;
1766         }
1767     }
1768
1769     close ($fh);
1770
1771     die "unable to identify user connection\n" if !$user;
1772
1773     return $user;
1774 }
1775
1776 sub handle_login {
1777     my ($daemon, $c, $r) = @_;
1778
1779     # my $cuser = ident_user ($c->peerport, $c->sockport);
1780
1781     my $h =  $r->headers;
1782     my $action = $h->header('SOAPAction');
1783     if ($action !~ m|^(\"?)http://proxmox.com/PVE/ConfigServer\#(\w+)(\"?)$|) {
1784         send_error($c, 400, "Invalid SOAPAction");
1785         return undef;
1786     }
1787     my $method = $2;
1788     my $ticket = extract_auth_cookie($h);
1789     my $authheader = $h->header('Authorization');
1790
1791     if (!$ticket) {
1792         if (!$authheader || $authheader !~ m/^Basic\s+\S+$/) {
1793             send_basic_auth_request ($c);
1794             return undef;
1795         }
1796     }
1797
1798     my ($user, $group);
1799
1800     $daemon->request($r);
1801
1802     my $update;
1803
1804     if ($authheader) {
1805         my $auth = (split /\s+/, $authheader)[1];
1806         my $enc = MIME::Base64::decode ($auth);
1807         my $pw;
1808         ($user, $pw) = split (/:/, $enc, 2);
1809         if ($group = PVE::Utils::is_valid_user ($user, $pw)) {
1810             $ticket = PVE::Utils::create_auth_ticket ($daemon->{pve}->{secret}, $user, $group);
1811             $update = 1;
1812         } else {
1813             $daemon->make_fault($SOAP::Constants::FAULT_CLIENT,
1814                                 'Basic authentication failed');
1815             $c->send_response($daemon->response);
1816             return undef;
1817         }
1818     } elsif ($ticket) {
1819         ($user, $group) = PVE::Utils::verify_ticket ($daemon->{pve}->{secret}, $ticket);
1820         if (!($user && $group)) {
1821             $daemon->make_fault($SOAP::Constants::FAULT_CLIENT,
1822                                 "Ticket authentication failed - invalid ticket '$ticket'");
1823             $c->send_response($daemon->response);
1824             return undef;
1825         }
1826         if ($method eq 'update_ticket') {
1827             $ticket = PVE::Utils::create_auth_ticket ($daemon->{pve}->{secret}, $user, $group);
1828         }
1829     } else {
1830         $daemon->make_fault($SOAP::Constants::FAULT_CLIENT,
1831                             'Ticket authentication failed - no ticket');
1832         $c->send_response($daemon->response);
1833         return undef;
1834     }
1835
1836     return ($user, $group, $ticket, $update);
1837 }
1838
1839 sub handle_requests {
1840     my $self = shift;
1841
1842     my $daemon = $self->{httpdaemon};
1843
1844     my $rcount = 0;
1845
1846     my $sel = IO::Select->new();
1847     $sel->add ($daemon->{_daemon});
1848
1849     my $timeout = 5;
1850     my @ready;
1851     while (1) {
1852         if (scalar (@ready = $sel->can_read($timeout))) {
1853
1854             if (!$daemon->{pve}->{secret} || $self->{reload_config}) {
1855                 $self->{reload_config} = undef;
1856                 syslog ("info", "reloading configuration")
1857                     if $self->{reload_config};
1858                 $daemon->{pve}->{secret} = PVE::Utils::load_auth_secret();
1859             }
1860
1861             my $c;
1862             while (($c = $daemon->accept) || ($! == EINTR)) {
1863                 next if !$c; # EINTR
1864
1865                 $c->timeout(5);
1866
1867                 $daemon->{pve}->{username} = undef;
1868                 $daemon->{pve}->{groupname} = undef;
1869                 $daemon->{pve}->{ticket} = undef;
1870
1871                 # handle requests
1872                 while (my $r = $c->get_request) {
1873
1874                     my ($user, $group, $ticket, $update) = handle_login ($daemon, $c, $r);
1875                     last if !$user;
1876
1877                     $daemon->{pve}->{username} = $user;
1878                     $daemon->{pve}->{groupname} = $group;
1879                     $daemon->{pve}->{ticket} = $ticket;
1880                     $daemon->SOAP::Transport::HTTP::Server::handle;
1881
1882                     if ($update) {
1883                         $daemon->response->header ("Set-Cookie" => "PVEAuthTicket=$ticket");
1884                     }
1885
1886                     $c->send_response($daemon->response);
1887                 }
1888                 $rcount++;
1889
1890                 # we only handle one request per connection, because
1891                 # we want to minimize the number of connections
1892
1893                 $c->shutdown(2);
1894                 $c->close();
1895                 last;
1896             }
1897
1898             last if !$c || ($rcount >= $max_requests);
1899
1900         } else {
1901             # timeout
1902             PVE::Config::poll(); # read inotify events
1903         }
1904     }
1905 }
1906
1907 package PVE::ConfigClient;
1908
1909 use SOAP::Lite;
1910 use HTTP::Cookies;
1911 use HTTP::Headers;
1912 use PVE::Config;
1913
1914 my ($soaphost, $soapport) = PVE::Config::soap_host_port();
1915
1916 sub __create_soaplite {
1917     my ($timeout, $port, $ticket, $username, $password) = @_;
1918
1919     my $cookie_jar = HTTP::Cookies->new (ignore_discard => 1);
1920
1921     if ($ticket) {
1922         $cookie_jar->set_cookie(0, 'PVEAuthTicket', $ticket, '/', $soaphost);
1923     }
1924
1925     my $soap = SOAP::Lite
1926         -> serializer (PVE::SOAPSerializer->new)
1927         -> ns('http://proxmox.com/PVE/ConfigServer')
1928         -> on_fault (sub {
1929             my($soap, $res) = @_;
1930             die ref $res ? $res->faultstring : $soap->transport->status, "\n";
1931         })
1932         -> proxy("http://$soaphost:$port", timeout => $timeout,
1933                  cookie_jar => $cookie_jar);
1934
1935     if ($username && defined($password)) {
1936         $soap->proxy->credentials ("$soaphost:$port", 'PVE SOAP Server',
1937                                    $username, $password);
1938     }
1939
1940     return $soap;
1941 }
1942
1943 sub connect {
1944     my ($ticket, $cinfo, $cid) = @_;
1945
1946     die "no ticket specified" if !$ticket;
1947
1948     # set longet timeout for local connection
1949     my $timeout = $cid ? 10 : 120;
1950
1951     my $port = $soapport;
1952
1953     if ($cid) {
1954         die "invalid cluster ID '$cid'"
1955             if $cid !~ m/^\d+$/;
1956         my $ni;
1957         die "no config for cluster node '$cid'"
1958             if !($cinfo && ($ni = $cinfo->{"CID_$cid"}));
1959
1960         $port = $ni->{configport};
1961     }
1962
1963     return __create_soaplite ($timeout, $port, $ticket);
1964 }
1965
1966 sub update_ticket {
1967     my ($ticket) = @_;
1968
1969     die "no ticket specified" if !$ticket;
1970
1971
1972     if ($ticket !~ m/^((\S+)::\w+::\d+::[0-9a-f]{40})(::[0-9a-f]{40})?$/)  {
1973         die "got invalid ticket '$ticket'\n";
1974     }
1975
1976     $ticket = $1; # strip second checksum used by PVE::AuthCookieHandler
1977
1978     my $username = $2;
1979
1980     my $timeout = 120;
1981
1982     my $soap = __create_soaplite ($timeout, $soapport, $ticket);
1983
1984     my $nt = $soap->update_ticket()->result;
1985
1986     if ($ticket !~ m/^${username}::\w+::\d+::[0-9a-f]{40}$/)  {
1987         die "got invalid ticket '$ticket'\n";
1988     }
1989
1990     return $nt;
1991 }
1992
1993 sub request_ticket {
1994     my ($username, $password) = @_;
1995
1996     die "no username specified\n" if !$username;
1997     die "no password specified for user '$username'\n" if !defined ($password);
1998
1999     my $timeout = 120;
2000
2001     my $soap = __create_soaplite ($timeout, $soapport, undef, $username, $password);
2002
2003     my $ticket = $soap->update_ticket()->result;
2004
2005     if ($ticket !~ m/^${username}::\w+::\d+::[0-9a-f]{40}$/)  {
2006         die "got invalid ticket '$ticket'\n";
2007     }
2008
2009     return $ticket
2010 }
2011
2012 1;