src/PVE/LXC.pm

   1 package PVE::LXC;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX qw(EINTR);
   6
   7 use File::Path;
   8 use Fcntl ':flock';
   9
  10 use PVE::Cluster qw(cfs_register_file cfs_read_file);
  11 use PVE::Storage;
  12 use PVE::SafeSyslog;
  13 use PVE::INotify;
  14 use PVE::JSONSchema qw(get_standard_option);
  15 use PVE::Tools qw($IPV6RE $IPV4RE);
  16 use PVE::Network;
  17
  18 use Data::Dumper;
  19
  20 cfs_register_file('/lxc/', \&parse_lxc_config, \&write_lxc_config);
  21
  22 PVE::JSONSchema::register_format('pve-lxc-network', \&verify_lxc_network);
  23 sub verify_lxc_network {
  24     my ($value, $noerr) = @_;
  25
  26     return $value if parse_lxc_network($value);
  27
  28     return undef if $noerr;
  29
  30     die "unable to parse network setting\n";
  31 }
  32
  33 my $nodename = PVE::INotify::nodename();
  34
  35 sub parse_lxc_size {
  36     my ($name, $value) = @_;
  37
  38     if ($value =~ m/^(\d+)(b|k|m|g)?$/i) {
  39         my ($res, $unit) = ($1, lc($2 || 'b'));
  40
  41         return $res if $unit eq 'b';
  42         return $res*1024 if $unit eq 'k';
  43         return $res*1024*1024 if $unit eq 'm';
  44         return $res*1024*1024*1024 if $unit eq 'g';
  45     }
  46
  47     return undef;
  48 }
  49
  50 my $valid_lxc_keys = {
  51     'lxc.arch' => 'i386|x86|i686|x86_64|amd64',
  52     'lxc.include' => 1,
  53     'lxc.rootfs' => 1,
  54     'lxc.mount' => 1,
  55     'lxc.utsname' => 1,
  56
  57     'lxc.id_map' => 1,
  58
  59     'lxc.cgroup.memory.limit_in_bytes' => \&parse_lxc_size,
  60     'lxc.cgroup.memory.memsw.limit_in_bytes' => \&parse_lxc_size,
  61     'lxc.cgroup.cpu.cfs_period_us' => '\d+',
  62     'lxc.cgroup.cpu.cfs_quota_us' => '\d+',
  63     'lxc.cgroup.cpu.shares' => '\d+',
  64
  65     # mount related
  66     'lxc.mount' => 1,
  67     'lxc.mount.entry' => 1,
  68     'lxc.mount.auto' => 1,
  69
  70     # security related
  71     'lxc.seccomp' => 1,
  72
  73     # not used by pve
  74     'lxc.tty' => '\d+',
  75     'lxc.pts' => 1,
  76     'lxc.haltsignal' => 1,
  77     'lxc.rebootsignal' => 1,
  78     'lxc.stopsignal' => 1,
  79     'lxc.init_cmd' => 1,
  80     'lxc.console' => 1,
  81     'lxc.console.logfile' => 1,
  82     'lxc.devttydir' => 1,
  83     'lxc.autodev' => 1,
  84     'lxc.kmsg' => 1,
  85     'lxc.cap.drop' => 1,
  86     'lxc.cap.keep' => 1,
  87     'lxc.aa_profile' => 1,
  88     'lxc.aa_allow_incomplete' => 1,
  89     'lxc.se_context' => 1,
  90     'lxc.loglevel' => 1,
  91     'lxc.logfile' => 1,
  92     'lxc.environment' => 1,
  93     'lxc.cgroup.devices.deny' => 1,
  94
  95     # autostart
  96     'lxc.start.auto' => 1,
  97     'lxc.start.delay' => 1,
  98     'lxc.start.order' => 1,
  99     'lxc.group' => 1,
 100
 101     # hooks
 102     'lxc.hook.pre-start' => 1,
 103     'lxc.hook.pre-mount' => 1,
 104     'lxc.hook.mount' => 1,
 105     'lxc.hook.autodev' => 1,
 106     'lxc.hook.start' => 1,
 107     'lxc.hook.post-stop' => 1,
 108     'lxc.hook.clone' => 1,
 109
 110     # pve related keys
 111     'pve.nameserver' => sub {
 112         my ($name, $value) = @_;
 113         return verify_nameserver_list($value);
 114     },
 115     'pve.searchdomain' => sub {
 116         my ($name, $value) = @_;
 117         return verify_searchdomain_list($value);
 118     },
 119     'pve.onboot' => '(0|1)',
 120     'pve.startup' => sub {
 121         my ($name, $value) = @_;
 122         return PVE::JSONSchema::pve_verify_startup_order($value);
 123     },
 124     'pve.comment' => 1,
 125     'pve.disksize' => '\d+(\.\d+)?',
 126     'pve.volid' => sub {
 127         my ($name, $value) = @_;
 128         PVE::Storage::parse_volume_id($value);
 129         return $value;
 130     },
 131
 132      #pve snapshot
 133     'pve.lock' => 1,
 134     'pve.snaptime' => 1,
 135     'pve.snapcomment' => 1,
 136     'pve.parent' => 1,
 137     'pve.snapstate' => 1,
 138     'pve.snapname' => 1,
 139 };
 140
 141 my $valid_lxc_network_keys = {
 142     type => 1,
 143     mtu => 1,
 144     name => 1, # ifname inside container
 145     'veth.pair' => 1, # ifname at host (eth${vmid}.X)
 146     hwaddr => 1,
 147 };
 148
 149 my $valid_pve_network_keys = {
 150     bridge => 1,
 151     tag => 1,
 152     firewall => 1,
 153     ip => 1,
 154     gw => 1,
 155     ip6 => 1,
 156     gw6 => 1,
 157 };
 158
 159 my $lxc_array_configs = {
 160     'lxc.network' => 1,
 161     'lxc.mount' => 1,
 162     'lxc.include' => 1,
 163     'lxc.id_map' => 1,
 164     'lxc.cgroup.devices.deny' => 1,
 165 };
 166
 167 sub write_lxc_config {
 168     my ($filename, $data) = @_;
 169
 170     my $raw = "";
 171
 172     return $raw if !$data;
 173
 174     my $dump_entry = sub {
 175         my ($k, $value, $done_hash, $snapshot) = @_;
 176         return if !defined($value);
 177         return if $done_hash->{$k};
 178         $done_hash->{$k} = 1;
 179         if (ref($value)) {
 180             die "got unexpected reference for '$k'"
 181                 if !$lxc_array_configs->{$k};
 182             foreach my $v (@$value) {
 183                 $raw .= 'snap.' if $snapshot;
 184                 $raw .= "$k = $v\n";
 185             }
 186         } else {
 187             $raw .= 'snap.' if $snapshot;
 188             $raw .= "$k = $value\n";
 189         }
 190     };
 191
 192     my $config_writer = sub {
 193         my ($elem, $snapshot) = @_;
 194
 195         my $done_hash = { digest => 1};
 196
 197         if (defined(my $value = $elem->{'pve.snapname'})) {
 198              &$dump_entry('pve.snapname', $value, $done_hash, $snapshot);
 199         }
 200
 201         # Note: Order is important! Include defaults first, so that we
 202         # can overwrite them later.
 203         &$dump_entry('lxc.include', $elem->{'lxc.include'}, $done_hash, $snapshot);
 204
 205         foreach my $k (sort keys %$elem) {
 206             next if $k !~ m/^lxc\./;
 207             &$dump_entry($k, $elem->{$k}, $done_hash, $snapshot);
 208         }
 209         foreach my $k (sort keys %$elem) {
 210             next if $k !~ m/^pve\./;
 211             &$dump_entry($k, $elem->{$k}, $done_hash, $snapshot);
 212         }
 213         my $network_count = 0;
 214
 215         foreach my $k (sort keys %$elem) {
 216             next if $k !~ m/^net\d+$/;
 217             $done_hash->{$k} = 1;
 218
 219             my $net = $elem->{$k};
 220             $network_count++;
 221             $raw .= 'snap.' if $snapshot;
 222             $raw .= "lxc.network.type = $net->{type}\n";
 223             foreach my $subkey (sort keys %$net) {
 224                 next if $subkey eq 'type';
 225                 if ($valid_lxc_network_keys->{$subkey}) {
 226                     $raw .= 'snap.' if $snapshot;
 227                     $raw .= "lxc.network.$subkey = $net->{$subkey}\n";
 228                 } elsif ($valid_pve_network_keys->{$subkey}) {
 229                     $raw .= 'snap.' if $snapshot;
 230                     $raw .= "pve.network.$subkey = $net->{$subkey}\n";
 231                 } else {
 232                     die "found invalid network key '$subkey'";
 233                 }
 234             }
 235         }
 236         if (!$network_count) {
 237             $raw .= 'snap.' if $snapshot;
 238             $raw .= "lxc.network.type = empty\n";
 239         }
 240         foreach my $k (sort keys %$elem) {
 241             next if $k eq 'snapshots';
 242             next if $done_hash->{$k};
 243             die "found un-written value \"$k\" in config - implement this!";
 244         }
 245
 246     };
 247
 248     &$config_writer($data);
 249
 250     if ($data->{snapshots}) {
 251         my @tmp = sort { $data->{snapshots}->{$b}{'pve.snaptime'} <=>
 252                               $data->{snapshots}->{$a}{'pve.snaptime'} }
 253                         keys %{$data->{snapshots}};
 254         foreach my $snapname (@tmp) {
 255             $raw .= "\n";
 256             &$config_writer($data->{snapshots}->{$snapname}, 1);
 257         }
 258     }
 259
 260     return $raw;
 261 }
 262
 263 sub parse_lxc_option {
 264     my ($name, $value) = @_;
 265
 266     my $parser = $valid_lxc_keys->{$name};
 267
 268     die "invalid key '$name'\n" if !defined($parser);
 269
 270     if ($parser eq '1') {
 271         return $value;
 272     } elsif (ref($parser)) {
 273         my $res = &$parser($name, $value);
 274         return $res if defined($res);
 275     } else {
 276         # assume regex
 277         return $value if $value =~ m/^$parser$/;
 278     }
 279
 280     die "unable to parse value '$value' for option '$name'\n";
 281 }
 282
 283 sub parse_lxc_config {
 284     my ($filename, $raw) = @_;
 285
 286     return undef if !defined($raw);
 287
 288     my $data = {
 289         digest => Digest::SHA::sha1_hex($raw),
 290     };
 291
 292     $filename =~ m|/lxc/(\d+)/config$|
 293         || die "got strange filename '$filename'";
 294
 295     my $vmid = $1;
 296
 297
 298     my $network_counter = 0;
 299     my $network_list = [];
 300     my $host_ifnames = {};
 301     my $snapname;
 302     my $network;
 303
 304     my $find_next_hostif_name = sub {
 305         for (my $i = 0; $i < 10; $i++) {
 306             my $name = "veth${vmid}.$i";
 307             if (!$host_ifnames->{$name}) {
 308                 $host_ifnames->{$name} = 1;
 309                 return $name;
 310             }
 311         }
 312
 313         die "unable to find free host_ifname"; # should not happen
 314     };
 315
 316     my $push_network = sub {
 317         my ($netconf) = @_;
 318         return if !$netconf;
 319         push @{$network_list}, $netconf;
 320         $network_counter++;
 321         if (my $netname = $netconf->{'veth.pair'}) {
 322             if ($netname =~ m/^veth(\d+).(\d)$/) {
 323                 die "wrong vmid for network interface pair\n" if $1 != $vmid;
 324                 my $host_ifnames->{$netname} = 1;
 325             } else {
 326                 die "wrong network interface pair\n";
 327             }
 328         }
 329     };
 330
 331     my $finalize_section = sub {
 332         &$push_network($network); # flush
 333
 334         foreach my $net (@{$network_list}) {
 335             next if $net->{type} eq 'empty'; # skip
 336             $net->{'veth.pair'} = &$find_next_hostif_name() if !$net->{'veth.pair'};
 337             $net->{hwaddr} =  PVE::Tools::random_ether_addr() if !$net->{hwaddr};
 338             die "unsupported network type '$net->{type}'\n" if $net->{type} ne 'veth';
 339
 340             if ($net->{'veth.pair'} =~ m/^veth\d+.(\d+)$/) {
 341                 if ($snapname) {
 342                     $data->{snapshots}->{$snapname}->{"net$1"} = $net;
 343                 } else {
 344                     $data->{"net$1"} = $net;
 345                 }
 346             }
 347         }
 348
 349         # reset helper vars
 350         $network_counter = 0;
 351         $network_list = [];
 352         $host_ifnames = {};
 353         $network = undef;
 354     };
 355
 356     while ($raw && $raw =~ s/^(.*)?(\n|$)//) {
 357         my $line = $1;
 358         next if $line =~ m/^\s*$/; # skip empty lines
 359         next if $line =~ m/^#/; # skip comments
 360
 361         # snap.pve.snapname starts new sections
 362         if ($line =~ m/^(snap\.)?pve\.snapname\s*=\s*(\w*)\s*$/) {
 363             my $value = $2;
 364
 365             &$finalize_section();
 366
 367             $snapname = $value;
 368             $data->{snapshots}->{$snapname}->{'pve.snapname'} = $snapname;
 369
 370         } elsif ($line =~ m/^(snap\.)?lxc\.network\.(\S+)\s*=\s*(\S+)\s*$/) {
 371             my ($subkey, $value) = ($2, $3);
 372             if ($subkey eq 'type') {
 373                 &$push_network($network);
 374                 $network = { type => $value };
 375             } elsif ($valid_lxc_network_keys->{$subkey}) {
 376                 $network->{$subkey} = $value;
 377             } else {
 378                 die "unable to parse config line: $line\n";
 379             }
 380         } elsif ($line =~ m/^(snap\.)?pve\.network\.(\S+)\s*=\s*(\S+)\s*$/) {
 381             my ($subkey, $value) = ($2, $3);
 382             if ($valid_pve_network_keys->{$subkey}) {
 383                 $network->{$subkey} = $value;
 384             } else {
 385                 die "unable to parse config line: $line\n";
 386             }
 387         } elsif ($line =~ m/^(snap\.)?((?:pve|lxc)\.\S+)\s*=\s*(\S.*)\s*$/) {
 388             my ($name, $value) = ($2, $3);
 389
 390             if ($lxc_array_configs->{$name}) {
 391                 $data->{$name} = [] if !defined($data->{$name});
 392                 if ($snapname) {
 393                     push @{$data->{snapshots}->{$snapname}->{$name}},  parse_lxc_option($name, $value);
 394                 } else {
 395                     push @{$data->{$name}},  parse_lxc_option($name, $value);
 396                 }
 397             } else {
 398                 if ($snapname) {
 399                     die "multiple definitions for $name\n" if defined($data->{snapshots}->{$snapname}->{$name});
 400                     $data->{snapshots}->{$snapname}->{$name} = parse_lxc_option($name, $value);
 401                 } else {
 402                     die "multiple definitions for $name\n" if defined($data->{$name});
 403                     $data->{$name} = parse_lxc_option($name, $value);
 404                 }
 405             }
 406         } else {
 407             die "unable to parse config line: $line\n";
 408         }
 409     }
 410
 411     &$finalize_section();
 412
 413     return $data;
 414 }
 415
 416 sub config_list {
 417     my $vmlist = PVE::Cluster::get_vmlist();
 418     my $res = {};
 419     return $res if !$vmlist || !$vmlist->{ids};
 420     my $ids = $vmlist->{ids};
 421
 422     foreach my $vmid (keys %$ids) {
 423         next if !$vmid; # skip CT0
 424         my $d = $ids->{$vmid};
 425         next if !$d->{node} || $d->{node} ne $nodename;
 426         next if !$d->{type} || $d->{type} ne 'lxc';
 427         $res->{$vmid}->{type} = 'lxc';
 428     }
 429     return $res;
 430 }
 431
 432 sub cfs_config_path {
 433     my ($vmid, $node) = @_;
 434
 435     $node = $nodename if !$node;
 436     return "nodes/$node/lxc/$vmid/config";
 437 }
 438
 439 sub config_file {
 440     my ($vmid, $node) = @_;
 441
 442     my $cfspath = cfs_config_path($vmid, $node);
 443     return "/etc/pve/$cfspath";
 444 }
 445
 446 sub load_config {
 447     my ($vmid) = @_;
 448
 449     my $cfspath = cfs_config_path($vmid);
 450
 451     my $conf = PVE::Cluster::cfs_read_file($cfspath);
 452     die "container $vmid does not exists\n" if !defined($conf);
 453
 454     return $conf;
 455 }
 456
 457 sub create_config {
 458     my ($vmid, $conf) = @_;
 459
 460     my $dir = "/etc/pve/nodes/$nodename/lxc";
 461     mkdir $dir;
 462
 463     $dir .= "/$vmid";
 464     mkdir($dir) || die "unable to create container configuration directory - $!\n";
 465
 466     write_config($vmid, $conf);
 467 }
 468
 469 sub destroy_config {
 470     my ($vmid) = @_;
 471
 472     my $dir = "/etc/pve/nodes/$nodename/lxc/$vmid";
 473     File::Path::rmtree($dir);
 474 }
 475
 476 sub write_config {
 477     my ($vmid, $conf) = @_;
 478
 479     my $cfspath = cfs_config_path($vmid);
 480
 481     PVE::Cluster::cfs_write_file($cfspath, $conf);
 482 }
 483
 484 my $tempcounter = 0;
 485 sub write_temp_config {
 486     my ($vmid, $conf) = @_;
 487
 488     $tempcounter++;
 489     my $filename = "/tmp/temp-lxc-conf-$vmid-$$-$tempcounter.conf";
 490
 491     my $raw =  write_lxc_config($filename, $conf);
 492
 493     PVE::Tools::file_set_contents($filename, $raw);
 494
 495     return $filename;
 496 }
 497
 498 # flock: we use one file handle per process, so lock file
 499 # can be called multiple times and succeeds for the same process.
 500
 501 my $lock_handles =  {};
 502 my $lockdir = "/run/lock/lxc";
 503
 504 sub lock_filename {
 505     my ($vmid) = @_;
 506
 507     return "$lockdir/pve-config-{$vmid}.lock";
 508 }
 509
 510 sub lock_aquire {
 511     my ($vmid, $timeout) = @_;
 512
 513     $timeout = 10 if !$timeout;
 514     my $mode = LOCK_EX;
 515
 516     my $filename = lock_filename($vmid);
 517
 518     mkdir $lockdir if !-d $lockdir;
 519
 520     my $lock_func = sub {
 521         if (!$lock_handles->{$$}->{$filename}) {
 522             my $fh = new IO::File(">>$filename") ||
 523                 die "can't open file - $!\n";
 524             $lock_handles->{$$}->{$filename} = { fh => $fh, refcount => 0};
 525         }
 526
 527         if (!flock($lock_handles->{$$}->{$filename}->{fh}, $mode |LOCK_NB)) {
 528             print STDERR "trying to aquire lock...";
 529             my $success;
 530             while(1) {
 531                 $success = flock($lock_handles->{$$}->{$filename}->{fh}, $mode);
 532                 # try again on EINTR (see bug #273)
 533                 if ($success || ($! != EINTR)) {
 534                     last;
 535                 }
 536             }
 537             if (!$success) {
 538                 print STDERR " failed\n";
 539                 die "can't aquire lock - $!\n";
 540             }
 541
 542             $lock_handles->{$$}->{$filename}->{refcount}++;
 543
 544             print STDERR " OK\n";
 545         }
 546     };
 547
 548     eval { PVE::Tools::run_with_timeout($timeout, $lock_func); };
 549     my $err = $@;
 550     if ($err) {
 551         die "can't lock file '$filename' - $err";
 552     }
 553 }
 554
 555 sub lock_release {
 556     my ($vmid) = @_;
 557
 558     my $filename = lock_filename($vmid);
 559
 560     if (my $fh = $lock_handles->{$$}->{$filename}->{fh}) {
 561         my $refcount = --$lock_handles->{$$}->{$filename}->{refcount};
 562         if ($refcount <= 0) {
 563             $lock_handles->{$$}->{$filename} = undef;
 564             close ($fh);
 565         }
 566     }
 567 }
 568
 569 sub lock_container {
 570     my ($vmid, $timeout, $code, @param) = @_;
 571
 572     my $res;
 573
 574     lock_aquire($vmid, $timeout);
 575     eval { $res = &$code(@param) };
 576     my $err = $@;
 577     lock_release($vmid);
 578
 579     die $err if $err;
 580
 581     return $res;
 582 }
 583
 584 my $confdesc = {
 585     onboot => {
 586         optional => 1,
 587         type => 'boolean',
 588         description => "Specifies whether a VM will be started during system bootup.",
 589         default => 0,
 590     },
 591     startup => get_standard_option('pve-startup-order'),
 592     cpulimit => {
 593         optional => 1,
 594         type => 'number',
 595         description => "Limit of CPU usage. Note if the computer has 2 CPUs, it has total of '2' CPU time. Value '0' indicates no CPU limit.",
 596         minimum => 0,
 597         maximum => 128,
 598         default => 0,
 599     },
 600     cpuunits => {
 601         optional => 1,
 602         type => 'integer',
 603         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 604         minimum => 0,
 605         maximum => 500000,
 606         default => 1000,
 607     },
 608     memory => {
 609         optional => 1,
 610         type => 'integer',
 611         description => "Amount of RAM for the VM in MB.",
 612         minimum => 16,
 613         default => 512,
 614     },
 615     swap => {
 616         optional => 1,
 617         type => 'integer',
 618         description => "Amount of SWAP for the VM in MB.",
 619         minimum => 0,
 620         default => 512,
 621     },
 622     disk => {
 623         optional => 1,
 624         type => 'number',
 625         description => "Amount of disk space for the VM in GB. A zero indicates no limits.",
 626         minimum => 0,
 627         default => 4,
 628     },
 629     hostname => {
 630         optional => 1,
 631         description => "Set a host name for the container.",
 632         type => 'string',
 633         maxLength => 255,
 634     },
 635     description => {
 636         optional => 1,
 637         type => 'string',
 638         description => "Container description. Only used on the configuration web interface.",
 639     },
 640     searchdomain => {
 641         optional => 1,
 642         type => 'string',
 643         description => "Sets DNS search domains for a container. Create will automatically use the setting from the host if you neither set searchdomain or nameserver.",
 644     },
 645     nameserver => {
 646         optional => 1,
 647         type => 'string',
 648         description => "Sets DNS server IP address for a container. Create will automatically use the setting from the host if you neither set searchdomain or nameserver.",
 649     },
 650 };
 651
 652 my $MAX_LXC_NETWORKS = 10;
 653 for (my $i = 0; $i < $MAX_LXC_NETWORKS; $i++) {
 654     $confdesc->{"net$i"} = {
 655         optional => 1,
 656         type => 'string', format => 'pve-lxc-network',
 657         description => "Specifies network interfaces for the container.\n\n".
 658             "The string should have the follow format:\n\n".
 659             "-net<[0-9]> bridge=<vmbr<Nummber>>[,hwaddr=<MAC>]\n".
 660             "[,mtu=<Number>][,name=<String>][,ip=<IPv4Format/CIDR>]\n".
 661             ",ip6=<IPv6Format/CIDR>][,gw=<GatwayIPv4>]\n".
 662             ",gw6=<GatwayIPv6>][,firewall=<[1|0]>][,tag=<VlanNo>]",
 663     };
 664 }
 665
 666 sub option_exists {
 667     my ($name) = @_;
 668
 669     return defined($confdesc->{$name});
 670 }
 671
 672 # add JSON properties for create and set function
 673 sub json_config_properties {
 674     my $prop = shift;
 675
 676     foreach my $opt (keys %$confdesc) {
 677         $prop->{$opt} = $confdesc->{$opt};
 678     }
 679
 680     return $prop;
 681 }
 682
 683 # container status helpers
 684
 685 sub list_active_containers {
 686
 687     my $filename = "/proc/net/unix";
 688
 689     # similar test is used by lcxcontainers.c: list_active_containers
 690     my $res = {};
 691
 692     my $fh = IO::File->new ($filename, "r");
 693     return $res if !$fh;
 694
 695     while (defined(my $line = <$fh>)) {
 696         if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
 697             my $path = $1;
 698             if ($path =~ m!^@/etc/pve/lxc/(\d+)/command$!) {
 699                 $res->{$1} = 1;
 700             }
 701         }
 702     }
 703
 704     close($fh);
 705
 706     return $res;
 707 }
 708
 709 # warning: this is slow
 710 sub check_running {
 711     my ($vmid) = @_;
 712
 713     my $active_hash = list_active_containers();
 714
 715     return 1 if defined($active_hash->{$vmid});
 716
 717     return undef;
 718 }
 719
 720 sub get_container_disk_usage {
 721     my ($vmid) = @_;
 722
 723     my $cmd = ['lxc-attach', '-n', $vmid, '--', 'df',  '-P', '-B', '1', '/'];
 724
 725     my $res = {
 726         total => 0,
 727         used => 0,
 728         avail => 0,
 729     };
 730
 731     my $parser = sub {
 732         my $line = shift;
 733         if (my ($fsid, $total, $used, $avail) = $line =~
 734             m/^(\S+.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+\d+%\s.*$/) {
 735             $res = {
 736                 total => $total,
 737                 used => $used,
 738                 avail => $avail,
 739             };
 740         }
 741     };
 742     eval { PVE::Tools::run_command($cmd, timeout => 1, outfunc => $parser); };
 743     warn $@ if $@;
 744
 745     return $res;
 746 }
 747
 748 sub vmstatus {
 749     my ($opt_vmid) = @_;
 750
 751     my $list = $opt_vmid ? { $opt_vmid => { type => 'lxc' }} : config_list();
 752
 753     my $active_hash = list_active_containers();
 754
 755     foreach my $vmid (keys %$list) {
 756         my $d = $list->{$vmid};
 757
 758         my $running = defined($active_hash->{$vmid});
 759
 760         $d->{status} = $running ? 'running' : 'stopped';
 761
 762         my $cfspath = cfs_config_path($vmid);
 763         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
 764
 765         $d->{name} = $conf->{'lxc.utsname'} || "CT$vmid";
 766         $d->{name} =~ s/[\s]//g;
 767
 768         $d->{cpus} = 0;
 769
 770         my $cfs_period_us = $conf->{'lxc.cgroup.cpu.cfs_period_us'};
 771         my $cfs_quota_us = $conf->{'lxc.cgroup.cpu.cfs_quota_us'};
 772
 773         if ($cfs_period_us && $cfs_quota_us) {
 774             $d->{cpus} = int($cfs_quota_us/$cfs_period_us);
 775         }
 776
 777         $d->{disk} = 0;
 778         $d->{maxdisk} = defined($conf->{'pve.disksize'}) ?
 779             int($conf->{'pve.disksize'}*1024*1024)*1024 : 1024*1024*1024*1024*1024;
 780
 781         if (my $private = $conf->{'lxc.rootfs'}) {
 782             if ($private =~ m!^/!) {
 783                 my $res = PVE::Tools::df($private, 2);
 784                 $d->{disk} = $res->{used};
 785                 $d->{maxdisk} = $res->{total};
 786             } elsif ($running) {
 787                 if ($private =~ m!^(?:loop|nbd):(?:\S+)$!) {
 788                     my $res = get_container_disk_usage($vmid);
 789                     $d->{disk} = $res->{used};
 790                     $d->{maxdisk} = $res->{total};
 791                 }
 792             }
 793         }
 794
 795         $d->{mem} = 0;
 796         $d->{swap} = 0;
 797         $d->{maxmem} = ($conf->{'lxc.cgroup.memory.limit_in_bytes'}||0) +
 798             ($conf->{'lxc.cgroup.memory.memsw.limit_in_bytes'}||0);
 799
 800         $d->{uptime} = 0;
 801         $d->{cpu} = 0;
 802
 803         $d->{netout} = 0;
 804         $d->{netin} = 0;
 805
 806         $d->{diskread} = 0;
 807         $d->{diskwrite} = 0;
 808     }
 809
 810     foreach my $vmid (keys %$list) {
 811         my $d = $list->{$vmid};
 812         next if $d->{status} ne 'running';
 813
 814         $d->{uptime} = 100; # fixme:
 815
 816         $d->{mem} = read_cgroup_value('memory', $vmid, 'memory.usage_in_bytes');
 817         $d->{swap} = read_cgroup_value('memory', $vmid, 'memory.memsw.usage_in_bytes') - $d->{mem};
 818
 819         my $blkio_bytes = read_cgroup_value('blkio', $vmid, 'blkio.throttle.io_service_bytes', 1);
 820         my @bytes = split(/\n/, $blkio_bytes);
 821         foreach my $byte (@bytes) {
 822             if (my ($key, $value) = $byte =~ /(Read|Write)\s+(\d+)/) {
 823                 $d->{diskread} = $2 if $key eq 'Read';
 824                 $d->{diskwrite} = $2 if $key eq 'Write';
 825             }
 826         }
 827     }
 828
 829     return $list;
 830 }
 831
 832
 833 sub print_lxc_network {
 834     my $net = shift;
 835
 836     die "no network name defined\n" if !$net->{name};
 837
 838     my $res = "name=$net->{name}";
 839
 840     foreach my $k (qw(hwaddr mtu bridge ip gw ip6 gw6 firewall tag)) {
 841         next if !defined($net->{$k});
 842         $res .= ",$k=$net->{$k}";
 843     }
 844
 845     return $res;
 846 }
 847
 848 sub parse_lxc_network {
 849     my ($data) = @_;
 850
 851     my $res = {};
 852
 853     return $res if !$data;
 854
 855     foreach my $pv (split (/,/, $data)) {
 856         if ($pv =~ m/^(bridge|hwaddr|mtu|name|ip|ip6|gw|gw6|firewall|tag)=(\S+)$/) {
 857             $res->{$1} = $2;
 858         } else {
 859             return undef;
 860         }
 861     }
 862
 863     $res->{type} = 'veth';
 864     $res->{hwaddr} = PVE::Tools::random_ether_addr() if !$res->{hwaddr};
 865
 866     return $res;
 867 }
 868
 869 sub read_cgroup_value {
 870     my ($group, $vmid, $name, $full) = @_;
 871
 872     my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
 873
 874     return PVE::Tools::file_get_contents($path) if $full;
 875
 876     return PVE::Tools::file_read_firstline($path);
 877 }
 878
 879 sub write_cgroup_value {
 880    my ($group, $vmid, $name, $value) = @_;
 881
 882    my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
 883    PVE::ProcFSTools::write_proc_entry($path, $value) if -e $path;
 884
 885 }
 886
 887 sub find_lxc_console_pids {
 888
 889     my $res = {};
 890
 891     PVE::Tools::dir_glob_foreach('/proc', '\d+', sub {
 892         my ($pid) = @_;
 893
 894         my $cmdline = PVE::Tools::file_read_firstline("/proc/$pid/cmdline");
 895         return if !$cmdline;
 896
 897         my @args = split(/\0/, $cmdline);
 898
 899         # serach for lxc-console -n <vmid>
 900         return if scalar(@args) != 3;
 901         return if $args[1] ne '-n';
 902         return if $args[2] !~ m/^\d+$/;
 903         return if $args[0] !~ m|^(/usr/bin/)?lxc-console$|;
 904
 905         my $vmid = $args[2];
 906
 907         push @{$res->{$vmid}}, $pid;
 908     });
 909
 910     return $res;
 911 }
 912
 913 sub find_lxc_pid {
 914     my ($vmid) = @_;
 915
 916     my $pid = undef;
 917     my $parser = sub {
 918         my $line = shift;
 919         $pid = $1 if $line =~ m/^PID:\s+(\d+)$/;
 920     };
 921     PVE::Tools::run_command(['lxc-info', '-n', $vmid], outfunc => $parser);
 922
 923     die "unable to get PID for CT $vmid (not running?)\n" if !$pid;
 924
 925     return $pid;
 926 }
 927
 928 my $ipv4_reverse_mask = [
 929     '0.0.0.0',
 930     '128.0.0.0',
 931     '192.0.0.0',
 932     '224.0.0.0',
 933     '240.0.0.0',
 934     '248.0.0.0',
 935     '252.0.0.0',
 936     '254.0.0.0',
 937     '255.0.0.0',
 938     '255.128.0.0',
 939     '255.192.0.0',
 940     '255.224.0.0',
 941     '255.240.0.0',
 942     '255.248.0.0',
 943     '255.252.0.0',
 944     '255.254.0.0',
 945     '255.255.0.0',
 946     '255.255.128.0',
 947     '255.255.192.0',
 948     '255.255.224.0',
 949     '255.255.240.0',
 950     '255.255.248.0',
 951     '255.255.252.0',
 952     '255.255.254.0',
 953     '255.255.255.0',
 954     '255.255.255.128',
 955     '255.255.255.192',
 956     '255.255.255.224',
 957     '255.255.255.240',
 958     '255.255.255.248',
 959     '255.255.255.252',
 960     '255.255.255.254',
 961     '255.255.255.255',
 962 ];
 963
 964 # Note: we cannot use Net:IP, because that only allows strict
 965 # CIDR networks
 966 sub parse_ipv4_cidr {
 967     my ($cidr, $noerr) = @_;
 968
 969     if ($cidr =~ m!^($IPV4RE)(?:/(\d+))$! && ($2 > 7) &&  ($2 < 32)) {
 970         return { address => $1, netmask => $ipv4_reverse_mask->[$2] };
 971     }
 972
 973     return undef if $noerr;
 974
 975     die "unable to parse ipv4 address/mask\n";
 976 }
 977
 978 sub check_lock {
 979     my ($conf) = @_;
 980
 981     die "VM is locked ($conf->{'pve.lock'})\n" if $conf->{'pve.lock'};
 982 }
 983
 984 sub lxc_conf_to_pve {
 985     my ($vmid, $lxc_conf) = @_;
 986
 987     my $properties = json_config_properties();
 988
 989     my $conf = { digest => $lxc_conf->{digest} };
 990
 991     foreach my $k (keys %$properties) {
 992
 993         if ($k eq 'description') {
 994             if (my $raw = $lxc_conf->{'pve.comment'}) {
 995                 $conf->{$k} = PVE::Tools::decode_text($raw);
 996             }
 997         } elsif ($k eq 'onboot') {
 998             $conf->{$k} = $lxc_conf->{'pve.onboot'} if  $lxc_conf->{'pve.onboot'};
 999         } elsif ($k eq 'startup') {
1000             $conf->{$k} = $lxc_conf->{'pve.startup'} if  $lxc_conf->{'pve.startup'};
1001         } elsif ($k eq 'hostname') {
1002             $conf->{$k} = $lxc_conf->{'lxc.utsname'} if $lxc_conf->{'lxc.utsname'};
1003         } elsif ($k eq 'nameserver') {
1004             $conf->{$k} = $lxc_conf->{'pve.nameserver'} if $lxc_conf->{'pve.nameserver'};
1005         } elsif ($k eq 'searchdomain') {
1006             $conf->{$k} = $lxc_conf->{'pve.searchdomain'} if $lxc_conf->{'pve.searchdomain'};
1007         } elsif ($k eq 'memory') {
1008             if (my $value = $lxc_conf->{'lxc.cgroup.memory.limit_in_bytes'}) {
1009                 $conf->{$k} = int($value / (1024*1024));
1010             }
1011         } elsif ($k eq 'swap') {
1012             if (my $value = $lxc_conf->{'lxc.cgroup.memory.memsw.limit_in_bytes'}) {
1013                 my $mem = $lxc_conf->{'lxc.cgroup.memory.limit_in_bytes'} || 0;
1014                 $conf->{$k} = int(($value -$mem) / (1024*1024));
1015             }
1016         } elsif ($k eq 'cpulimit') {
1017             my $cfs_period_us = $lxc_conf->{'lxc.cgroup.cpu.cfs_period_us'};
1018             my $cfs_quota_us = $lxc_conf->{'lxc.cgroup.cpu.cfs_quota_us'};
1019
1020             if ($cfs_period_us && $cfs_quota_us) {
1021                 $conf->{$k} = $cfs_quota_us/$cfs_period_us;
1022             } else {
1023                 $conf->{$k} = 0;
1024             }
1025         } elsif ($k eq 'cpuunits') {
1026             $conf->{$k} = $lxc_conf->{'lxc.cgroup.cpu.shares'} || 1024;
1027         } elsif ($k eq 'disk') {
1028             $conf->{$k} = defined($lxc_conf->{'pve.disksize'}) ?
1029                 $lxc_conf->{'pve.disksize'} : 0;
1030         } elsif ($k =~ m/^net\d$/) {
1031             my $net = $lxc_conf->{$k};
1032             next if !$net;
1033             $conf->{$k} = print_lxc_network($net);
1034         }
1035     }
1036
1037     if (my $parent = $lxc_conf->{'pve.parent'}) {
1038             $conf->{parent} = $lxc_conf->{'pve.parent'};
1039     }
1040
1041     if (my $parent = $lxc_conf->{'pve.snapcomment'}) {
1042         $conf->{description} = $lxc_conf->{'pve.snapcomment'};
1043     }
1044
1045     if (my $parent = $lxc_conf->{'pve.snaptime'}) {
1046         $conf->{snaptime} = $lxc_conf->{'pve.snaptime'};
1047     }
1048
1049     return $conf;
1050 }
1051
1052 # verify and cleanup nameserver list (replace \0 with ' ')
1053 sub verify_nameserver_list {
1054     my ($nameserver_list) = @_;
1055
1056     my @list = ();
1057     foreach my $server (PVE::Tools::split_list($nameserver_list)) {
1058         PVE::JSONSchema::pve_verify_ip($server);
1059         push @list, $server;
1060     }
1061
1062     return join(' ', @list);
1063 }
1064
1065 sub verify_searchdomain_list {
1066     my ($searchdomain_list) = @_;
1067
1068     my @list = ();
1069     foreach my $server (PVE::Tools::split_list($searchdomain_list)) {
1070         # todo: should we add checks for valid dns domains?
1071         push @list, $server;
1072     }
1073
1074     return join(' ', @list);
1075 }
1076
1077 sub update_lxc_config {
1078     my ($vmid, $conf, $running, $param, $delete) = @_;
1079
1080     my @nohotplug;
1081
1082     my $rootdir;
1083     if ($running) {
1084         my $pid = find_lxc_pid($vmid);
1085         $rootdir = "/proc/$pid/root";
1086     }
1087
1088     if (defined($delete)) {
1089         foreach my $opt (@$delete) {
1090             if ($opt eq 'hostname' || $opt eq 'memory') {
1091                 die "unable to delete required option '$opt'\n";
1092             } elsif ($opt eq 'swap') {
1093                 delete $conf->{'lxc.cgroup.memory.memsw.limit_in_bytes'};
1094                 write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", -1);
1095             } elsif ($opt eq 'description') {
1096                 delete $conf->{'pve.comment'};
1097             } elsif ($opt eq 'onboot') {
1098                 delete $conf->{'pve.onboot'};
1099             } elsif ($opt eq 'startup') {
1100                 delete $conf->{'pve.startup'};
1101             } elsif ($opt eq 'nameserver') {
1102                 delete $conf->{'pve.nameserver'};
1103                 push @nohotplug, $opt;
1104                 next if $running;
1105             } elsif ($opt eq 'searchdomain') {
1106                 delete $conf->{'pve.searchdomain'};
1107                 push @nohotplug, $opt;
1108                 next if $running;
1109             } elsif ($opt =~ m/^net(\d)$/) {
1110                 delete $conf->{$opt};
1111                 next if !$running;
1112                 my $netid = $1;
1113                 PVE::Network::veth_delete("veth${vmid}.$netid");
1114             } else {
1115                 die "implement me"
1116             }
1117             PVE::LXC::write_config($vmid, $conf) if $running;
1118         }
1119     }
1120
1121     foreach my $opt (keys %$param) {
1122         my $value = $param->{$opt};
1123         if ($opt eq 'hostname') {
1124             $conf->{'lxc.utsname'} = $value;
1125         } elsif ($opt eq 'onboot') {
1126             $conf->{'pve.onboot'} = $value ? 1 : 0;
1127         } elsif ($opt eq 'startup') {
1128             $conf->{'pve.startup'} = $value;
1129         } elsif ($opt eq 'nameserver') {
1130             my $list = verify_nameserver_list($value);
1131             $conf->{'pve.nameserver'} = $list;
1132             push @nohotplug, $opt;
1133             next if $running;
1134         } elsif ($opt eq 'searchdomain') {
1135             my $list = verify_searchdomain_list($value);
1136             $conf->{'pve.searchdomain'} = $list;
1137             push @nohotplug, $opt;
1138             next if $running;
1139         } elsif ($opt eq 'memory') {
1140             $conf->{'lxc.cgroup.memory.limit_in_bytes'} = $value*1024*1024;
1141             write_cgroup_value("memory", $vmid, "memory.limit_in_bytes", $value*1024*1024);
1142         } elsif ($opt eq 'swap') {
1143             my $mem =  $conf->{'lxc.cgroup.memory.limit_in_bytes'};
1144             $mem = $param->{memory}*1024*1024 if $param->{memory};
1145             $conf->{'lxc.cgroup.memory.memsw.limit_in_bytes'} = $mem + $value*1024*1024;
1146             write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", $mem + $value*1024*1024);
1147
1148         } elsif ($opt eq 'cpulimit') {
1149             if ($value > 0) {
1150                 my $cfs_period_us = 100000;
1151                 $conf->{'lxc.cgroup.cpu.cfs_period_us'} = $cfs_period_us;
1152                 $conf->{'lxc.cgroup.cpu.cfs_quota_us'} = $cfs_period_us*$value;
1153                 write_cgroup_value("cpu", $vmid, "cpu.cfs_quota_us", $cfs_period_us*$value);
1154             } else {
1155                 delete $conf->{'lxc.cgroup.cpu.cfs_period_us'};
1156                 delete $conf->{'lxc.cgroup.cpu.cfs_quota_us'};
1157                 write_cgroup_value("cpu", $vmid, "cpu.cfs_quota_us", -1);
1158             }
1159         } elsif ($opt eq 'cpuunits') {
1160             $conf->{'lxc.cgroup.cpu.shares'} = $value;
1161             write_cgroup_value("cpu", $vmid, "cpu.shares", $value);
1162         } elsif ($opt eq 'description') {
1163             $conf->{'pve.comment'} = PVE::Tools::encode_text($value);
1164         } elsif ($opt eq 'disk') {
1165             $conf->{'pve.disksize'} = $value;
1166             push @nohotplug, $opt;
1167             next if $running;
1168         } elsif ($opt =~ m/^net(\d+)$/) {
1169             my $netid = $1;
1170             my $net = PVE::LXC::parse_lxc_network($value);
1171             $net->{'veth.pair'} = "veth${vmid}.$netid";
1172             if (!$running) {
1173                 $conf->{$opt} = $net;
1174             } else {
1175                 update_net($vmid, $conf, $opt, $net, $netid, $rootdir);
1176             }
1177         } else {
1178             die "implement me: $opt";
1179         }
1180         PVE::LXC::write_config($vmid, $conf) if $running;
1181     }
1182
1183     if ($running && scalar(@nohotplug)) {
1184         die "unable to modify " . join(',', @nohotplug) . " while container is running\n";
1185     }
1186 }
1187
1188 sub get_primary_ips {
1189     my ($conf) = @_;
1190
1191     # return data from net0
1192
1193     my $net = $conf->{net0};
1194     return undef if !$net;
1195
1196     my $ipv4 = $net->{ip};
1197     if ($ipv4) {
1198         if ($ipv4 =~ /^(dhcp|manual)$/) {
1199             $ipv4 = undef
1200         } else {
1201             $ipv4 =~ s!/\d+$!!;
1202         }
1203     }
1204     my $ipv6 = $net->{ip6};
1205     if ($ipv6) {
1206         if ($ipv6 =~ /^(dhcp|manual)$/) {
1207             $ipv6 = undef;
1208         } else {
1209             $ipv6 =~ s!/\d+$!!;
1210         }
1211     }
1212
1213     return ($ipv4, $ipv6);
1214 }
1215
1216 sub destory_lxc_container {
1217     my ($storage_cfg, $vmid, $conf) = @_;
1218
1219     if (my $volid = $conf->{'pve.volid'}) {
1220
1221         my ($vtype, $name, $owner) = PVE::Storage::parse_volname($storage_cfg, $volid);
1222         die "got strange volid (containe is not owner!)\n" if $vmid != $owner;
1223
1224         PVE::Storage::vdisk_free($storage_cfg, $volid);
1225
1226         destroy_config($vmid);
1227
1228     } else {
1229         my $cmd = ['lxc-destroy', '-n', $vmid ];
1230
1231         PVE::Tools::run_command($cmd);
1232     }
1233 }
1234
1235 my $safe_num_ne = sub {
1236     my ($a, $b) = @_;
1237
1238     return 0 if !defined($a) && !defined($b);
1239     return 1 if !defined($a);
1240     return 1 if !defined($b);
1241
1242     return $a != $b;
1243 };
1244
1245 my $safe_string_ne = sub {
1246     my ($a, $b) = @_;
1247
1248     return 0 if !defined($a) && !defined($b);
1249     return 1 if !defined($a);
1250     return 1 if !defined($b);
1251
1252     return $a ne $b;
1253 };
1254
1255 sub update_net {
1256     my ($vmid, $conf, $opt, $newnet, $netid, $rootdir) = @_;
1257
1258     my $veth = $newnet->{'veth.pair'};
1259     my $vethpeer = $veth . "p";
1260     my $eth = $newnet->{name};
1261
1262     if ($conf->{$opt}) {
1263         if (&$safe_string_ne($conf->{$opt}->{hwaddr}, $newnet->{hwaddr}) ||
1264             &$safe_string_ne($conf->{$opt}->{name}, $newnet->{name})) {
1265
1266             PVE::Network::veth_delete($veth);
1267             delete $conf->{$opt};
1268             PVE::LXC::write_config($vmid, $conf);
1269
1270             hotplug_net($vmid, $conf, $opt, $newnet);
1271
1272         } elsif (&$safe_string_ne($conf->{$opt}->{bridge}, $newnet->{bridge}) ||
1273                 &$safe_num_ne($conf->{$opt}->{tag}, $newnet->{tag}) ||
1274                 &$safe_num_ne($conf->{$opt}->{firewall}, $newnet->{firewall})) {
1275
1276                 if ($conf->{$opt}->{bridge}){
1277                     PVE::Network::tap_unplug($veth);
1278                     delete $conf->{$opt}->{bridge};
1279                     delete $conf->{$opt}->{tag};
1280                     delete $conf->{$opt}->{firewall};
1281                     PVE::LXC::write_config($vmid, $conf);
1282                 }
1283
1284                 PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1285                 $conf->{$opt}->{bridge} = $newnet->{bridge} if $newnet->{bridge};
1286                 $conf->{$opt}->{tag} = $newnet->{tag} if $newnet->{tag};
1287                 $conf->{$opt}->{firewall} = $newnet->{firewall} if $newnet->{firewall};
1288                 PVE::LXC::write_config($vmid, $conf);
1289         }
1290     } else {
1291         hotplug_net($vmid, $conf, $opt, $newnet);
1292     }
1293
1294     update_ipconfig($vmid, $conf, $opt, $eth, $newnet, $rootdir);
1295 }
1296
1297 sub hotplug_net {
1298     my ($vmid, $conf, $opt, $newnet) = @_;
1299
1300     my $veth = $newnet->{'veth.pair'};
1301     my $vethpeer = $veth . "p";
1302     my $eth = $newnet->{name};
1303
1304     PVE::Network::veth_create($veth, $vethpeer, $newnet->{bridge}, $newnet->{hwaddr});
1305     PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1306
1307     # attach peer in container
1308     my $cmd = ['lxc-device', '-n', $vmid, 'add', $vethpeer, "$eth" ];
1309     PVE::Tools::run_command($cmd);
1310
1311     # link up peer in container
1312     $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', 'link', 'set', $eth ,'up'  ];
1313     PVE::Tools::run_command($cmd);
1314
1315     $conf->{$opt}->{type} = 'veth';
1316     $conf->{$opt}->{bridge} = $newnet->{bridge} if $newnet->{bridge};
1317     $conf->{$opt}->{tag} = $newnet->{tag} if $newnet->{tag};
1318     $conf->{$opt}->{firewall} = $newnet->{firewall} if $newnet->{firewall};
1319     $conf->{$opt}->{hwaddr} = $newnet->{hwaddr} if $newnet->{hwaddr};
1320     $conf->{$opt}->{name} = $newnet->{name} if $newnet->{name};
1321     $conf->{$opt}->{'veth.pair'} = $newnet->{'veth.pair'} if $newnet->{'veth.pair'};
1322
1323     delete $conf->{$opt}->{ip} if $conf->{$opt}->{ip};
1324     delete $conf->{$opt}->{ip6} if $conf->{$opt}->{ip6};
1325     delete $conf->{$opt}->{gw} if $conf->{$opt}->{gw};
1326     delete $conf->{$opt}->{gw6} if $conf->{$opt}->{gw6};
1327
1328     PVE::LXC::write_config($vmid, $conf);
1329 }
1330
1331 sub update_ipconfig {
1332     my ($vmid, $conf, $opt, $eth, $newnet, $rootdir) = @_;
1333
1334     my $lxc_setup = PVE::LXCSetup->new($conf, $rootdir);
1335
1336     my $optdata = $conf->{$opt};
1337     my $deleted = [];
1338     my $added = [];
1339     my $netcmd = sub {
1340         my $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', @_];
1341         PVE::Tools::run_command($cmd);
1342     };
1343
1344     my $change_ip_config = sub {
1345         my ($ipversion) = @_;
1346
1347         my $family_opt = "-$ipversion";
1348         my $suffix = $ipversion == 4 ? '' : $ipversion;
1349         my $gw= "gw$suffix";
1350         my $ip= "ip$suffix";
1351
1352         my $change_ip = &$safe_string_ne($optdata->{$ip}, $newnet->{$ip});
1353         my $change_gw = &$safe_string_ne($optdata->{$gw}, $newnet->{$gw});
1354
1355         return if !$change_ip && !$change_gw;
1356
1357         # step 1: add new IP, if this fails we cancel
1358         if ($change_ip && $newnet->{$ip}) {
1359             eval { &$netcmd($family_opt, 'addr', 'add', $newnet->{$ip}, 'dev', $eth); };
1360             if (my $err = $@) {
1361                 warn $err;
1362                 return;
1363             }
1364         }
1365
1366         # step 2: replace gateway
1367         #   If this fails we delete the added IP and cancel.
1368         #   If it succeeds we save the config and delete the old IP, ignoring
1369         #   errors. The config is then saved.
1370         # Note: 'ip route replace' can add
1371         if ($change_gw) {
1372             if ($newnet->{$gw}) {
1373                 eval { &$netcmd($family_opt, 'route', 'replace', 'default', 'via', $newnet->{$gw}); };
1374                 if (my $err = $@) {
1375                     warn $err;
1376                     # the route was not replaced, the old IP is still available
1377                     # rollback (delete new IP) and cancel
1378                     if ($change_ip) {
1379                         eval { &$netcmd($family_opt, 'addr', 'del', $newnet->{$ip}, 'dev', $eth); };
1380                         warn $@ if $@; # no need to die here
1381                     }
1382                     return;
1383                 }
1384             } else {
1385                 eval { &$netcmd($family_opt, 'route', 'del', 'default'); };
1386                 # if the route was not deleted, the guest might have deleted it manually
1387                 # warn and continue
1388                 warn $@ if $@;
1389             }
1390         }
1391
1392         # from this point on we safe the configuration
1393         # step 3: delete old IP ignoring errors
1394         if ($change_ip && $optdata->{$ip}) {
1395             eval { &$netcmd($family_opt, 'addr', 'del', $optdata->{$ip}, 'dev', $eth); };
1396             warn $@ if $@; # no need to die here
1397         }
1398
1399         foreach my $property ($ip, $gw) {
1400             if ($newnet->{$property}) {
1401                 $optdata->{$property} = $newnet->{$property};
1402             } else {
1403                 delete $optdata->{$property};
1404             }
1405         }
1406         PVE::LXC::write_config($vmid, $conf);
1407         $lxc_setup->setup_network($conf);
1408     };
1409
1410     &$change_ip_config(4);
1411     &$change_ip_config(6);
1412
1413 }
1414
1415 # Internal snapshots
1416
1417 # NOTE: Snapshot create/delete involves several non-atomic
1418 # action, and can take a long time.
1419 # So we try to avoid locking the file and use 'lock' variable
1420 # inside the config file instead.
1421
1422 my $snapshot_copy_config = sub {
1423     my ($source, $dest) = @_;
1424
1425     foreach my $k (keys %$source) {
1426         next if $k eq 'snapshots';
1427         next if $k eq 'pve.snapstate';
1428         next if $k eq 'pve.snaptime';
1429         next if $k eq 'pve.lock';
1430         next if $k eq 'digest';
1431         next if $k eq 'pve.comment';
1432
1433         $dest->{$k} = $source->{$k};
1434     }
1435 };
1436
1437 my $snapshot_prepare = sub {
1438     my ($vmid, $snapname, $comment) = @_;
1439
1440     my $snap;
1441
1442     my $updatefn =  sub {
1443
1444         my $conf = load_config($vmid);
1445
1446         check_lock($conf);
1447
1448         $conf->{'pve.lock'} = 'snapshot';
1449
1450         die "snapshot name '$snapname' already used\n"
1451             if defined($conf->{snapshots}->{$snapname});
1452
1453         my $storecfg = PVE::Storage::config();
1454         die "snapshot feature is not available\n" if !has_feature('snapshot', $conf, $storecfg);
1455
1456         $snap = $conf->{snapshots}->{$snapname} = {};
1457
1458         &$snapshot_copy_config($conf, $snap);
1459
1460         $snap->{'pve.snapstate'} = "prepare";
1461         $snap->{'pve.snaptime'} = time();
1462         $snap->{'pve.snapname'} = $snapname;
1463         $snap->{'pve.snapcomment'} = $comment if $comment;
1464         $conf->{snapshots}->{$snapname} = $snap;
1465
1466         PVE::LXC::write_config($vmid, $conf);
1467     };
1468
1469     lock_container($vmid, 10, $updatefn);
1470
1471     return $snap;
1472 };
1473
1474 my $snapshot_commit = sub {
1475     my ($vmid, $snapname) = @_;
1476
1477     my $updatefn = sub {
1478
1479         my $conf = load_config($vmid);
1480
1481         die "missing snapshot lock\n"
1482             if !($conf->{'pve.lock'} && $conf->{'pve.lock'} eq 'snapshot');
1483
1484         die "snapshot '$snapname' does not exist\n"
1485             if !defined($conf->{snapshots}->{$snapname});
1486
1487         die "wrong snapshot state\n"
1488             if !($conf->{snapshots}->{$snapname}->{'pve.snapstate'} && $conf->{snapshots}->{$snapname}->{'pve.snapstate'} eq "prepare");
1489
1490         delete $conf->{snapshots}->{$snapname}->{'pve.snapstate'};
1491         delete $conf->{'pve.lock'};
1492         $conf->{'pve.parent'} = $snapname;
1493
1494         PVE::LXC::write_config($vmid, $conf);
1495
1496     };
1497
1498     lock_container($vmid, 10 ,$updatefn);
1499 };
1500
1501 sub has_feature {
1502     my ($feature, $conf, $storecfg, $snapname) = @_;
1503     #Fixme add other drives if necessary.
1504     my $err;
1505     my $volid = $conf->{'pve.volid'};
1506     $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname);
1507
1508     return $err ? 0 : 1;
1509 }
1510
1511 sub snapshot_create {
1512     my ($vmid, $snapname, $comment) = @_;
1513
1514     my $snap = &$snapshot_prepare($vmid, $snapname, $comment);
1515
1516     my $config = load_config($vmid);
1517
1518     my $cmd = "/usr/bin/lxc-freeze -n $vmid";
1519     my $running = check_running($vmid);
1520     eval {
1521         if ($running) {
1522             PVE::Tools::run_command($cmd);
1523         };
1524
1525         my $storecfg = PVE::Storage::config();
1526         my $volid = $config->{'pve.volid'};
1527
1528         $cmd = "/usr/bin/lxc-unfreeze -n $vmid";
1529         if ($running) {
1530             PVE::Tools::run_command($cmd);
1531         };
1532
1533         PVE::Storage::volume_snapshot($storecfg, $volid, $snapname);
1534         &$snapshot_commit($vmid, $snapname);
1535     };
1536     if(my $err = $@) {
1537         snapshot_delete($vmid, $snapname, 1);
1538         die "$err\n";
1539     }
1540 }
1541
1542 sub snapshot_delete {
1543     my ($vmid, $snapname, $force) = @_;
1544
1545     my $snap;
1546
1547     my $conf;
1548
1549     my $updatefn =  sub {
1550
1551         $conf = load_config($vmid);
1552
1553         $snap = $conf->{snapshots}->{$snapname};
1554
1555         check_lock($conf);
1556
1557         die "snapshot '$snapname' does not exist\n" if !defined($snap);
1558
1559         $snap->{'pve.snapstate'} = 'delete';
1560
1561         PVE::LXC::write_config($vmid, $conf);
1562     };
1563
1564     lock_container($vmid, 10, $updatefn);
1565
1566     my $storecfg = PVE::Storage::config();
1567
1568     my $del_snap =  sub {
1569
1570         check_lock($conf);
1571
1572         if ($conf->{'pve.parent'} eq $snapname) {
1573             if ($conf->{snapshots}->{$snapname}->{'pve.snapname'}) {
1574                 $conf->{'pve.parent'} = $conf->{snapshots}->{$snapname}->{'pve.parent'};
1575             } else {
1576                 delete $conf->{'pve.parent'};
1577             }
1578         }
1579
1580         delete $conf->{snapshots}->{$snapname};
1581
1582         PVE::LXC::write_config($vmid, $conf);
1583     };
1584
1585     my $volid = $conf->{snapshots}->{$snapname}->{'pve.volid'};
1586
1587     eval {
1588         PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snapname);
1589     };
1590     my $err = $@;
1591
1592     if(!$err || ($err && $force)) {
1593         lock_container($vmid, 10, $del_snap);
1594         if ($err) {
1595             die "Can't delete snapshot: $vmid $snapname $err\n";
1596         }
1597     }
1598 }
1599
1600 sub snapshot_rollback {
1601     my ($vmid, $snapname) = @_;
1602
1603     my $storecfg = PVE::Storage::config();
1604
1605     my $conf = load_config($vmid);
1606
1607     my $snap = $conf->{snapshots}->{$snapname};
1608
1609     die "snapshot '$snapname' does not exist\n" if !defined($snap);
1610
1611     PVE::Storage::volume_rollback_is_possible($storecfg, $snap->{'pve.volid'},
1612                                               $snapname);
1613
1614     my $updatefn = sub {
1615
1616         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n" if $snap->{snapstate};
1617
1618         check_lock($conf);
1619
1620         system("lxc-stop -n $vmid --kill") if check_running($vmid);
1621
1622         die "unable to rollback vm $vmid: vm is running\n"
1623             if check_running($vmid);
1624
1625         $conf->{'pve.lock'} = 'rollback';
1626
1627         my $forcemachine;
1628
1629         # copy snapshot config to current config
1630
1631         my $tmp_conf = $conf;
1632         &$snapshot_copy_config($tmp_conf->{snapshots}->{$snapname}, $conf);
1633         $conf->{snapshots} = $tmp_conf->{snapshots};
1634         delete $conf->{'pve.snaptime'};
1635         delete $conf->{'pve.snapname'};
1636         $conf->{'pve.parent'} = $snapname;
1637
1638         PVE::LXC::write_config($vmid, $conf);
1639     };
1640
1641     my $unlockfn = sub {
1642         delete $conf->{'pve.lock'};
1643         PVE::LXC::write_config($vmid, $conf);
1644     };
1645
1646     lock_container($vmid, 10, $updatefn);
1647
1648     PVE::Storage::volume_snapshot_rollback($storecfg, $conf->{'pve.volid'}, $snapname);
1649
1650     lock_container($vmid, 5, $unlockfn);
1651 }
1652
1653 1;