PVE/API2/Qemu.pm

   1 package PVE::API2::Qemu;
   2
   3 use strict;
   4 use warnings;
   5 use Cwd 'abs_path';
   6
   7 use PVE::Cluster qw (cfs_read_file cfs_write_file);;
   8 use PVE::SafeSyslog;
   9 use PVE::Tools qw(extract_param);
  10 use PVE::Exception qw(raise raise_param_exc raise_perm_exc);
  11 use PVE::Storage;
  12 use PVE::JSONSchema qw(get_standard_option);
  13 use PVE::RESTHandler;
  14 use PVE::QemuServer;
  15 use PVE::QemuMigrate;
  16 use PVE::RPCEnvironment;
  17 use PVE::AccessControl;
  18 use PVE::INotify;
  19 use PVE::Network;
  20
  21 use Data::Dumper; # fixme: remove
  22
  23 use base qw(PVE::RESTHandler);
  24
  25 my $opt_force_description = "Force physical removal. Without this, we simple remove the disk from the config file and create an additional configuration entry called 'unused[n]', which contains the volume ID. Unlink of unused[n] always cause physical removal.";
  26
  27 my $resolve_cdrom_alias = sub {
  28     my $param = shift;
  29
  30     if (my $value = $param->{cdrom}) {
  31         $value .= ",media=cdrom" if $value !~ m/media=/;
  32         $param->{ide2} = $value;
  33         delete $param->{cdrom};
  34     }
  35 };
  36
  37
  38 my $check_storage_access = sub {
  39    my ($rpcenv, $authuser, $storecfg, $vmid, $settings, $default_storage) = @_;
  40
  41    PVE::QemuServer::foreach_drive($settings, sub {
  42         my ($ds, $drive) = @_;
  43
  44         my $isCDROM = PVE::QemuServer::drive_is_cdrom($drive);
  45
  46         my $volid = $drive->{file};
  47
  48         if (!$volid || $volid eq 'none') {
  49             # nothing to check
  50         } elsif ($isCDROM && ($volid eq 'cdrom')) {
  51             $rpcenv->check($authuser, "/", ['Sys.Console']);
  52         } elsif (!$isCDROM && ($volid =~ m/^(([^:\s]+):)?(\d+(\.\d+)?)$/)) {
  53             my ($storeid, $size) = ($2 || $default_storage, $3);
  54             die "no storage ID specified (and no default storage)\n" if !$storeid;
  55             $rpcenv->check($authuser, "/storage/$storeid", ['Datastore.AllocateSpace']);
  56         } else {
  57             $rpcenv->check_volume_access($authuser, $storecfg, $vmid, $volid);
  58         }
  59     });
  60 };
  61
  62 my $check_storage_access_clone = sub {
  63    my ($rpcenv, $authuser, $storecfg, $conf, $storage) = @_;
  64
  65    my $sharedvm = 1;
  66
  67    PVE::QemuServer::foreach_drive($conf, sub {
  68         my ($ds, $drive) = @_;
  69
  70         my $isCDROM = PVE::QemuServer::drive_is_cdrom($drive);
  71
  72         my $volid = $drive->{file};
  73
  74         return if !$volid || $volid eq 'none';
  75
  76         if ($isCDROM) {
  77             if ($volid eq 'cdrom') {
  78                 $rpcenv->check($authuser, "/", ['Sys.Console']);
  79             } else {
  80                 # we simply allow access
  81                 my ($sid, $volname) = PVE::Storage::parse_volume_id($volid);
  82                 my $scfg = PVE::Storage::storage_config($storecfg, $sid);
  83                 $sharedvm = 0 if !$scfg->{shared};
  84
  85             }
  86         } else {
  87             my ($sid, $volname) = PVE::Storage::parse_volume_id($volid);
  88             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
  89             $sharedvm = 0 if !$scfg->{shared};
  90
  91             $sid = $storage if $storage;
  92             $rpcenv->check($authuser, "/storage/$sid", ['Datastore.AllocateSpace']);
  93         }
  94     });
  95
  96    return $sharedvm;
  97 };
  98
  99 # Note: $pool is only needed when creating a VM, because pool permissions
 100 # are automatically inherited if VM already exists inside a pool.
 101 my $create_disks = sub {
 102     my ($rpcenv, $authuser, $conf, $storecfg, $vmid, $pool, $settings, $default_storage) = @_;
 103
 104     my $vollist = [];
 105
 106     my $res = {};
 107     PVE::QemuServer::foreach_drive($settings, sub {
 108         my ($ds, $disk) = @_;
 109
 110         my $volid = $disk->{file};
 111
 112         if (!$volid || $volid eq 'none' || $volid eq 'cdrom') {
 113             delete $disk->{size};
 114             $res->{$ds} = PVE::QemuServer::print_drive($vmid, $disk);
 115         } elsif ($volid =~ m/^(([^:\s]+):)?(\d+(\.\d+)?)$/) {
 116             my ($storeid, $size) = ($2 || $default_storage, $3);
 117             die "no storage ID specified (and no default storage)\n" if !$storeid;
 118             my $defformat = PVE::Storage::storage_default_format($storecfg, $storeid);
 119             my $fmt = $disk->{format} || $defformat;
 120             my $volid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $vmid,
 121                                                   $fmt, undef, $size*1024*1024);
 122             $disk->{file} = $volid;
 123             $disk->{size} = $size*1024*1024*1024;
 124             push @$vollist, $volid;
 125             delete $disk->{format}; # no longer needed
 126             $res->{$ds} = PVE::QemuServer::print_drive($vmid, $disk);
 127         } else {
 128
 129             my $path = $rpcenv->check_volume_access($authuser, $storecfg, $vmid, $volid);
 130
 131             my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
 132
 133             my $foundvolid = undef;
 134
 135             if ($storeid) {
 136                 PVE::Storage::activate_volumes($storecfg, [ $volid ]);
 137                 my $dl = PVE::Storage::vdisk_list($storecfg, $storeid, undef);
 138
 139                 PVE::Storage::foreach_volid($dl, sub {
 140                     my ($volumeid) = @_;
 141                     if($volumeid eq $volid) {
 142                         $foundvolid = 1;
 143                         return;
 144                     }
 145                 });
 146             }
 147
 148             die "image '$path' does not exists\n" if (!(-f $path || -b $path || $foundvolid));
 149
 150             my ($size) = PVE::Storage::volume_size_info($storecfg, $volid, 1);
 151             $disk->{size} = $size;
 152             $res->{$ds} = PVE::QemuServer::print_drive($vmid, $disk);
 153         }
 154     });
 155
 156     # free allocated images on error
 157     if (my $err = $@) {
 158         syslog('err', "VM $vmid creating disks failed");
 159         foreach my $volid (@$vollist) {
 160             eval { PVE::Storage::vdisk_free($storecfg, $volid); };
 161             warn $@ if $@;
 162         }
 163         die $err;
 164     }
 165
 166     # modify vm config if everything went well
 167     foreach my $ds (keys %$res) {
 168         $conf->{$ds} = $res->{$ds};
 169     }
 170
 171     return $vollist;
 172 };
 173
 174 my $check_vm_modify_config_perm = sub {
 175     my ($rpcenv, $authuser, $vmid, $pool, $key_list) = @_;
 176
 177     return 1 if $authuser eq 'root@pam';
 178
 179     foreach my $opt (@$key_list) {
 180         # disk checks need to be done somewhere else
 181         next if PVE::QemuServer::valid_drivename($opt);
 182
 183         if ($opt eq 'sockets' || $opt eq 'cores' ||
 184             $opt eq 'cpu' || $opt eq 'smp' ||
 185             $opt eq 'cpulimit' || $opt eq 'cpuunits') {
 186             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.CPU']);
 187         } elsif ($opt eq 'boot' || $opt eq 'bootdisk') {
 188             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Disk']);
 189         } elsif ($opt eq 'memory' || $opt eq 'balloon' || $opt eq 'shares') {
 190             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Memory']);
 191         } elsif ($opt eq 'args' || $opt eq 'lock') {
 192             die "only root can set '$opt' config\n";
 193         } elsif ($opt eq 'cpu' || $opt eq 'kvm' || $opt eq 'acpi' ||
 194                  $opt eq 'vga' || $opt eq 'watchdog' || $opt eq 'tablet') {
 195             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.HWType']);
 196         } elsif ($opt =~ m/^net\d+$/) {
 197             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Network']);
 198         } else {
 199             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Options']);
 200         }
 201     }
 202
 203     return 1;
 204 };
 205
 206 __PACKAGE__->register_method({
 207     name => 'vmlist',
 208     path => '',
 209     method => 'GET',
 210     description => "Virtual machine index (per node).",
 211     permissions => {
 212         description => "Only list VMs where you have VM.Audit permissons on /vms/<vmid>.",
 213         user => 'all',
 214     },
 215     proxyto => 'node',
 216     protected => 1, # qemu pid files are only readable by root
 217     parameters => {
 218         additionalProperties => 0,
 219         properties => {
 220             node => get_standard_option('pve-node'),
 221         },
 222     },
 223     returns => {
 224         type => 'array',
 225         items => {
 226             type => "object",
 227             properties => {},
 228         },
 229         links => [ { rel => 'child', href => "{vmid}" } ],
 230     },
 231     code => sub {
 232         my ($param) = @_;
 233
 234         my $rpcenv = PVE::RPCEnvironment::get();
 235         my $authuser = $rpcenv->get_user();
 236
 237         my $vmstatus = PVE::QemuServer::vmstatus();
 238
 239         my $res = [];
 240         foreach my $vmid (keys %$vmstatus) {
 241             next if !$rpcenv->check($authuser, "/vms/$vmid", [ 'VM.Audit' ], 1);
 242
 243             my $data = $vmstatus->{$vmid};
 244             $data->{vmid} = $vmid;
 245             push @$res, $data;
 246         }
 247
 248         return $res;
 249     }});
 250
 251 __PACKAGE__->register_method({
 252     name => 'create_vm',
 253     path => '',
 254     method => 'POST',
 255     description => "Create or restore a virtual machine.",
 256     permissions => {
 257         description => "You need 'VM.Allocate' permissions on /vms/{vmid} or on the VM pool /pool/{pool}. " .
 258             "For restore (option 'archive'), it is enough if the user has 'VM.Backup' permission and the VM already exists. " .
 259             "If you create disks you need 'Datastore.AllocateSpace' on any used storage.",
 260         user => 'all', # check inside
 261     },
 262     protected => 1,
 263     proxyto => 'node',
 264     parameters => {
 265         additionalProperties => 0,
 266         properties => PVE::QemuServer::json_config_properties(
 267             {
 268                 node => get_standard_option('pve-node'),
 269                 vmid => get_standard_option('pve-vmid'),
 270                 archive => {
 271                     description => "The backup file.",
 272                     type => 'string',
 273                     optional => 1,
 274                     maxLength => 255,
 275                 },
 276                 storage => get_standard_option('pve-storage-id', {
 277                     description => "Default storage.",
 278                     optional => 1,
 279                 }),
 280                 force => {
 281                     optional => 1,
 282                     type => 'boolean',
 283                     description => "Allow to overwrite existing VM.",
 284                     requires => 'archive',
 285                 },
 286                 unique => {
 287                     optional => 1,
 288                     type => 'boolean',
 289                     description => "Assign a unique random ethernet address.",
 290                     requires => 'archive',
 291                 },
 292                 pool => {
 293                     optional => 1,
 294                     type => 'string', format => 'pve-poolid',
 295                     description => "Add the VM to the specified pool.",
 296                 },
 297             }),
 298     },
 299     returns => {
 300         type => 'string',
 301     },
 302     code => sub {
 303         my ($param) = @_;
 304
 305         my $rpcenv = PVE::RPCEnvironment::get();
 306
 307         my $authuser = $rpcenv->get_user();
 308
 309         my $node = extract_param($param, 'node');
 310
 311         my $vmid = extract_param($param, 'vmid');
 312
 313         my $archive = extract_param($param, 'archive');
 314
 315         my $storage = extract_param($param, 'storage');
 316
 317         my $force = extract_param($param, 'force');
 318
 319         my $unique = extract_param($param, 'unique');
 320
 321         my $pool = extract_param($param, 'pool');
 322
 323         my $filename = PVE::QemuServer::config_file($vmid);
 324
 325         my $storecfg = PVE::Storage::config();
 326
 327         PVE::Cluster::check_cfs_quorum();
 328
 329         if (defined($pool)) {
 330             $rpcenv->check_pool_exist($pool);
 331         }
 332
 333         $rpcenv->check($authuser, "/storage/$storage", ['Datastore.AllocateSpace'])
 334             if defined($storage);
 335
 336         if ($rpcenv->check($authuser, "/vms/$vmid", ['VM.Allocate'], 1)) {
 337             # OK
 338         } elsif ($pool && $rpcenv->check($authuser, "/pool/$pool", ['VM.Allocate'], 1)) {
 339             # OK
 340         } elsif ($archive && $force && (-f $filename) &&
 341                  $rpcenv->check($authuser, "/vms/$vmid", ['VM.Backup'], 1)) {
 342             # OK: user has VM.Backup permissions, and want to restore an existing VM
 343         } else {
 344             raise_perm_exc();
 345         }
 346
 347         if (!$archive) {
 348             &$resolve_cdrom_alias($param);
 349
 350             &$check_storage_access($rpcenv, $authuser, $storecfg, $vmid, $param, $storage);
 351
 352             &$check_vm_modify_config_perm($rpcenv, $authuser, $vmid, $pool, [ keys %$param]);
 353
 354             foreach my $opt (keys %$param) {
 355                 if (PVE::QemuServer::valid_drivename($opt)) {
 356                     my $drive = PVE::QemuServer::parse_drive($opt, $param->{$opt});
 357                     raise_param_exc({ $opt => "unable to parse drive options" }) if !$drive;
 358
 359                     PVE::QemuServer::cleanup_drive_path($opt, $storecfg, $drive);
 360                     $param->{$opt} = PVE::QemuServer::print_drive($vmid, $drive);
 361                 }
 362             }
 363
 364             PVE::QemuServer::add_random_macs($param);
 365         } else {
 366             my $keystr = join(' ', keys %$param);
 367             raise_param_exc({ archive => "option conflicts with other options ($keystr)"}) if $keystr;
 368
 369             if ($archive eq '-') {
 370                 die "pipe requires cli environment\n"
 371                     if $rpcenv->{type} ne 'cli';
 372             } else {
 373                 my $path = $rpcenv->check_volume_access($authuser, $storecfg, $vmid, $archive);
 374
 375                 PVE::Storage::activate_volumes($storecfg, [ $archive ])
 376                     if PVE::Storage::parse_volume_id ($archive, 1);
 377
 378                 die "can't find archive file '$archive'\n" if !($path && -f $path);
 379                 $archive = $path;
 380             }
 381         }
 382
 383         my $addVMtoPoolFn = sub {
 384             my $usercfg = cfs_read_file("user.cfg");
 385             if (my $data = $usercfg->{pools}->{$pool}) {
 386                 $data->{vms}->{$vmid} = 1;
 387                 $usercfg->{vms}->{$vmid} = $pool;
 388                 cfs_write_file("user.cfg", $usercfg);
 389             }
 390         };
 391
 392         my $restorefn = sub {
 393
 394             # fixme: this test does not work if VM exists on other node!
 395             if (-f $filename) {
 396                 die "unable to restore vm $vmid: config file already exists\n"
 397                     if !$force;
 398
 399                 die "unable to restore vm $vmid: vm is running\n"
 400                     if PVE::QemuServer::check_running($vmid);
 401             }
 402
 403             my $realcmd = sub {
 404                 PVE::QemuServer::restore_archive($archive, $vmid, $authuser, {
 405                     storage => $storage,
 406                     pool => $pool,
 407                     unique => $unique });
 408
 409                 PVE::AccessControl::lock_user_config($addVMtoPoolFn, "can't add VM to pool") if $pool;
 410             };
 411
 412             return $rpcenv->fork_worker('qmrestore', $vmid, $authuser, $realcmd);
 413         };
 414
 415         my $createfn = sub {
 416
 417             # test after locking
 418             die "unable to create vm $vmid: config file already exists\n"
 419                 if -f $filename;
 420
 421             my $realcmd = sub {
 422
 423                 my $vollist = [];
 424
 425                 my $conf = $param;
 426
 427                 eval {
 428
 429                     $vollist = &$create_disks($rpcenv, $authuser, $conf, $storecfg, $vmid, $pool, $param, $storage);
 430
 431                     # try to be smart about bootdisk
 432                     my @disks = PVE::QemuServer::disknames();
 433                     my $firstdisk;
 434                     foreach my $ds (reverse @disks) {
 435                         next if !$conf->{$ds};
 436                         my $disk = PVE::QemuServer::parse_drive($ds, $conf->{$ds});
 437                         next if PVE::QemuServer::drive_is_cdrom($disk);
 438                         $firstdisk = $ds;
 439                     }
 440
 441                     if (!$conf->{bootdisk} && $firstdisk) {
 442                         $conf->{bootdisk} = $firstdisk;
 443                     }
 444
 445                     PVE::QemuServer::update_config_nolock($vmid, $conf);
 446
 447                 };
 448                 my $err = $@;
 449
 450                 if ($err) {
 451                     foreach my $volid (@$vollist) {
 452                         eval { PVE::Storage::vdisk_free($storecfg, $volid); };
 453                         warn $@ if $@;
 454                     }
 455                     die "create failed - $err";
 456                 }
 457
 458                 PVE::AccessControl::lock_user_config($addVMtoPoolFn, "can't add VM to pool") if $pool;
 459             };
 460
 461             return $rpcenv->fork_worker('qmcreate', $vmid, $authuser, $realcmd);
 462         };
 463
 464         return PVE::QemuServer::lock_config_full($vmid, 1, $archive ? $restorefn : $createfn);
 465     }});
 466
 467 __PACKAGE__->register_method({
 468     name => 'vmdiridx',
 469     path => '{vmid}',
 470     method => 'GET',
 471     proxyto => 'node',
 472     description => "Directory index",
 473     permissions => {
 474         user => 'all',
 475     },
 476     parameters => {
 477         additionalProperties => 0,
 478         properties => {
 479             node => get_standard_option('pve-node'),
 480             vmid => get_standard_option('pve-vmid'),
 481         },
 482     },
 483     returns => {
 484         type => 'array',
 485         items => {
 486             type => "object",
 487             properties => {
 488                 subdir => { type => 'string' },
 489             },
 490         },
 491         links => [ { rel => 'child', href => "{subdir}" } ],
 492     },
 493     code => sub {
 494         my ($param) = @_;
 495
 496         my $res = [
 497             { subdir => 'config' },
 498             { subdir => 'status' },
 499             { subdir => 'unlink' },
 500             { subdir => 'vncproxy' },
 501             { subdir => 'migrate' },
 502             { subdir => 'resize' },
 503             { subdir => 'rrd' },
 504             { subdir => 'rrddata' },
 505             { subdir => 'monitor' },
 506             { subdir => 'snapshot' },
 507             ];
 508
 509         return $res;
 510     }});
 511
 512 __PACKAGE__->register_method({
 513     name => 'rrd',
 514     path => '{vmid}/rrd',
 515     method => 'GET',
 516     protected => 1, # fixme: can we avoid that?
 517     permissions => {
 518         check => ['perm', '/vms/{vmid}', [ 'VM.Audit' ]],
 519     },
 520     description => "Read VM RRD statistics (returns PNG)",
 521     parameters => {
 522         additionalProperties => 0,
 523         properties => {
 524             node => get_standard_option('pve-node'),
 525             vmid => get_standard_option('pve-vmid'),
 526             timeframe => {
 527                 description => "Specify the time frame you are interested in.",
 528                 type => 'string',
 529                 enum => [ 'hour', 'day', 'week', 'month', 'year' ],
 530             },
 531             ds => {
 532                 description => "The list of datasources you want to display.",
 533                 type => 'string', format => 'pve-configid-list',
 534             },
 535             cf => {
 536                 description => "The RRD consolidation function",
 537                 type => 'string',
 538                 enum => [ 'AVERAGE', 'MAX' ],
 539                 optional => 1,
 540             },
 541         },
 542     },
 543     returns => {
 544         type => "object",
 545         properties => {
 546             filename => { type => 'string' },
 547         },
 548     },
 549     code => sub {
 550         my ($param) = @_;
 551
 552         return PVE::Cluster::create_rrd_graph(
 553             "pve2-vm/$param->{vmid}", $param->{timeframe},
 554             $param->{ds}, $param->{cf});
 555
 556     }});
 557
 558 __PACKAGE__->register_method({
 559     name => 'rrddata',
 560     path => '{vmid}/rrddata',
 561     method => 'GET',
 562     protected => 1, # fixme: can we avoid that?
 563     permissions => {
 564         check => ['perm', '/vms/{vmid}', [ 'VM.Audit' ]],
 565     },
 566     description => "Read VM RRD statistics",
 567     parameters => {
 568         additionalProperties => 0,
 569         properties => {
 570             node => get_standard_option('pve-node'),
 571             vmid => get_standard_option('pve-vmid'),
 572             timeframe => {
 573                 description => "Specify the time frame you are interested in.",
 574                 type => 'string',
 575                 enum => [ 'hour', 'day', 'week', 'month', 'year' ],
 576             },
 577             cf => {
 578                 description => "The RRD consolidation function",
 579                 type => 'string',
 580                 enum => [ 'AVERAGE', 'MAX' ],
 581                 optional => 1,
 582             },
 583         },
 584     },
 585     returns => {
 586         type => "array",
 587         items => {
 588             type => "object",
 589             properties => {},
 590         },
 591     },
 592     code => sub {
 593         my ($param) = @_;
 594
 595         return PVE::Cluster::create_rrd_data(
 596             "pve2-vm/$param->{vmid}", $param->{timeframe}, $param->{cf});
 597     }});
 598
 599
 600 __PACKAGE__->register_method({
 601     name => 'vm_config',
 602     path => '{vmid}/config',
 603     method => 'GET',
 604     proxyto => 'node',
 605     description => "Get virtual machine configuration.",
 606     permissions => {
 607         check => ['perm', '/vms/{vmid}', [ 'VM.Audit' ]],
 608     },
 609     parameters => {
 610         additionalProperties => 0,
 611         properties => {
 612             node => get_standard_option('pve-node'),
 613             vmid => get_standard_option('pve-vmid'),
 614         },
 615     },
 616     returns => {
 617         type => "object",
 618         properties => {
 619             digest => {
 620                 type => 'string',
 621                 description => 'SHA1 digest of configuration file. This can be used to prevent concurrent modifications.',
 622             }
 623         },
 624     },
 625     code => sub {
 626         my ($param) = @_;
 627
 628         my $conf = PVE::QemuServer::load_config($param->{vmid});
 629
 630         delete $conf->{snapshots};
 631
 632         return $conf;
 633     }});
 634
 635 my $vm_is_volid_owner = sub {
 636     my ($storecfg, $vmid, $volid) =@_;
 637
 638     if ($volid !~  m|^/|) {
 639         my ($path, $owner);
 640         eval { ($path, $owner) = PVE::Storage::path($storecfg, $volid); };
 641         if ($owner && ($owner == $vmid)) {
 642             return 1;
 643         }
 644     }
 645
 646     return undef;
 647 };
 648
 649 my $test_deallocate_drive = sub {
 650     my ($storecfg, $vmid, $key, $drive, $force) = @_;
 651
 652     if (!PVE::QemuServer::drive_is_cdrom($drive)) {
 653         my $volid = $drive->{file};
 654         if (&$vm_is_volid_owner($storecfg, $vmid, $volid)) {
 655             if ($force || $key =~ m/^unused/) {
 656                 my $sid = PVE::Storage::parse_volume_id($volid);
 657                 return $sid;
 658             }
 659         }
 660     }
 661
 662     return undef;
 663 };
 664
 665 my $delete_drive = sub {
 666     my ($conf, $storecfg, $vmid, $key, $drive, $force) = @_;
 667
 668     if (!PVE::QemuServer::drive_is_cdrom($drive)) {
 669         my $volid = $drive->{file};
 670         if (&$vm_is_volid_owner($storecfg, $vmid, $volid)) {
 671             if ($force || $key =~ m/^unused/) {
 672                 eval { PVE::Storage::vdisk_free($storecfg, $volid); };
 673                 die $@ if $@;
 674             } else {
 675                 PVE::QemuServer::add_unused_volume($conf, $volid, $vmid);
 676             }
 677         }
 678     }
 679
 680     delete $conf->{$key};
 681 };
 682
 683 my $vmconfig_delete_option = sub {
 684     my ($rpcenv, $authuser, $conf, $storecfg, $vmid, $opt, $force) = @_;
 685
 686     return if !defined($conf->{$opt});
 687
 688     my $isDisk = PVE::QemuServer::valid_drivename($opt)|| ($opt =~ m/^unused/);
 689
 690     if ($isDisk) {
 691         $rpcenv->check_vm_perm($authuser, $vmid, undef, ['VM.Config.Disk']);
 692
 693         my $drive = PVE::QemuServer::parse_drive($opt, $conf->{$opt});
 694         if (my $sid = &$test_deallocate_drive($storecfg, $vmid, $opt, $drive, $force)) {
 695             $rpcenv->check($authuser, "/storage/$sid", ['Datastore.Allocate']);
 696         }
 697     }
 698
 699     my $unplugwarning = "";
 700     if($conf->{ostype} && $conf->{ostype} eq 'l26'){
 701         $unplugwarning = "<br>verify that you have acpiphp && pci_hotplug modules loaded in your guest VM";
 702     }elsif($conf->{ostype} && $conf->{ostype} eq 'l24'){
 703         $unplugwarning = "<br>kernel 2.4 don't support hotplug, please disable hotplug in options";
 704     }elsif(!$conf->{ostype} || ($conf->{ostype} && $conf->{ostype} eq 'other')){
 705         $unplugwarning = "<br>verify that your guest support acpi hotplug";
 706     }
 707
 708     if($opt eq 'tablet'){
 709         PVE::QemuServer::vm_deviceplug(undef, $conf, $vmid, $opt);
 710     }else{
 711         die "error hot-unplug $opt $unplugwarning" if !PVE::QemuServer::vm_deviceunplug($vmid, $conf, $opt);
 712     }
 713
 714     if ($isDisk) {
 715         my $drive = PVE::QemuServer::parse_drive($opt, $conf->{$opt});
 716         &$delete_drive($conf, $storecfg, $vmid, $opt, $drive, $force);
 717     } else {
 718         delete $conf->{$opt};
 719     }
 720
 721     PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
 722 };
 723
 724 my $safe_num_ne = sub {
 725     my ($a, $b) = @_;
 726
 727     return 0 if !defined($a) && !defined($b);
 728     return 1 if !defined($a);
 729     return 1 if !defined($b);
 730
 731     return $a != $b;
 732 };
 733
 734 my $vmconfig_update_disk = sub {
 735     my ($rpcenv, $authuser, $conf, $storecfg, $vmid, $opt, $value, $force) = @_;
 736
 737     my $drive = PVE::QemuServer::parse_drive($opt, $value);
 738
 739     if (PVE::QemuServer::drive_is_cdrom($drive)) { #cdrom
 740         $rpcenv->check_vm_perm($authuser, $vmid, undef, ['VM.Config.CDROM']);
 741     } else {
 742         $rpcenv->check_vm_perm($authuser, $vmid, undef, ['VM.Config.Disk']);
 743     }
 744
 745     if ($conf->{$opt}) {
 746
 747         if (my $old_drive = PVE::QemuServer::parse_drive($opt, $conf->{$opt}))  {
 748
 749             my $media = $drive->{media} || 'disk';
 750             my $oldmedia = $old_drive->{media} || 'disk';
 751             die "unable to change media type\n" if $media ne $oldmedia;
 752
 753             if (!PVE::QemuServer::drive_is_cdrom($old_drive) &&
 754                 ($drive->{file} ne $old_drive->{file})) {  # delete old disks
 755
 756                 &$vmconfig_delete_option($rpcenv, $authuser, $conf, $storecfg, $vmid, $opt, $force);
 757                 $conf = PVE::QemuServer::load_config($vmid); # update/reload
 758             }
 759
 760             if(&$safe_num_ne($drive->{mbps}, $old_drive->{mbps}) ||
 761                &$safe_num_ne($drive->{mbps_rd}, $old_drive->{mbps_rd}) ||
 762                &$safe_num_ne($drive->{mbps_wr}, $old_drive->{mbps_wr}) ||
 763                &$safe_num_ne($drive->{iops}, $old_drive->{iops}) ||
 764                &$safe_num_ne($drive->{iops_rd}, $old_drive->{iops_rd}) ||
 765                &$safe_num_ne($drive->{iops_wr}, $old_drive->{iops_wr})) {
 766                PVE::QemuServer::qemu_block_set_io_throttle($vmid,"drive-$opt", $drive->{mbps}*1024*1024,
 767                                                            $drive->{mbps_rd}*1024*1024, $drive->{mbps_wr}*1024*1024,
 768                                                            $drive->{iops}, $drive->{iops_rd}, $drive->{iops_wr})
 769                    if !PVE::QemuServer::drive_is_cdrom($drive);
 770             }
 771         }
 772     }
 773
 774     &$create_disks($rpcenv, $authuser, $conf, $storecfg, $vmid, undef, {$opt => $value});
 775     PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
 776
 777     $conf = PVE::QemuServer::load_config($vmid); # update/reload
 778     $drive = PVE::QemuServer::parse_drive($opt, $conf->{$opt});
 779
 780     if (PVE::QemuServer::drive_is_cdrom($drive)) { # cdrom
 781
 782         if (PVE::QemuServer::check_running($vmid)) {
 783             if ($drive->{file} eq 'none') {
 784                 PVE::QemuServer::vm_mon_cmd($vmid, "eject",force => JSON::true,device => "drive-$opt");
 785             } else {
 786                 my $path = PVE::QemuServer::get_iso_path($storecfg, $vmid, $drive->{file});
 787                 PVE::QemuServer::vm_mon_cmd($vmid, "eject",force => JSON::true,device => "drive-$opt"); #force eject if locked
 788                 PVE::QemuServer::vm_mon_cmd($vmid, "change",device => "drive-$opt",target => "$path") if $path;
 789             }
 790         }
 791
 792     } else { # hotplug new disks
 793
 794         die "error hotplug $opt" if !PVE::QemuServer::vm_deviceplug($storecfg, $conf, $vmid, $opt, $drive);
 795     }
 796 };
 797
 798 my $vmconfig_update_net = sub {
 799     my ($rpcenv, $authuser, $conf, $storecfg, $vmid, $opt, $value) = @_;
 800
 801     if ($conf->{$opt} && PVE::QemuServer::check_running($vmid)) {
 802         my $oldnet = PVE::QemuServer::parse_net($conf->{$opt});
 803         my $newnet = PVE::QemuServer::parse_net($value);
 804
 805         if($oldnet->{model} ne $newnet->{model}){
 806             #if model change, we try to hot-unplug
 807             die "error hot-unplug $opt for update" if !PVE::QemuServer::vm_deviceunplug($vmid, $conf, $opt);
 808         }else{
 809
 810             if($newnet->{bridge} && $oldnet->{bridge}){
 811                 my $iface = "tap".$vmid."i".$1 if $opt =~ m/net(\d+)/;
 812
 813                 if($newnet->{rate} ne $oldnet->{rate}){
 814                     PVE::Network::tap_rate_limit($iface, $newnet->{rate});
 815                 }
 816
 817                 if(($newnet->{bridge} ne $oldnet->{bridge}) || ($newnet->{tag} ne $oldnet->{tag})){
 818                     eval{PVE::Network::tap_unplug($iface, $oldnet->{bridge}, $oldnet->{tag});};
 819                     PVE::Network::tap_plug($iface, $newnet->{bridge}, $newnet->{tag});
 820                 }
 821
 822             }else{
 823                 #if bridge/nat mode change, we try to hot-unplug
 824                 die "error hot-unplug $opt for update" if !PVE::QemuServer::vm_deviceunplug($vmid, $conf, $opt);
 825             }
 826         }
 827
 828     }
 829     $conf->{$opt} = $value;
 830     PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
 831     $conf = PVE::QemuServer::load_config($vmid); # update/reload
 832
 833     my $net = PVE::QemuServer::parse_net($conf->{$opt});
 834
 835     die "error hotplug $opt" if !PVE::QemuServer::vm_deviceplug($storecfg, $conf, $vmid, $opt, $net);
 836 };
 837
 838 my $vm_config_perm_list = [
 839             'VM.Config.Disk',
 840             'VM.Config.CDROM',
 841             'VM.Config.CPU',
 842             'VM.Config.Memory',
 843             'VM.Config.Network',
 844             'VM.Config.HWType',
 845             'VM.Config.Options',
 846     ];
 847
 848 __PACKAGE__->register_method({
 849     name => 'update_vm',
 850     path => '{vmid}/config',
 851     method => 'PUT',
 852     protected => 1,
 853     proxyto => 'node',
 854     description => "Set virtual machine options.",
 855     permissions => {
 856         check => ['perm', '/vms/{vmid}', $vm_config_perm_list, any => 1],
 857     },
 858     parameters => {
 859         additionalProperties => 0,
 860         properties => PVE::QemuServer::json_config_properties(
 861             {
 862                 node => get_standard_option('pve-node'),
 863                 vmid => get_standard_option('pve-vmid'),
 864                 skiplock => get_standard_option('skiplock'),
 865                 delete => {
 866                     type => 'string', format => 'pve-configid-list',
 867                     description => "A list of settings you want to delete.",
 868                     optional => 1,
 869                 },
 870                 force => {
 871                     type => 'boolean',
 872                     description => $opt_force_description,
 873                     optional => 1,
 874                     requires => 'delete',
 875                 },
 876                 digest => {
 877                     type => 'string',
 878                     description => 'Prevent changes if current configuration file has different SHA1 digest. This can be used to prevent concurrent modifications.',
 879                     maxLength => 40,
 880                     optional => 1,
 881                 }
 882             }),
 883     },
 884     returns => { type => 'null'},
 885     code => sub {
 886         my ($param) = @_;
 887
 888         my $rpcenv = PVE::RPCEnvironment::get();
 889
 890         my $authuser = $rpcenv->get_user();
 891
 892         my $node = extract_param($param, 'node');
 893
 894         my $vmid = extract_param($param, 'vmid');
 895
 896         my $digest = extract_param($param, 'digest');
 897
 898         my @paramarr = (); # used for log message
 899         foreach my $key (keys %$param) {
 900             push @paramarr, "-$key", $param->{$key};
 901         }
 902
 903         my $skiplock = extract_param($param, 'skiplock');
 904         raise_param_exc({ skiplock => "Only root may use this option." })
 905             if $skiplock && $authuser ne 'root@pam';
 906
 907         my $delete_str = extract_param($param, 'delete');
 908
 909         my $force = extract_param($param, 'force');
 910
 911         die "no options specified\n" if !$delete_str && !scalar(keys %$param);
 912
 913         my $storecfg = PVE::Storage::config();
 914
 915         my $defaults = PVE::QemuServer::load_defaults();
 916
 917         &$resolve_cdrom_alias($param);
 918
 919         # now try to verify all parameters
 920
 921         my @delete = ();
 922         foreach my $opt (PVE::Tools::split_list($delete_str)) {
 923             $opt = 'ide2' if $opt eq 'cdrom';
 924             raise_param_exc({ delete => "you can't use '-$opt' and " .
 925                                   "-delete $opt' at the same time" })
 926                 if defined($param->{$opt});
 927
 928             if (!PVE::QemuServer::option_exists($opt)) {
 929                 raise_param_exc({ delete => "unknown option '$opt'" });
 930             }
 931
 932             push @delete, $opt;
 933         }
 934
 935         foreach my $opt (keys %$param) {
 936             if (PVE::QemuServer::valid_drivename($opt)) {
 937                 # cleanup drive path
 938                 my $drive = PVE::QemuServer::parse_drive($opt, $param->{$opt});
 939                 PVE::QemuServer::cleanup_drive_path($opt, $storecfg, $drive);
 940                 $param->{$opt} = PVE::QemuServer::print_drive($vmid, $drive);
 941             } elsif ($opt =~ m/^net(\d+)$/) {
 942                 # add macaddr
 943                 my $net = PVE::QemuServer::parse_net($param->{$opt});
 944                 $param->{$opt} = PVE::QemuServer::print_net($net);
 945             }
 946         }
 947
 948         &$check_vm_modify_config_perm($rpcenv, $authuser, $vmid, undef, [@delete]);
 949
 950         &$check_vm_modify_config_perm($rpcenv, $authuser, $vmid, undef, [keys %$param]);
 951
 952         &$check_storage_access($rpcenv, $authuser, $storecfg, $vmid, $param);
 953
 954         my $updatefn =  sub {
 955
 956             my $conf = PVE::QemuServer::load_config($vmid);
 957
 958             die "checksum missmatch (file change by other user?)\n"
 959                 if $digest && $digest ne $conf->{digest};
 960
 961             PVE::QemuServer::check_lock($conf) if !$skiplock;
 962
 963             if ($param->{memory} || defined($param->{balloon})) {
 964                 my $maxmem = $param->{memory} || $conf->{memory} || $defaults->{memory};
 965                 my $balloon = defined($param->{balloon}) ?  $param->{balloon} : $conf->{balloon};
 966
 967                 die "balloon value too large (must be smaller than assigned memory)\n"
 968                     if $balloon > $maxmem;
 969             }
 970
 971             PVE::Cluster::log_msg('info', $authuser, "update VM $vmid: " . join (' ', @paramarr));
 972
 973             foreach my $opt (@delete) { # delete
 974                 $conf = PVE::QemuServer::load_config($vmid); # update/reload
 975                 &$vmconfig_delete_option($rpcenv, $authuser, $conf, $storecfg, $vmid, $opt, $force);
 976             }
 977
 978             my $running = PVE::QemuServer::check_running($vmid);
 979
 980             foreach my $opt (keys %$param) { # add/change
 981
 982                 $conf = PVE::QemuServer::load_config($vmid); # update/reload
 983
 984                 next if $conf->{$opt} && ($param->{$opt} eq $conf->{$opt}); # skip if nothing changed
 985
 986                 if (PVE::QemuServer::valid_drivename($opt)) {
 987
 988                     &$vmconfig_update_disk($rpcenv, $authuser, $conf, $storecfg, $vmid,
 989                                            $opt, $param->{$opt}, $force);
 990
 991                 } elsif ($opt =~ m/^net(\d+)$/) { #nics
 992
 993                     &$vmconfig_update_net($rpcenv, $authuser, $conf, $storecfg, $vmid,
 994                                           $opt, $param->{$opt});
 995
 996                 } else {
 997
 998                     if($opt eq 'tablet' && $param->{$opt} == 1){
 999                         PVE::QemuServer::vm_deviceplug(undef, $conf, $vmid, $opt);
1000                     }elsif($opt eq 'tablet' && $param->{$opt} == 0){
1001                         PVE::QemuServer::vm_deviceunplug($vmid, $conf, $opt);
1002                     }
1003
1004                     $conf->{$opt} = $param->{$opt};
1005                     PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
1006                 }
1007             }
1008
1009             # allow manual ballooning if shares is set to zero
1010             if ($running && defined($param->{balloon}) &&
1011                 defined($conf->{shares}) && ($conf->{shares} == 0)) {
1012                 my $balloon = $param->{'balloon'} || $conf->{memory} || $defaults->{memory};
1013                 PVE::QemuServer::vm_mon_cmd($vmid, "balloon", value => $balloon*1024*1024);
1014             }
1015
1016         };
1017
1018         PVE::QemuServer::lock_config($vmid, $updatefn);
1019
1020         return undef;
1021     }});
1022
1023
1024 __PACKAGE__->register_method({
1025     name => 'destroy_vm',
1026     path => '{vmid}',
1027     method => 'DELETE',
1028     protected => 1,
1029     proxyto => 'node',
1030     description => "Destroy the vm (also delete all used/owned volumes).",
1031     permissions => {
1032         check => [ 'perm', '/vms/{vmid}', ['VM.Allocate']],
1033     },
1034     parameters => {
1035         additionalProperties => 0,
1036         properties => {
1037             node => get_standard_option('pve-node'),
1038             vmid => get_standard_option('pve-vmid'),
1039             skiplock => get_standard_option('skiplock'),
1040         },
1041     },
1042     returns => {
1043         type => 'string',
1044     },
1045     code => sub {
1046         my ($param) = @_;
1047
1048         my $rpcenv = PVE::RPCEnvironment::get();
1049
1050         my $authuser = $rpcenv->get_user();
1051
1052         my $vmid = $param->{vmid};
1053
1054         my $skiplock = $param->{skiplock};
1055         raise_param_exc({ skiplock => "Only root may use this option." })
1056             if $skiplock && $authuser ne 'root@pam';
1057
1058         # test if VM exists
1059         my $conf = PVE::QemuServer::load_config($vmid);
1060
1061         my $storecfg = PVE::Storage::config();
1062
1063         my $delVMfromPoolFn = sub {
1064             my $usercfg = cfs_read_file("user.cfg");
1065             if (my $pool = $usercfg->{vms}->{$vmid}) {
1066                 if (my $data = $usercfg->{pools}->{$pool}) {
1067                     delete $data->{vms}->{$vmid};
1068                     delete $usercfg->{vms}->{$vmid};
1069                     cfs_write_file("user.cfg", $usercfg);
1070                 }
1071             }
1072         };
1073
1074         my $realcmd = sub {
1075             my $upid = shift;
1076
1077             syslog('info', "destroy VM $vmid: $upid\n");
1078
1079             PVE::QemuServer::vm_destroy($storecfg, $vmid, $skiplock);
1080
1081             PVE::AccessControl::lock_user_config($delVMfromPoolFn, "pool cleanup failed");
1082         };
1083
1084         return $rpcenv->fork_worker('qmdestroy', $vmid, $authuser, $realcmd);
1085     }});
1086
1087 __PACKAGE__->register_method({
1088     name => 'unlink',
1089     path => '{vmid}/unlink',
1090     method => 'PUT',
1091     protected => 1,
1092     proxyto => 'node',
1093     description => "Unlink/delete disk images.",
1094     permissions => {
1095         check => [ 'perm', '/vms/{vmid}', ['VM.Config.Disk']],
1096     },
1097     parameters => {
1098         additionalProperties => 0,
1099         properties => {
1100             node => get_standard_option('pve-node'),
1101             vmid => get_standard_option('pve-vmid'),
1102             idlist => {
1103                 type => 'string', format => 'pve-configid-list',
1104                 description => "A list of disk IDs you want to delete.",
1105             },
1106             force => {
1107                 type => 'boolean',
1108                 description => $opt_force_description,
1109                 optional => 1,
1110             },
1111         },
1112     },
1113     returns => { type => 'null'},
1114     code => sub {
1115         my ($param) = @_;
1116
1117         $param->{delete} = extract_param($param, 'idlist');
1118
1119         __PACKAGE__->update_vm($param);
1120
1121         return undef;
1122     }});
1123
1124 my $sslcert;
1125
1126 __PACKAGE__->register_method({
1127     name => 'vncproxy',
1128     path => '{vmid}/vncproxy',
1129     method => 'POST',
1130     protected => 1,
1131     permissions => {
1132         check => ['perm', '/vms/{vmid}', [ 'VM.Console' ]],
1133     },
1134     description => "Creates a TCP VNC proxy connections.",
1135     parameters => {
1136         additionalProperties => 0,
1137         properties => {
1138             node => get_standard_option('pve-node'),
1139             vmid => get_standard_option('pve-vmid'),
1140         },
1141     },
1142     returns => {
1143         additionalProperties => 0,
1144         properties => {
1145             user => { type => 'string' },
1146             ticket => { type => 'string' },
1147             cert => { type => 'string' },
1148             port => { type => 'integer' },
1149             upid => { type => 'string' },
1150         },
1151     },
1152     code => sub {
1153         my ($param) = @_;
1154
1155         my $rpcenv = PVE::RPCEnvironment::get();
1156
1157         my $authuser = $rpcenv->get_user();
1158
1159         my $vmid = $param->{vmid};
1160         my $node = $param->{node};
1161
1162         my $authpath = "/vms/$vmid";
1163
1164         my $ticket = PVE::AccessControl::assemble_vnc_ticket($authuser, $authpath);
1165
1166         $sslcert = PVE::Tools::file_get_contents("/etc/pve/pve-root-ca.pem", 8192)
1167             if !$sslcert;
1168
1169         my $port = PVE::Tools::next_vnc_port();
1170
1171         my $remip;
1172
1173         if ($node ne 'localhost' && $node ne PVE::INotify::nodename()) {
1174             $remip = PVE::Cluster::remote_node_ip($node);
1175         }
1176
1177         # NOTE: kvm VNC traffic is already TLS encrypted
1178         my $remcmd = $remip ? ['/usr/bin/ssh', '-T', '-o', 'BatchMode=yes', $remip] : [];
1179
1180         my $timeout = 10;
1181
1182         my $realcmd = sub {
1183             my $upid = shift;
1184
1185             syslog('info', "starting vnc proxy $upid\n");
1186
1187             my $qmcmd = [@$remcmd, "/usr/sbin/qm", 'vncproxy', $vmid];
1188
1189             my $qmstr = join(' ', @$qmcmd);
1190
1191             # also redirect stderr (else we get RFB protocol errors)
1192             my $cmd = ['/bin/nc', '-l', '-p', $port, '-w', $timeout, '-c', "$qmstr 2>/dev/null"];
1193
1194             PVE::Tools::run_command($cmd);
1195
1196             return;
1197         };
1198
1199         my $upid = $rpcenv->fork_worker('vncproxy', $vmid, $authuser, $realcmd);
1200
1201         PVE::Tools::wait_for_vnc_port($port);
1202
1203         return {
1204             user => $authuser,
1205             ticket => $ticket,
1206             port => $port,
1207             upid => $upid,
1208             cert => $sslcert,
1209         };
1210     }});
1211
1212 __PACKAGE__->register_method({
1213     name => 'vmcmdidx',
1214     path => '{vmid}/status',
1215     method => 'GET',
1216     proxyto => 'node',
1217     description => "Directory index",
1218     permissions => {
1219         user => 'all',
1220     },
1221     parameters => {
1222         additionalProperties => 0,
1223         properties => {
1224             node => get_standard_option('pve-node'),
1225             vmid => get_standard_option('pve-vmid'),
1226         },
1227     },
1228     returns => {
1229         type => 'array',
1230         items => {
1231             type => "object",
1232             properties => {
1233                 subdir => { type => 'string' },
1234             },
1235         },
1236         links => [ { rel => 'child', href => "{subdir}" } ],
1237     },
1238     code => sub {
1239         my ($param) = @_;
1240
1241         # test if VM exists
1242         my $conf = PVE::QemuServer::load_config($param->{vmid});
1243
1244         my $res = [
1245             { subdir => 'current' },
1246             { subdir => 'start' },
1247             { subdir => 'stop' },
1248             ];
1249
1250         return $res;
1251     }});
1252
1253 my $vm_is_ha_managed = sub {
1254     my ($vmid) = @_;
1255
1256     my $cc = PVE::Cluster::cfs_read_file('cluster.conf');
1257     if (PVE::Cluster::cluster_conf_lookup_pvevm($cc, 0, $vmid, 1)) {
1258         return 1;
1259     }
1260     return 0;
1261 };
1262
1263 __PACKAGE__->register_method({
1264     name => 'vm_status',
1265     path => '{vmid}/status/current',
1266     method => 'GET',
1267     proxyto => 'node',
1268     protected => 1, # qemu pid files are only readable by root
1269     description => "Get virtual machine status.",
1270     permissions => {
1271         check => ['perm', '/vms/{vmid}', [ 'VM.Audit' ]],
1272     },
1273     parameters => {
1274         additionalProperties => 0,
1275         properties => {
1276             node => get_standard_option('pve-node'),
1277             vmid => get_standard_option('pve-vmid'),
1278         },
1279     },
1280     returns => { type => 'object' },
1281     code => sub {
1282         my ($param) = @_;
1283
1284         # test if VM exists
1285         my $conf = PVE::QemuServer::load_config($param->{vmid});
1286
1287         my $vmstatus = PVE::QemuServer::vmstatus($param->{vmid}, 1);
1288         my $status = $vmstatus->{$param->{vmid}};
1289
1290         $status->{ha} = &$vm_is_ha_managed($param->{vmid});
1291
1292         return $status;
1293     }});
1294
1295 __PACKAGE__->register_method({
1296     name => 'vm_start',
1297     path => '{vmid}/status/start',
1298     method => 'POST',
1299     protected => 1,
1300     proxyto => 'node',
1301     description => "Start virtual machine.",
1302     permissions => {
1303         check => ['perm', '/vms/{vmid}', [ 'VM.PowerMgmt' ]],
1304     },
1305     parameters => {
1306         additionalProperties => 0,
1307         properties => {
1308             node => get_standard_option('pve-node'),
1309             vmid => get_standard_option('pve-vmid'),
1310             skiplock => get_standard_option('skiplock'),
1311             stateuri => get_standard_option('pve-qm-stateuri'),
1312             migratedfrom => get_standard_option('pve-node',{ optional => 1 }),
1313
1314         },
1315     },
1316     returns => {
1317         type => 'string',
1318     },
1319     code => sub {
1320         my ($param) = @_;
1321
1322         my $rpcenv = PVE::RPCEnvironment::get();
1323
1324         my $authuser = $rpcenv->get_user();
1325
1326         my $node = extract_param($param, 'node');
1327
1328         my $vmid = extract_param($param, 'vmid');
1329
1330         my $stateuri = extract_param($param, 'stateuri');
1331         raise_param_exc({ stateuri => "Only root may use this option." })
1332             if $stateuri && $authuser ne 'root@pam';
1333
1334         my $skiplock = extract_param($param, 'skiplock');
1335         raise_param_exc({ skiplock => "Only root may use this option." })
1336             if $skiplock && $authuser ne 'root@pam';
1337
1338         my $migratedfrom = extract_param($param, 'migratedfrom');
1339         raise_param_exc({ migratedfrom => "Only root may use this option." })
1340             if $migratedfrom && $authuser ne 'root@pam';
1341
1342         my $storecfg = PVE::Storage::config();
1343
1344         if (&$vm_is_ha_managed($vmid) && !$stateuri &&
1345             $rpcenv->{type} ne 'ha') {
1346
1347             my $hacmd = sub {
1348                 my $upid = shift;
1349
1350                 my $service = "pvevm:$vmid";
1351
1352                 my $cmd = ['clusvcadm', '-e', $service, '-m', $node];
1353
1354                 print "Executing HA start for VM $vmid\n";
1355
1356                 PVE::Tools::run_command($cmd);
1357
1358                 return;
1359             };
1360
1361             return $rpcenv->fork_worker('hastart', $vmid, $authuser, $hacmd);
1362
1363         } else {
1364
1365             my $realcmd = sub {
1366                 my $upid = shift;
1367
1368                 syslog('info', "start VM $vmid: $upid\n");
1369
1370                 PVE::QemuServer::vm_start($storecfg, $vmid, $stateuri, $skiplock, $migratedfrom);
1371
1372                 return;
1373             };
1374
1375             return $rpcenv->fork_worker('qmstart', $vmid, $authuser, $realcmd);
1376         }
1377     }});
1378
1379 __PACKAGE__->register_method({
1380     name => 'vm_stop',
1381     path => '{vmid}/status/stop',
1382     method => 'POST',
1383     protected => 1,
1384     proxyto => 'node',
1385     description => "Stop virtual machine.",
1386     permissions => {
1387         check => ['perm', '/vms/{vmid}', [ 'VM.PowerMgmt' ]],
1388     },
1389     parameters => {
1390         additionalProperties => 0,
1391         properties => {
1392             node => get_standard_option('pve-node'),
1393             vmid => get_standard_option('pve-vmid'),
1394             skiplock => get_standard_option('skiplock'),
1395             migratedfrom => get_standard_option('pve-node',{ optional => 1 }),
1396             timeout => {
1397                 description => "Wait maximal timeout seconds.",
1398                 type => 'integer',
1399                 minimum => 0,
1400                 optional => 1,
1401             },
1402             keepActive => {
1403                 description => "Do not decativate storage volumes.",
1404                 type => 'boolean',
1405                 optional => 1,
1406                 default => 0,
1407             }
1408         },
1409     },
1410     returns => {
1411         type => 'string',
1412     },
1413     code => sub {
1414         my ($param) = @_;
1415
1416         my $rpcenv = PVE::RPCEnvironment::get();
1417
1418         my $authuser = $rpcenv->get_user();
1419
1420         my $node = extract_param($param, 'node');
1421
1422         my $vmid = extract_param($param, 'vmid');
1423
1424         my $skiplock = extract_param($param, 'skiplock');
1425         raise_param_exc({ skiplock => "Only root may use this option." })
1426             if $skiplock && $authuser ne 'root@pam';
1427
1428         my $keepActive = extract_param($param, 'keepActive');
1429         raise_param_exc({ keepActive => "Only root may use this option." })
1430             if $keepActive && $authuser ne 'root@pam';
1431
1432         my $migratedfrom = extract_param($param, 'migratedfrom');
1433         raise_param_exc({ migratedfrom => "Only root may use this option." })
1434             if $migratedfrom && $authuser ne 'root@pam';
1435
1436
1437         my $storecfg = PVE::Storage::config();
1438
1439         if (&$vm_is_ha_managed($vmid) && $rpcenv->{type} ne 'ha') {
1440
1441             my $hacmd = sub {
1442                 my $upid = shift;
1443
1444                 my $service = "pvevm:$vmid";
1445
1446                 my $cmd = ['clusvcadm', '-d', $service];
1447
1448                 print "Executing HA stop for VM $vmid\n";
1449
1450                 PVE::Tools::run_command($cmd);
1451
1452                 return;
1453             };
1454
1455             return $rpcenv->fork_worker('hastop', $vmid, $authuser, $hacmd);
1456
1457         } else {
1458             my $realcmd = sub {
1459                 my $upid = shift;
1460
1461                 syslog('info', "stop VM $vmid: $upid\n");
1462
1463                 PVE::QemuServer::vm_stop($storecfg, $vmid, $skiplock, 0,
1464                                          $param->{timeout}, 0, 1, $keepActive, $migratedfrom);
1465
1466                 return;
1467             };
1468
1469             return $rpcenv->fork_worker('qmstop', $vmid, $authuser, $realcmd);
1470         }
1471     }});
1472
1473 __PACKAGE__->register_method({
1474     name => 'vm_reset',
1475     path => '{vmid}/status/reset',
1476     method => 'POST',
1477     protected => 1,
1478     proxyto => 'node',
1479     description => "Reset virtual machine.",
1480     permissions => {
1481         check => ['perm', '/vms/{vmid}', [ 'VM.PowerMgmt' ]],
1482     },
1483     parameters => {
1484         additionalProperties => 0,
1485         properties => {
1486             node => get_standard_option('pve-node'),
1487             vmid => get_standard_option('pve-vmid'),
1488             skiplock => get_standard_option('skiplock'),
1489         },
1490     },
1491     returns => {
1492         type => 'string',
1493     },
1494     code => sub {
1495         my ($param) = @_;
1496
1497         my $rpcenv = PVE::RPCEnvironment::get();
1498
1499         my $authuser = $rpcenv->get_user();
1500
1501         my $node = extract_param($param, 'node');
1502
1503         my $vmid = extract_param($param, 'vmid');
1504
1505         my $skiplock = extract_param($param, 'skiplock');
1506         raise_param_exc({ skiplock => "Only root may use this option." })
1507             if $skiplock && $authuser ne 'root@pam';
1508
1509         die "VM $vmid not running\n" if !PVE::QemuServer::check_running($vmid);
1510
1511         my $realcmd = sub {
1512             my $upid = shift;
1513
1514             PVE::QemuServer::vm_reset($vmid, $skiplock);
1515
1516             return;
1517         };
1518
1519         return $rpcenv->fork_worker('qmreset', $vmid, $authuser, $realcmd);
1520     }});
1521
1522 __PACKAGE__->register_method({
1523     name => 'vm_shutdown',
1524     path => '{vmid}/status/shutdown',
1525     method => 'POST',
1526     protected => 1,
1527     proxyto => 'node',
1528     description => "Shutdown virtual machine.",
1529     permissions => {
1530         check => ['perm', '/vms/{vmid}', [ 'VM.PowerMgmt' ]],
1531     },
1532     parameters => {
1533         additionalProperties => 0,
1534         properties => {
1535             node => get_standard_option('pve-node'),
1536             vmid => get_standard_option('pve-vmid'),
1537             skiplock => get_standard_option('skiplock'),
1538             timeout => {
1539                 description => "Wait maximal timeout seconds.",
1540                 type => 'integer',
1541                 minimum => 0,
1542                 optional => 1,
1543             },
1544             forceStop => {
1545                 description => "Make sure the VM stops.",
1546                 type => 'boolean',
1547                 optional => 1,
1548                 default => 0,
1549             },
1550             keepActive => {
1551                 description => "Do not decativate storage volumes.",
1552                 type => 'boolean',
1553                 optional => 1,
1554                 default => 0,
1555             }
1556         },
1557     },
1558     returns => {
1559         type => 'string',
1560     },
1561     code => sub {
1562         my ($param) = @_;
1563
1564         my $rpcenv = PVE::RPCEnvironment::get();
1565
1566         my $authuser = $rpcenv->get_user();
1567
1568         my $node = extract_param($param, 'node');
1569
1570         my $vmid = extract_param($param, 'vmid');
1571
1572         my $skiplock = extract_param($param, 'skiplock');
1573         raise_param_exc({ skiplock => "Only root may use this option." })
1574             if $skiplock && $authuser ne 'root@pam';
1575
1576         my $keepActive = extract_param($param, 'keepActive');
1577         raise_param_exc({ keepActive => "Only root may use this option." })
1578             if $keepActive && $authuser ne 'root@pam';
1579
1580         my $storecfg = PVE::Storage::config();
1581
1582         my $realcmd = sub {
1583             my $upid = shift;
1584
1585             syslog('info', "shutdown VM $vmid: $upid\n");
1586
1587             PVE::QemuServer::vm_stop($storecfg, $vmid, $skiplock, 0, $param->{timeout},
1588                                      1, $param->{forceStop}, $keepActive);
1589
1590             return;
1591         };
1592
1593         return $rpcenv->fork_worker('qmshutdown', $vmid, $authuser, $realcmd);
1594     }});
1595
1596 __PACKAGE__->register_method({
1597     name => 'vm_suspend',
1598     path => '{vmid}/status/suspend',
1599     method => 'POST',
1600     protected => 1,
1601     proxyto => 'node',
1602     description => "Suspend virtual machine.",
1603     permissions => {
1604         check => ['perm', '/vms/{vmid}', [ 'VM.PowerMgmt' ]],
1605     },
1606     parameters => {
1607         additionalProperties => 0,
1608         properties => {
1609             node => get_standard_option('pve-node'),
1610             vmid => get_standard_option('pve-vmid'),
1611             skiplock => get_standard_option('skiplock'),
1612         },
1613     },
1614     returns => {
1615         type => 'string',
1616     },
1617     code => sub {
1618         my ($param) = @_;
1619
1620         my $rpcenv = PVE::RPCEnvironment::get();
1621
1622         my $authuser = $rpcenv->get_user();
1623
1624         my $node = extract_param($param, 'node');
1625
1626         my $vmid = extract_param($param, 'vmid');
1627
1628         my $skiplock = extract_param($param, 'skiplock');
1629         raise_param_exc({ skiplock => "Only root may use this option." })
1630             if $skiplock && $authuser ne 'root@pam';
1631
1632         die "VM $vmid not running\n" if !PVE::QemuServer::check_running($vmid);
1633
1634         my $realcmd = sub {
1635             my $upid = shift;
1636
1637             syslog('info', "suspend VM $vmid: $upid\n");
1638
1639             PVE::QemuServer::vm_suspend($vmid, $skiplock);
1640
1641             return;
1642         };
1643
1644         return $rpcenv->fork_worker('qmsuspend', $vmid, $authuser, $realcmd);
1645     }});
1646
1647 __PACKAGE__->register_method({
1648     name => 'vm_resume',
1649     path => '{vmid}/status/resume',
1650     method => 'POST',
1651     protected => 1,
1652     proxyto => 'node',
1653     description => "Resume virtual machine.",
1654     permissions => {
1655         check => ['perm', '/vms/{vmid}', [ 'VM.PowerMgmt' ]],
1656     },
1657     parameters => {
1658         additionalProperties => 0,
1659         properties => {
1660             node => get_standard_option('pve-node'),
1661             vmid => get_standard_option('pve-vmid'),
1662             skiplock => get_standard_option('skiplock'),
1663         },
1664     },
1665     returns => {
1666         type => 'string',
1667     },
1668     code => sub {
1669         my ($param) = @_;
1670
1671         my $rpcenv = PVE::RPCEnvironment::get();
1672
1673         my $authuser = $rpcenv->get_user();
1674
1675         my $node = extract_param($param, 'node');
1676
1677         my $vmid = extract_param($param, 'vmid');
1678
1679         my $skiplock = extract_param($param, 'skiplock');
1680         raise_param_exc({ skiplock => "Only root may use this option." })
1681             if $skiplock && $authuser ne 'root@pam';
1682
1683         die "VM $vmid not running\n" if !PVE::QemuServer::check_running($vmid);
1684
1685         my $realcmd = sub {
1686             my $upid = shift;
1687
1688             syslog('info', "resume VM $vmid: $upid\n");
1689
1690             PVE::QemuServer::vm_resume($vmid, $skiplock);
1691
1692             return;
1693         };
1694
1695         return $rpcenv->fork_worker('qmresume', $vmid, $authuser, $realcmd);
1696     }});
1697
1698 __PACKAGE__->register_method({
1699     name => 'vm_sendkey',
1700     path => '{vmid}/sendkey',
1701     method => 'PUT',
1702     protected => 1,
1703     proxyto => 'node',
1704     description => "Send key event to virtual machine.",
1705     permissions => {
1706         check => ['perm', '/vms/{vmid}', [ 'VM.Console' ]],
1707     },
1708     parameters => {
1709         additionalProperties => 0,
1710         properties => {
1711             node => get_standard_option('pve-node'),
1712             vmid => get_standard_option('pve-vmid'),
1713             skiplock => get_standard_option('skiplock'),
1714             key => {
1715                 description => "The key (qemu monitor encoding).",
1716                 type => 'string'
1717             }
1718         },
1719     },
1720     returns => { type => 'null'},
1721     code => sub {
1722         my ($param) = @_;
1723
1724         my $rpcenv = PVE::RPCEnvironment::get();
1725
1726         my $authuser = $rpcenv->get_user();
1727
1728         my $node = extract_param($param, 'node');
1729
1730         my $vmid = extract_param($param, 'vmid');
1731
1732         my $skiplock = extract_param($param, 'skiplock');
1733         raise_param_exc({ skiplock => "Only root may use this option." })
1734             if $skiplock && $authuser ne 'root@pam';
1735
1736         PVE::QemuServer::vm_sendkey($vmid, $skiplock, $param->{key});
1737
1738         return;
1739     }});
1740
1741 __PACKAGE__->register_method({
1742     name => 'vm_feature',
1743     path => '{vmid}/feature',
1744     method => 'GET',
1745     proxyto => 'node',
1746     protected => 1,
1747     description => "Check if feature for virtual machine is available.",
1748     permissions => {
1749         check => ['perm', '/vms/{vmid}', [ 'VM.Audit' ]],
1750     },
1751     parameters => {
1752         additionalProperties => 0,
1753         properties => {
1754             node => get_standard_option('pve-node'),
1755             vmid => get_standard_option('pve-vmid'),
1756             feature => {
1757                 description => "Feature to check.",
1758                 type => 'string',
1759                 enum => [ 'snapshot', 'clone' ],
1760             },
1761             snapname => get_standard_option('pve-snapshot-name', {
1762                 optional => 1,
1763             }),
1764         },
1765     },
1766     returns => {
1767         type => 'boolean'
1768     },
1769     code => sub {
1770         my ($param) = @_;
1771
1772         my $node = extract_param($param, 'node');
1773
1774         my $vmid = extract_param($param, 'vmid');
1775
1776         my $snapname = extract_param($param, 'snapname');
1777
1778         my $feature = extract_param($param, 'feature');
1779
1780         my $running = PVE::QemuServer::check_running($vmid);
1781
1782         my $conf = PVE::QemuServer::load_config($vmid);
1783
1784         if($snapname){
1785             my $snap = $conf->{snapshots}->{$snapname};
1786             die "snapshot '$snapname' does not exist\n" if !defined($snap);
1787             $conf = $snap;
1788         }
1789         my $storecfg = PVE::Storage::config();
1790
1791         my $hasfeature = PVE::QemuServer::has_feature($feature, $conf, $storecfg, $snapname, $running);
1792         my $res = $hasfeature ? 1 : 0 ;
1793         return $res;
1794     }});
1795
1796 __PACKAGE__->register_method({
1797     name => 'clone_vm',
1798     path => '{vmid}/clone',
1799     method => 'POST',
1800     protected => 1,
1801     proxyto => 'node',
1802     description => "Create a copy of virtual machine/template.",
1803     permissions => {
1804         description => "You need 'VM.Clone' permissions on /vms/{vmid}, and 'VM.Allocate' permissions " .
1805             "on /vms/{newid} (or on the VM pool /pool/{pool}). You also need " .
1806             "'Datastore.AllocateSpace' on any used storage.",
1807         check =>
1808         [ 'and',
1809           ['perm', '/vms/{vmid}', [ 'VM.Clone' ]],
1810           [ 'or',
1811             [ 'perm', '/vms/{newid}', ['VM.Allocate']],
1812             [ 'perm', '/pool/{pool}', ['VM.Allocate'], require_param => 'pool'],
1813           ],
1814         ]
1815     },
1816     parameters => {
1817         additionalProperties => 0,
1818         properties => {
1819             node => get_standard_option('pve-node'),
1820             vmid => get_standard_option('pve-vmid'),
1821             newid => get_standard_option('pve-vmid', { description => 'VMID for the clone.' }),
1822             name => {
1823                 optional => 1,
1824                 type => 'string', format => 'dns-name',
1825                 description => "Set a name for the new VM.",
1826             },
1827             description => {
1828                 optional => 1,
1829                 type => 'string',
1830                 description => "Description for the new VM.",
1831             },
1832             pool => {
1833                 optional => 1,
1834                 type => 'string', format => 'pve-poolid',
1835                 description => "Add the new VM to the specified pool.",
1836             },
1837             snapname => get_standard_option('pve-snapshot-name', {
1838                 requires => 'full',
1839                 optional => 1,
1840             }),
1841             storage => get_standard_option('pve-storage-id', {
1842                 description => "Target storage for full clone.",
1843                 requires => 'full',
1844                 optional => 1,
1845             }),
1846             'format' => {
1847                 description => "Target format for file storage.",
1848                 requires => 'full',
1849                 type => 'string',
1850                 optional => 1,
1851                 enum => [ 'raw', 'qcow2', 'vmdk'],
1852             },
1853             full => {
1854                 optional => 1,
1855                 type => 'boolean',
1856                 description => "Create a full copy of all disk. This is always done when " .
1857                     "you clone a normal VM. For VM templates, we try to create a linked clone by default.",
1858                 default => 0,
1859             },
1860             target => get_standard_option('pve-node', {
1861                 description => "Target node. Only allowed if the original VM is on shared storage.",
1862                 optional => 1,
1863             }),
1864         },
1865     },
1866     returns => {
1867         type => 'string',
1868     },
1869     code => sub {
1870         my ($param) = @_;
1871
1872         my $rpcenv = PVE::RPCEnvironment::get();
1873
1874         my $authuser = $rpcenv->get_user();
1875
1876         my $node = extract_param($param, 'node');
1877
1878         my $vmid = extract_param($param, 'vmid');
1879
1880         my $newid = extract_param($param, 'newid');
1881
1882         # fixme: update pool after create
1883         my $pool = extract_param($param, 'pool');
1884
1885         if (defined($pool)) {
1886             $rpcenv->check_pool_exist($pool);
1887         }
1888
1889         my $snapname = extract_param($param, 'snapname');
1890
1891         my $storage = extract_param($param, 'storage');
1892
1893         my $format = extract_param($param, 'format');
1894
1895         my $target = extract_param($param, 'target');
1896
1897         my $localnode = PVE::INotify::nodename();
1898
1899         undef $target if $target && ($target eq $localnode || $target eq 'localhost');
1900
1901         PVE::Cluster::check_node_exists($target) if $target;
1902
1903         my $storecfg = PVE::Storage::config();
1904
1905         PVE::Cluster::check_cfs_quorum();
1906
1907         my $running = PVE::QemuServer::check_running($vmid) || 0;
1908
1909         die "Clone running VM $vmid not implemented\n" if $running; # fixme: implement this
1910
1911         # exclusive lock if VM is running - else shared lock is enough;
1912         my $shared_lock = $running ? 0 : 1;
1913
1914         my $clonefn = sub {
1915
1916             # do all tests after lock
1917             # we also try to do all tests before we fork the worker
1918
1919             my $conf = PVE::QemuServer::load_config($vmid);
1920
1921             PVE::QemuServer::check_lock($conf);
1922
1923             my $verify_running = PVE::QemuServer::check_running($vmid) || 0;
1924
1925             die "unexpected state change\n" if $verify_running != $running;
1926
1927             die "snapshot '$snapname' does not exist\n"
1928                 if $snapname && !defined( $conf->{snapshots}->{$snapname});
1929
1930             my $oldconf = $snapname ? $conf->{snapshots}->{$snapname} : $conf;
1931
1932             my $sharedvm = &$check_storage_access_clone($rpcenv, $authuser, $storecfg, $oldconf, $storage);
1933
1934             die "can't clone VM to node '$target' (VM uses local storage)\n" if $target && !$sharedvm;
1935
1936             my $conffile = PVE::QemuServer::config_file($newid);
1937
1938             die "unable to create VM $newid: config file already exists\n"
1939                 if -f $conffile;
1940
1941             my $newconf = { lock => 'clone' };
1942             my $drives = {};
1943             my $vollist = [];
1944
1945             foreach my $opt (keys %$oldconf) {
1946                 my $value = $oldconf->{$opt};
1947
1948                 # do not copy snapshot related info
1949                 next if $opt eq 'snapshots' ||  $opt eq 'parent' || $opt eq 'snaptime' ||
1950                     $opt eq 'vmstate' || $opt eq 'snapstate';
1951
1952                 # always change MAC! address
1953                 if ($opt =~ m/^net(\d+)$/) {
1954                     my $net = PVE::QemuServer::parse_net($value);
1955                     $net->{macaddr} =  PVE::Tools::random_ether_addr();
1956                     $newconf->{$opt} = PVE::QemuServer::print_net($net);
1957                 } elsif (my $drive = PVE::QemuServer::parse_drive($opt, $value)) {
1958                     if (PVE::QemuServer::drive_is_cdrom($drive)) {
1959                         $newconf->{$opt} = $value; # simply copy configuration
1960                     } else {
1961                         if ($param->{full} || !PVE::Storage::volume_is_base($storecfg,  $drive->{file})) {
1962                             die "Full clone feature is not available"
1963                                 if !PVE::Storage::volume_has_feature($storecfg, 'copy', $drive->{file}, $snapname, $running);
1964                             $drive->{full} = 1;
1965                         }
1966                         $drives->{$opt} = $drive;
1967                         push @$vollist, $drive->{file};
1968                     }
1969                 } else {
1970                     # copy everything else
1971                     $newconf->{$opt} = $value;
1972                 }
1973             }
1974
1975             delete $newconf->{template};
1976
1977             if ($param->{name}) {
1978                 $newconf->{name} = $param->{name};
1979             } else {
1980                 $newconf->{name} = "Copy-of-$oldconf->{name}";
1981             }
1982
1983             if ($param->{description}) {
1984                 $newconf->{description} = $param->{description};
1985             }
1986
1987             # create empty/temp config - this fails if VM already exists on other node
1988             PVE::Tools::file_set_contents($conffile, "# qmclone temporary file\nlock: clone\n");
1989
1990             my $realcmd = sub {
1991                 my $upid = shift;
1992
1993                 my $newvollist = [];
1994
1995                 eval {
1996                     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub { die "interrupted by signal\n"; };
1997
1998                     PVE::Storage::activate_volumes($storecfg, $vollist);
1999
2000                     foreach my $opt (keys %$drives) {
2001                         my $drive = $drives->{$opt};
2002
2003                         my $newvolid;
2004                         if (!$drive->{full}) {
2005                             print "create linked clone of drive $opt ($drive->{file})\n";
2006                             $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newid);
2007                             push @$newvollist, $newvolid;
2008
2009                         } else {
2010                             my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
2011                             $storeid = $storage if $storage;
2012
2013                             my $fmt = undef;
2014                             if($format){
2015                                 $fmt = $format;
2016                             }else{
2017                                 my $defformat = PVE::Storage::storage_default_format($storecfg, $storeid);
2018                                 $fmt = $drive->{format} || $defformat;
2019                             }
2020
2021                             my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
2022
2023                             print "create ful clone of drive $opt ($drive->{file})\n";
2024                             $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newid, $fmt, undef, ($size/1024));
2025                             push @$newvollist, $newvolid;
2026
2027                             PVE::QemuServer::qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
2028                         }
2029
2030                         my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
2031                         my $disk = { file => $newvolid, size => $size };
2032                         $newconf->{$opt} = PVE::QemuServer::print_drive($vmid, $disk);
2033
2034                         PVE::QemuServer::update_config_nolock($newid, $newconf, 1);
2035                     }
2036
2037                     delete $newconf->{lock};
2038                     PVE::QemuServer::update_config_nolock($newid, $newconf, 1);
2039
2040                     if ($target) {
2041                         my $newconffile = PVE::QemuServer::config_file($newid, $target);
2042                         die "Failed to move config to node '$target' - rename failed: $!\n"
2043                             if !rename($conffile, $newconffile);
2044                     }
2045                 };
2046                 if (my $err = $@) {
2047                     unlink $conffile;
2048
2049                     sleep 1; # some storage like rbd need to wait before release volume - really?
2050
2051                     foreach my $volid (@$newvollist) {
2052                         eval { PVE::Storage::vdisk_free($storecfg, $volid); };
2053                         warn $@ if $@;
2054                     }
2055                     die "clone failed: $err";
2056                 }
2057
2058                 return;
2059             };
2060
2061             return $rpcenv->fork_worker('qmclone', $vmid, $authuser, $realcmd);
2062         };
2063
2064         return PVE::QemuServer::lock_config_mode($vmid, 1, $shared_lock, sub {
2065             # Aquire exclusive lock lock for $newid
2066             return PVE::QemuServer::lock_config_full($newid, 1, $clonefn);
2067         });
2068
2069     }});
2070
2071 __PACKAGE__->register_method({
2072     name => 'migrate_vm',
2073     path => '{vmid}/migrate',
2074     method => 'POST',
2075     protected => 1,
2076     proxyto => 'node',
2077     description => "Migrate virtual machine. Creates a new migration task.",
2078     permissions => {
2079         check => ['perm', '/vms/{vmid}', [ 'VM.Migrate' ]],
2080     },
2081     parameters => {
2082         additionalProperties => 0,
2083         properties => {
2084             node => get_standard_option('pve-node'),
2085             vmid => get_standard_option('pve-vmid'),
2086             target => get_standard_option('pve-node', { description => "Target node." }),
2087             online => {
2088                 type => 'boolean',
2089                 description => "Use online/live migration.",
2090                 optional => 1,
2091             },
2092             force => {
2093                 type => 'boolean',
2094                 description => "Allow to migrate VMs which use local devices. Only root may use this option.",
2095                 optional => 1,
2096             },
2097         },
2098     },
2099     returns => {
2100         type => 'string',
2101         description => "the task ID.",
2102     },
2103     code => sub {
2104         my ($param) = @_;
2105
2106         my $rpcenv = PVE::RPCEnvironment::get();
2107
2108         my $authuser = $rpcenv->get_user();
2109
2110         my $target = extract_param($param, 'target');
2111
2112         my $localnode = PVE::INotify::nodename();
2113         raise_param_exc({ target => "target is local node."}) if $target eq $localnode;
2114
2115         PVE::Cluster::check_cfs_quorum();
2116
2117         PVE::Cluster::check_node_exists($target);
2118
2119         my $targetip = PVE::Cluster::remote_node_ip($target);
2120
2121         my $vmid = extract_param($param, 'vmid');
2122
2123         raise_param_exc({ force => "Only root may use this option." })
2124             if $param->{force} && $authuser ne 'root@pam';
2125
2126         # test if VM exists
2127         my $conf = PVE::QemuServer::load_config($vmid);
2128
2129         # try to detect errors early
2130
2131         PVE::QemuServer::check_lock($conf);
2132
2133         if (PVE::QemuServer::check_running($vmid)) {
2134             die "cant migrate running VM without --online\n"
2135                 if !$param->{online};
2136         }
2137
2138         my $storecfg = PVE::Storage::config();
2139         PVE::QemuServer::check_storage_availability($storecfg, $conf, $target);
2140
2141         if (&$vm_is_ha_managed($vmid) && $rpcenv->{type} ne 'ha') {
2142
2143             my $hacmd = sub {
2144                 my $upid = shift;
2145
2146                 my $service = "pvevm:$vmid";
2147
2148                 my $cmd = ['clusvcadm', '-M', $service, '-m', $target];
2149
2150                 print "Executing HA migrate for VM $vmid to node $target\n";
2151
2152                 PVE::Tools::run_command($cmd);
2153
2154                 return;
2155             };
2156
2157             return $rpcenv->fork_worker('hamigrate', $vmid, $authuser, $hacmd);
2158
2159         } else {
2160
2161             my $realcmd = sub {
2162                 my $upid = shift;
2163
2164                 PVE::QemuMigrate->migrate($target, $targetip, $vmid, $param);
2165             };
2166
2167             return $rpcenv->fork_worker('qmigrate', $vmid, $authuser, $realcmd);
2168         }
2169
2170     }});
2171
2172 __PACKAGE__->register_method({
2173     name => 'monitor',
2174     path => '{vmid}/monitor',
2175     method => 'POST',
2176     protected => 1,
2177     proxyto => 'node',
2178     description => "Execute Qemu monitor commands.",
2179     permissions => {
2180         check => ['perm', '/vms/{vmid}', [ 'VM.Monitor' ]],
2181     },
2182     parameters => {
2183         additionalProperties => 0,
2184         properties => {
2185             node => get_standard_option('pve-node'),
2186             vmid => get_standard_option('pve-vmid'),
2187             command => {
2188                 type => 'string',
2189                 description => "The monitor command.",
2190             }
2191         },
2192     },
2193     returns => { type => 'string'},
2194     code => sub {
2195         my ($param) = @_;
2196
2197         my $vmid = $param->{vmid};
2198
2199         my $conf = PVE::QemuServer::load_config ($vmid); # check if VM exists
2200
2201         my $res = '';
2202         eval {
2203             $res = PVE::QemuServer::vm_human_monitor_command($vmid, $param->{command});
2204         };
2205         $res = "ERROR: $@" if $@;
2206
2207         return $res;
2208     }});
2209
2210 __PACKAGE__->register_method({
2211     name => 'resize_vm',
2212     path => '{vmid}/resize',
2213     method => 'PUT',
2214     protected => 1,
2215     proxyto => 'node',
2216     description => "Extend volume size.",
2217     permissions => {
2218         check => ['perm', '/vms/{vmid}', [ 'VM.Config.Disk' ]],
2219     },
2220     parameters => {
2221         additionalProperties => 0,
2222         properties => {
2223             node => get_standard_option('pve-node'),
2224             vmid => get_standard_option('pve-vmid'),
2225             skiplock => get_standard_option('skiplock'),
2226             disk => {
2227                 type => 'string',
2228                 description => "The disk you want to resize.",
2229                 enum => [PVE::QemuServer::disknames()],
2230             },
2231             size => {
2232                 type => 'string',
2233                 pattern => '\+?\d+(\.\d+)?[KMGT]?',
2234                 description => "The new size. With the '+' sign the value is added to the actual size of the volume and without it, the value is taken as an absolute one. Shrinking disk size is not supported.",
2235             },
2236             digest => {
2237                 type => 'string',
2238                 description => 'Prevent changes if current configuration file has different SHA1 digest. This can be used to prevent concurrent modifications.',
2239                 maxLength => 40,
2240                 optional => 1,
2241             },
2242         },
2243     },
2244     returns => { type => 'null'},
2245     code => sub {
2246         my ($param) = @_;
2247
2248         my $rpcenv = PVE::RPCEnvironment::get();
2249
2250         my $authuser = $rpcenv->get_user();
2251
2252         my $node = extract_param($param, 'node');
2253
2254         my $vmid = extract_param($param, 'vmid');
2255
2256         my $digest = extract_param($param, 'digest');
2257
2258         my $disk = extract_param($param, 'disk');
2259
2260         my $sizestr = extract_param($param, 'size');
2261
2262         my $skiplock = extract_param($param, 'skiplock');
2263         raise_param_exc({ skiplock => "Only root may use this option." })
2264             if $skiplock && $authuser ne 'root@pam';
2265
2266         my $storecfg = PVE::Storage::config();
2267
2268         my $updatefn =  sub {
2269
2270             my $conf = PVE::QemuServer::load_config($vmid);
2271
2272             die "checksum missmatch (file change by other user?)\n"
2273                 if $digest && $digest ne $conf->{digest};
2274             PVE::QemuServer::check_lock($conf) if !$skiplock;
2275
2276             die "disk '$disk' does not exist\n" if !$conf->{$disk};
2277
2278             my $drive = PVE::QemuServer::parse_drive($disk, $conf->{$disk});
2279
2280             my $volid = $drive->{file};
2281
2282             die "disk '$disk' has no associated volume\n" if !$volid;
2283
2284             die "you can't resize a cdrom\n" if PVE::QemuServer::drive_is_cdrom($drive);
2285
2286             die "you can't online resize a virtio windows bootdisk\n"
2287                 if PVE::QemuServer::check_running($vmid) && $conf->{bootdisk} eq $disk && $conf->{ostype} =~ m/^w/ && $disk =~ m/^virtio/;
2288
2289             my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid);
2290
2291             $rpcenv->check($authuser, "/storage/$storeid", ['Datastore.AllocateSpace']);
2292
2293             my $size = PVE::Storage::volume_size_info($storecfg, $volid, 5);
2294
2295             die "internal error" if $sizestr !~ m/^(\+)?(\d+(\.\d+)?)([KMGT])?$/;
2296             my ($ext, $newsize, $unit) = ($1, $2, $4);
2297             if ($unit) {
2298                 if ($unit eq 'K') {
2299                     $newsize = $newsize * 1024;
2300                 } elsif ($unit eq 'M') {
2301                     $newsize = $newsize * 1024 * 1024;
2302                 } elsif ($unit eq 'G') {
2303                     $newsize = $newsize * 1024 * 1024 * 1024;
2304                 } elsif ($unit eq 'T') {
2305                     $newsize = $newsize * 1024 * 1024 * 1024 * 1024;
2306                 }
2307             }
2308             $newsize += $size if $ext;
2309             $newsize = int($newsize);
2310
2311             die "unable to skrink disk size\n" if $newsize < $size;
2312
2313             return if $size == $newsize;
2314
2315             PVE::Cluster::log_msg('info', $authuser, "update VM $vmid: resize --disk $disk --size $sizestr");
2316
2317             PVE::QemuServer::qemu_block_resize($vmid, "drive-$disk", $storecfg, $volid, $newsize);
2318
2319             $drive->{size} = $newsize;
2320             $conf->{$disk} = PVE::QemuServer::print_drive($vmid, $drive);
2321
2322             PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
2323         };
2324
2325         PVE::QemuServer::lock_config($vmid, $updatefn);
2326         return undef;
2327     }});
2328
2329 __PACKAGE__->register_method({
2330     name => 'snapshot_list',
2331     path => '{vmid}/snapshot',
2332     method => 'GET',
2333     description => "List all snapshots.",
2334     permissions => {
2335         check => ['perm', '/vms/{vmid}', [ 'VM.Audit' ]],
2336     },
2337     proxyto => 'node',
2338     protected => 1, # qemu pid files are only readable by root
2339     parameters => {
2340         additionalProperties => 0,
2341         properties => {
2342             vmid => get_standard_option('pve-vmid'),
2343             node => get_standard_option('pve-node'),
2344         },
2345     },
2346     returns => {
2347         type => 'array',
2348         items => {
2349             type => "object",
2350             properties => {},
2351         },
2352         links => [ { rel => 'child', href => "{name}" } ],
2353     },
2354     code => sub {
2355         my ($param) = @_;
2356
2357         my $vmid = $param->{vmid};
2358
2359         my $conf = PVE::QemuServer::load_config($vmid);
2360         my $snaphash = $conf->{snapshots} || {};
2361
2362         my $res = [];
2363
2364         foreach my $name (keys %$snaphash) {
2365             my $d = $snaphash->{$name};
2366             my $item = {
2367                 name => $name,
2368                 snaptime => $d->{snaptime} || 0,
2369                 vmstate => $d->{vmstate} ? 1 : 0,
2370                 description => $d->{description} || '',
2371             };
2372             $item->{parent} = $d->{parent} if $d->{parent};
2373             $item->{snapstate} = $d->{snapstate} if $d->{snapstate};
2374             push @$res, $item;
2375         }
2376
2377         my $running = PVE::QemuServer::check_running($vmid, 1) ? 1 : 0;
2378         my $current = { name => 'current', digest => $conf->{digest}, running => $running };
2379         $current->{parent} = $conf->{parent} if $conf->{parent};
2380
2381         push @$res, $current;
2382
2383         return $res;
2384     }});
2385
2386 __PACKAGE__->register_method({
2387     name => 'snapshot',
2388     path => '{vmid}/snapshot',
2389     method => 'POST',
2390     protected => 1,
2391     proxyto => 'node',
2392     description => "Snapshot a VM.",
2393     permissions => {
2394         check => ['perm', '/vms/{vmid}', [ 'VM.Snapshot' ]],
2395     },
2396     parameters => {
2397         additionalProperties => 0,
2398         properties => {
2399             node => get_standard_option('pve-node'),
2400             vmid => get_standard_option('pve-vmid'),
2401             snapname => get_standard_option('pve-snapshot-name'),
2402             vmstate => {
2403                 optional => 1,
2404                 type => 'boolean',
2405                 description => "Save the vmstate",
2406             },
2407             freezefs => {
2408                 optional => 1,
2409                 type => 'boolean',
2410                 description => "Freeze the filesystem",
2411             },
2412             description => {
2413                 optional => 1,
2414                 type => 'string',
2415                 description => "A textual description or comment.",
2416             },
2417         },
2418     },
2419     returns => {
2420         type => 'string',
2421         description => "the task ID.",
2422     },
2423     code => sub {
2424         my ($param) = @_;
2425
2426         my $rpcenv = PVE::RPCEnvironment::get();
2427
2428         my $authuser = $rpcenv->get_user();
2429
2430         my $node = extract_param($param, 'node');
2431
2432         my $vmid = extract_param($param, 'vmid');
2433
2434         my $snapname = extract_param($param, 'snapname');
2435
2436         die "unable to use snapshot name 'current' (reserved name)\n"
2437             if $snapname eq 'current';
2438
2439         my $realcmd = sub {
2440             PVE::Cluster::log_msg('info', $authuser, "snapshot VM $vmid: $snapname");
2441             PVE::QemuServer::snapshot_create($vmid, $snapname, $param->{vmstate},
2442                                              $param->{freezefs}, $param->{description});
2443         };
2444
2445         return $rpcenv->fork_worker('qmsnapshot', $vmid, $authuser, $realcmd);
2446     }});
2447
2448 __PACKAGE__->register_method({
2449     name => 'snapshot_cmd_idx',
2450     path => '{vmid}/snapshot/{snapname}',
2451     description => '',
2452     method => 'GET',
2453     permissions => {
2454         user => 'all',
2455     },
2456     parameters => {
2457         additionalProperties => 0,
2458         properties => {
2459             vmid => get_standard_option('pve-vmid'),
2460             node => get_standard_option('pve-node'),
2461             snapname => get_standard_option('pve-snapshot-name'),
2462         },
2463     },
2464     returns => {
2465         type => 'array',
2466         items => {
2467             type => "object",
2468             properties => {},
2469         },
2470         links => [ { rel => 'child', href => "{cmd}" } ],
2471     },
2472     code => sub {
2473         my ($param) = @_;
2474
2475         my $res = [];
2476
2477         push @$res, { cmd => 'rollback' };
2478         push @$res, { cmd => 'config' };
2479
2480         return $res;
2481     }});
2482
2483 __PACKAGE__->register_method({
2484     name => 'update_snapshot_config',
2485     path => '{vmid}/snapshot/{snapname}/config',
2486     method => 'PUT',
2487     protected => 1,
2488     proxyto => 'node',
2489     description => "Update snapshot metadata.",
2490     permissions => {
2491         check => ['perm', '/vms/{vmid}', [ 'VM.Snapshot' ]],
2492     },
2493     parameters => {
2494         additionalProperties => 0,
2495         properties => {
2496             node => get_standard_option('pve-node'),
2497             vmid => get_standard_option('pve-vmid'),
2498             snapname => get_standard_option('pve-snapshot-name'),
2499             description => {
2500                 optional => 1,
2501                 type => 'string',
2502                 description => "A textual description or comment.",
2503             },
2504         },
2505     },
2506     returns => { type => 'null' },
2507     code => sub {
2508         my ($param) = @_;
2509
2510         my $rpcenv = PVE::RPCEnvironment::get();
2511
2512         my $authuser = $rpcenv->get_user();
2513
2514         my $vmid = extract_param($param, 'vmid');
2515
2516         my $snapname = extract_param($param, 'snapname');
2517
2518         return undef if !defined($param->{description});
2519
2520         my $updatefn =  sub {
2521
2522             my $conf = PVE::QemuServer::load_config($vmid);
2523
2524             PVE::QemuServer::check_lock($conf);
2525
2526             my $snap = $conf->{snapshots}->{$snapname};
2527
2528             die "snapshot '$snapname' does not exist\n" if !defined($snap);
2529
2530             $snap->{description} = $param->{description} if defined($param->{description});
2531
2532              PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
2533         };
2534
2535         PVE::QemuServer::lock_config($vmid, $updatefn);
2536
2537         return undef;
2538     }});
2539
2540 __PACKAGE__->register_method({
2541     name => 'get_snapshot_config',
2542     path => '{vmid}/snapshot/{snapname}/config',
2543     method => 'GET',
2544     proxyto => 'node',
2545     description => "Get snapshot configuration",
2546     permissions => {
2547         check => ['perm', '/vms/{vmid}', [ 'VM.Snapshot' ]],
2548     },
2549     parameters => {
2550         additionalProperties => 0,
2551         properties => {
2552             node => get_standard_option('pve-node'),
2553             vmid => get_standard_option('pve-vmid'),
2554             snapname => get_standard_option('pve-snapshot-name'),
2555         },
2556     },
2557     returns => { type => "object" },
2558     code => sub {
2559         my ($param) = @_;
2560
2561         my $rpcenv = PVE::RPCEnvironment::get();
2562
2563         my $authuser = $rpcenv->get_user();
2564
2565         my $vmid = extract_param($param, 'vmid');
2566
2567         my $snapname = extract_param($param, 'snapname');
2568
2569         my $conf = PVE::QemuServer::load_config($vmid);
2570
2571         my $snap = $conf->{snapshots}->{$snapname};
2572
2573         die "snapshot '$snapname' does not exist\n" if !defined($snap);
2574
2575         return $snap;
2576     }});
2577
2578 __PACKAGE__->register_method({
2579     name => 'rollback',
2580     path => '{vmid}/snapshot/{snapname}/rollback',
2581     method => 'POST',
2582     protected => 1,
2583     proxyto => 'node',
2584     description => "Rollback VM state to specified snapshot.",
2585     permissions => {
2586         check => ['perm', '/vms/{vmid}', [ 'VM.Snapshot' ]],
2587     },
2588     parameters => {
2589         additionalProperties => 0,
2590         properties => {
2591             node => get_standard_option('pve-node'),
2592             vmid => get_standard_option('pve-vmid'),
2593             snapname => get_standard_option('pve-snapshot-name'),
2594         },
2595     },
2596     returns => {
2597         type => 'string',
2598         description => "the task ID.",
2599     },
2600     code => sub {
2601         my ($param) = @_;
2602
2603         my $rpcenv = PVE::RPCEnvironment::get();
2604
2605         my $authuser = $rpcenv->get_user();
2606
2607         my $node = extract_param($param, 'node');
2608
2609         my $vmid = extract_param($param, 'vmid');
2610
2611         my $snapname = extract_param($param, 'snapname');
2612
2613         my $realcmd = sub {
2614             PVE::Cluster::log_msg('info', $authuser, "rollback snapshot VM $vmid: $snapname");
2615             PVE::QemuServer::snapshot_rollback($vmid, $snapname);
2616         };
2617
2618         return $rpcenv->fork_worker('qmrollback', $vmid, $authuser, $realcmd);
2619     }});
2620
2621 __PACKAGE__->register_method({
2622     name => 'delsnapshot',
2623     path => '{vmid}/snapshot/{snapname}',
2624     method => 'DELETE',
2625     protected => 1,
2626     proxyto => 'node',
2627     description => "Delete a VM snapshot.",
2628     permissions => {
2629         check => ['perm', '/vms/{vmid}', [ 'VM.Snapshot' ]],
2630     },
2631     parameters => {
2632         additionalProperties => 0,
2633         properties => {
2634             node => get_standard_option('pve-node'),
2635             vmid => get_standard_option('pve-vmid'),
2636             snapname => get_standard_option('pve-snapshot-name'),
2637             force => {
2638                 optional => 1,
2639                 type => 'boolean',
2640                 description => "For removal from config file, even if removing disk snapshots fails.",
2641             },
2642         },
2643     },
2644     returns => {
2645         type => 'string',
2646         description => "the task ID.",
2647     },
2648     code => sub {
2649         my ($param) = @_;
2650
2651         my $rpcenv = PVE::RPCEnvironment::get();
2652
2653         my $authuser = $rpcenv->get_user();
2654
2655         my $node = extract_param($param, 'node');
2656
2657         my $vmid = extract_param($param, 'vmid');
2658
2659         my $snapname = extract_param($param, 'snapname');
2660
2661         my $realcmd = sub {
2662             PVE::Cluster::log_msg('info', $authuser, "delete snapshot VM $vmid: $snapname");
2663             PVE::QemuServer::snapshot_delete($vmid, $snapname, $param->{force});
2664         };
2665
2666         return $rpcenv->fork_worker('qmdelsnapshot', $vmid, $authuser, $realcmd);
2667     }});
2668
2669 __PACKAGE__->register_method({
2670     name => 'template',
2671     path => '{vmid}/template',
2672     method => 'POST',
2673     protected => 1,
2674     proxyto => 'node',
2675     description => "Create a Template.",
2676     permissions => {
2677         description => "You need 'VM.Allocate' permissions on /vms/{vmid} or on the VM pool /pool/{pool}.",
2678         check => [ 'or',
2679                    [ 'perm', '/vms/{vmid}', ['VM.Allocate']],
2680                    [ 'perm', '/pool/{pool}', ['VM.Allocate'], require_param => 'pool'],
2681             ],
2682     },
2683     parameters => {
2684         additionalProperties => 0,
2685         properties => {
2686             node => get_standard_option('pve-node'),
2687             vmid => get_standard_option('pve-vmid'),
2688             disk => {
2689                 optional => 1,
2690                 type => 'string',
2691                 description => "If you want to convert only 1 disk to base image.",
2692                 enum => [PVE::QemuServer::disknames()],
2693             },
2694
2695         },
2696     },
2697     returns => { type => 'null'},
2698     code => sub {
2699         my ($param) = @_;
2700
2701         my $rpcenv = PVE::RPCEnvironment::get();
2702
2703         my $authuser = $rpcenv->get_user();
2704
2705         my $node = extract_param($param, 'node');
2706
2707         my $vmid = extract_param($param, 'vmid');
2708
2709         my $disk = extract_param($param, 'disk');
2710
2711         my $updatefn =  sub {
2712
2713             my $conf = PVE::QemuServer::load_config($vmid);
2714
2715             PVE::QemuServer::check_lock($conf);
2716
2717             die "unable to create template, because VM contains snapshots\n"
2718                 if $conf->{snapshots} && scalar(keys %{$conf->{snapshots}});
2719
2720             die "you can't convert a template to a template\n"
2721                 if PVE::QemuServer::is_template($conf) && !$disk;
2722
2723             die "you can't convert a VM to template if VM is running\n"
2724                 if PVE::QemuServer::check_running($vmid);
2725
2726             my $realcmd = sub {
2727                 PVE::QemuServer::template_create($vmid, $conf, $disk);
2728             };
2729
2730             $conf->{template} = 1;
2731             PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
2732
2733             return $rpcenv->fork_worker('qmtemplate', $vmid, $authuser, $realcmd);
2734         };
2735
2736         PVE::QemuServer::lock_config($vmid, $updatefn);
2737         return undef;
2738     }});
2739
2740
2741
2742 1;