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