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