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