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     }
 946
 947     my $netcount = 0;
 948     foreach my $k (keys %$conf) {
 949         next if $k !~ m/^net(\d+)$/;
 950         my $ind = $1;
 951         my $d = parse_lxc_network($conf->{$k});
 952         $netcount++;
 953         $raw .= "lxc.network.type = veth\n";
 954         $raw .= "lxc.network.veth.pair = veth${vmid}i${ind}\n";
 955         $raw .= "lxc.network.hwaddr = $d->{hwaddr}\n" if defined($d->{hwaddr});
 956         $raw .= "lxc.network.name = $d->{name}\n" if defined($d->{name});
 957         $raw .= "lxc.network.mtu = $d->{mtu}\n" if defined($d->{mtu});
 958     }
 959
 960     if (my $lxcconf = $conf->{lxc}) {
 961         foreach my $entry (@$lxcconf) {
 962             my ($k, $v) = @$entry;
 963             $netcount++ if $k eq 'lxc.network.type';
 964             $raw .= "$k = $v\n";
 965         }
 966     }
 967
 968     $raw .= "lxc.network.type = empty\n" if !$netcount;
 969
 970     my $dir = "/var/lib/lxc/$vmid";
 971     File::Path::mkpath("$dir/rootfs");
 972
 973     PVE::Tools::file_set_contents("$dir/config", $raw);
 974 }
 975
 976 # verify and cleanup nameserver list (replace \0 with ' ')
 977 sub verify_nameserver_list {
 978     my ($nameserver_list) = @_;
 979
 980     my @list = ();
 981     foreach my $server (PVE::Tools::split_list($nameserver_list)) {
 982         PVE::JSONSchema::pve_verify_ip($server);
 983         push @list, $server;
 984     }
 985
 986     return join(' ', @list);
 987 }
 988
 989 sub verify_searchdomain_list {
 990     my ($searchdomain_list) = @_;
 991
 992     my @list = ();
 993     foreach my $server (PVE::Tools::split_list($searchdomain_list)) {
 994         # todo: should we add checks for valid dns domains?
 995         push @list, $server;
 996     }
 997
 998     return join(' ', @list);
 999 }
1000
1001 sub update_pct_config {
1002     my ($vmid, $conf, $running, $param, $delete) = @_;
1003
1004     my @nohotplug;
1005
1006     my $rootdir;
1007     if ($running) {
1008         my $pid = find_lxc_pid($vmid);
1009         $rootdir = "/proc/$pid/root";
1010     }
1011
1012     if (defined($delete)) {
1013         foreach my $opt (@$delete) {
1014             if ($opt eq 'hostname' || $opt eq 'memory' || $opt eq 'rootfs') {
1015                 die "unable to delete required option '$opt'\n";
1016             } elsif ($opt eq 'swap') {
1017                 delete $conf->{$opt};
1018                 write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", -1);
1019             } elsif ($opt eq 'description' || $opt eq 'onboot' || $opt eq 'startup') {
1020                 delete $conf->{$opt};
1021             } elsif ($opt eq 'nameserver' || $opt eq 'searchdomain') {
1022                 delete $conf->{$opt};
1023                 push @nohotplug, $opt;
1024                 next if $running;
1025             } elsif ($opt =~ m/^net(\d)$/) {
1026                 delete $conf->{$opt};
1027                 next if !$running;
1028                 my $netid = $1;
1029                 PVE::Network::veth_delete("veth${vmid}i$netid");
1030             } else {
1031                 die "implement me"
1032             }
1033             PVE::LXC::write_config($vmid, $conf) if $running;
1034         }
1035     }
1036
1037     # There's no separate swap size to configure, there's memory and "total"
1038     # memory (iow. memory+swap). This means we have to change them together.
1039     my $wanted_memory = PVE::Tools::extract_param($param, 'memory');
1040     my $wanted_swap =  PVE::Tools::extract_param($param, 'swap');
1041     if (defined($wanted_memory) || defined($wanted_swap)) {
1042
1043         $wanted_memory //= ($conf->{memory} || 512);
1044         $wanted_swap //=  ($conf->{swap} || 0);
1045
1046         my $total = $wanted_memory + $wanted_swap;
1047         if ($running) {
1048             write_cgroup_value("memory", $vmid, "memory.limit_in_bytes", int($wanted_memory*1024*1024));
1049             write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", int($total*1024*1024));
1050         }
1051         $conf->{memory} = $wanted_memory;
1052         $conf->{swap} = $wanted_swap;
1053
1054         PVE::LXC::write_config($vmid, $conf) if $running;
1055     }
1056
1057     foreach my $opt (keys %$param) {
1058         my $value = $param->{$opt};
1059         if ($opt eq 'hostname') {
1060             $conf->{$opt} = $value;
1061         } elsif ($opt eq 'onboot') {
1062             $conf->{$opt} = $value ? 1 : 0;
1063         } elsif ($opt eq 'startup') {
1064             $conf->{$opt} = $value;
1065         } elsif ($opt eq 'tty') {
1066             $conf->{$opt} = $value;
1067             push @nohotplug, $opt;
1068             next if $running;
1069         } elsif ($opt eq 'nameserver') {
1070             my $list = verify_nameserver_list($value);
1071             $conf->{$opt} = $list;
1072             push @nohotplug, $opt;
1073             next if $running;
1074         } elsif ($opt eq 'searchdomain') {
1075             my $list = verify_searchdomain_list($value);
1076             $conf->{$opt} = $list;
1077             push @nohotplug, $opt;
1078             next if $running;
1079         } elsif ($opt eq 'cpulimit') {
1080             $conf->{$opt} = $value;
1081             push @nohotplug, $opt; # fixme: hotplug
1082             next;
1083         } elsif ($opt eq 'cpuunits') {
1084             $conf->{$opt} = $value;
1085             write_cgroup_value("cpu", $vmid, "cpu.shares", $value);
1086         } elsif ($opt eq 'description') {
1087             $conf->{$opt} = PVE::Tools::encode_text($value);
1088         } elsif ($opt =~ m/^net(\d+)$/) {
1089             my $netid = $1;
1090             my $net = parse_lxc_network($value);
1091             if (!$running) {
1092                 $conf->{$opt} = print_lxc_network($net);
1093             } else {
1094                 update_net($vmid, $conf, $opt, $net, $netid, $rootdir);
1095             }
1096         } else {
1097             die "implement me: $opt";
1098         }
1099         PVE::LXC::write_config($vmid, $conf) if $running;
1100     }
1101
1102     if ($running && scalar(@nohotplug)) {
1103         die "unable to modify " . join(',', @nohotplug) . " while container is running\n";
1104     }
1105 }
1106
1107 sub get_primary_ips {
1108     my ($conf) = @_;
1109
1110     # return data from net0
1111
1112     return undef if !defined($conf->{net0});
1113     my $net = parse_lxc_network($conf->{net0});
1114
1115     my $ipv4 = $net->{ip};
1116     if ($ipv4) {
1117         if ($ipv4 =~ /^(dhcp|manual)$/) {
1118             $ipv4 = undef
1119         } else {
1120             $ipv4 =~ s!/\d+$!!;
1121         }
1122     }
1123     my $ipv6 = $net->{ip6};
1124     if ($ipv6) {
1125         if ($ipv6 =~ /^(dhcp|manual)$/) {
1126             $ipv6 = undef;
1127         } else {
1128             $ipv6 =~ s!/\d+$!!;
1129         }
1130     }
1131
1132     return ($ipv4, $ipv6);
1133 }
1134
1135 sub destroy_lxc_container {
1136     my ($storage_cfg, $vmid, $conf) = @_;
1137
1138     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1139     if (defined($rootinfo->{volume})) {
1140         my ($vtype, $name, $owner) = PVE::Storage::parse_volname($storage_cfg, $rootinfo->{volume});
1141         PVE::Storage::vdisk_free($storage_cfg, $rootinfo->{volume}) if $vmid == $owner;;
1142     }
1143     rmdir "/var/lib/lxc/$vmid/rootfs";
1144     unlink "/var/lib/lxc/$vmid/config";
1145     rmdir "/var/lib/lxc/$vmid";
1146     destroy_config($vmid);
1147
1148     #my $cmd = ['lxc-destroy', '-n', $vmid ];
1149     #PVE::Tools::run_command($cmd);
1150 }
1151
1152 my $safe_num_ne = sub {
1153     my ($a, $b) = @_;
1154
1155     return 0 if !defined($a) && !defined($b);
1156     return 1 if !defined($a);
1157     return 1 if !defined($b);
1158
1159     return $a != $b;
1160 };
1161
1162 my $safe_string_ne = sub {
1163     my ($a, $b) = @_;
1164
1165     return 0 if !defined($a) && !defined($b);
1166     return 1 if !defined($a);
1167     return 1 if !defined($b);
1168
1169     return $a ne $b;
1170 };
1171
1172 sub update_net {
1173     my ($vmid, $conf, $opt, $newnet, $netid, $rootdir) = @_;
1174
1175     if ($newnet->{type} ne 'veth') {
1176         # for when there are physical interfaces
1177         die "cannot update interface of type $newnet->{type}";
1178     }
1179
1180     my $veth = "veth${vmid}i${netid}";
1181     my $eth = $newnet->{name};
1182
1183     if (my $oldnetcfg = $conf->{$opt}) {
1184         my $oldnet = parse_lxc_network($oldnetcfg);
1185
1186         if (&$safe_string_ne($oldnet->{hwaddr}, $newnet->{hwaddr}) ||
1187             &$safe_string_ne($oldnet->{name}, $newnet->{name})) {
1188
1189             PVE::Network::veth_delete($veth);
1190             delete $conf->{$opt};
1191             PVE::LXC::write_config($vmid, $conf);
1192
1193             hotplug_net($vmid, $conf, $opt, $newnet, $netid);
1194
1195         } elsif (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
1196                  &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
1197                  &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
1198
1199                 if ($oldnet->{bridge}) {
1200                     PVE::Network::tap_unplug($veth);
1201                     foreach (qw(bridge tag firewall)) {
1202                         delete $oldnet->{$_};
1203                     }
1204                     $conf->{$opt} = print_lxc_network($oldnet);
1205                     PVE::LXC::write_config($vmid, $conf);
1206                 }
1207
1208                 PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1209                 foreach (qw(bridge tag firewall)) {
1210                     $oldnet->{$_} = $newnet->{$_} if $newnet->{$_};
1211                 }
1212                 $conf->{$opt} = print_lxc_network($oldnet);
1213                 PVE::LXC::write_config($vmid, $conf);
1214         }
1215     } else {
1216         hotplug_net($vmid, $conf, $opt, $newnet, $netid);
1217     }
1218
1219     update_ipconfig($vmid, $conf, $opt, $eth, $newnet, $rootdir);
1220 }
1221
1222 sub hotplug_net {
1223     my ($vmid, $conf, $opt, $newnet, $netid) = @_;
1224
1225     my $veth = "veth${vmid}i${netid}";
1226     my $vethpeer = $veth . "p";
1227     my $eth = $newnet->{name};
1228
1229     PVE::Network::veth_create($veth, $vethpeer, $newnet->{bridge}, $newnet->{hwaddr});
1230     PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1231
1232     # attach peer in container
1233     my $cmd = ['lxc-device', '-n', $vmid, 'add', $vethpeer, "$eth" ];
1234     PVE::Tools::run_command($cmd);
1235
1236     # link up peer in container
1237     $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', 'link', 'set', $eth ,'up'  ];
1238     PVE::Tools::run_command($cmd);
1239
1240     my $done = { type => 'veth' };
1241     foreach (qw(bridge tag firewall hwaddr name)) {
1242         $done->{$_} = $newnet->{$_} if $newnet->{$_};
1243     }
1244     $conf->{$opt} = print_lxc_network($done);
1245
1246     PVE::LXC::write_config($vmid, $conf);
1247 }
1248
1249 sub update_ipconfig {
1250     my ($vmid, $conf, $opt, $eth, $newnet, $rootdir) = @_;
1251
1252     my $lxc_setup = PVE::LXCSetup->new($conf, $rootdir);
1253
1254     my $optdata = parse_lxc_network($conf->{$opt});
1255     my $deleted = [];
1256     my $added = [];
1257     my $nscmd = sub {
1258         my $cmdargs = shift;
1259         PVE::Tools::run_command(['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', @_], %$cmdargs);
1260     };
1261     my $ipcmd = sub { &$nscmd({}, '/sbin/ip', @_) };
1262
1263     my $change_ip_config = sub {
1264         my ($ipversion) = @_;
1265
1266         my $family_opt = "-$ipversion";
1267         my $suffix = $ipversion == 4 ? '' : $ipversion;
1268         my $gw= "gw$suffix";
1269         my $ip= "ip$suffix";
1270
1271         my $newip = $newnet->{$ip};
1272         my $newgw = $newnet->{$gw};
1273         my $oldip = $optdata->{$ip};
1274
1275         my $change_ip = &$safe_string_ne($oldip, $newip);
1276         my $change_gw = &$safe_string_ne($optdata->{$gw}, $newgw);
1277
1278         return if !$change_ip && !$change_gw;
1279
1280         # step 1: add new IP, if this fails we cancel
1281         if ($change_ip && $newip && $newip !~ /^(?:auto|dhcp)$/) {
1282             eval { &$ipcmd($family_opt, 'addr', 'add', $newip, 'dev', $eth); };
1283             if (my $err = $@) {
1284                 warn $err;
1285                 return;
1286             }
1287         }
1288
1289         # step 2: replace gateway
1290         #   If this fails we delete the added IP and cancel.
1291         #   If it succeeds we save the config and delete the old IP, ignoring
1292         #   errors. The config is then saved.
1293         # Note: 'ip route replace' can add
1294         if ($change_gw) {
1295             if ($newgw) {
1296                 eval { &$ipcmd($family_opt, 'route', 'replace', 'default', 'via', $newgw); };
1297                 if (my $err = $@) {
1298                     warn $err;
1299                     # the route was not replaced, the old IP is still available
1300                     # rollback (delete new IP) and cancel
1301                     if ($change_ip) {
1302                         eval { &$ipcmd($family_opt, 'addr', 'del', $newip, 'dev', $eth); };
1303                         warn $@ if $@; # no need to die here
1304                     }
1305                     return;
1306                 }
1307             } else {
1308                 eval { &$ipcmd($family_opt, 'route', 'del', 'default'); };
1309                 # if the route was not deleted, the guest might have deleted it manually
1310                 # warn and continue
1311                 warn $@ if $@;
1312             }
1313         }
1314
1315         # from this point on we save the configuration
1316         # step 3: delete old IP ignoring errors
1317         if ($change_ip && $oldip && $oldip !~ /^(?:auto|dhcp)$/) {
1318             # We need to enable promote_secondaries, otherwise our newly added
1319             # address will be removed along with the old one.
1320             my $promote = 0;
1321             eval {
1322                 if ($ipversion == 4) {
1323                     &$nscmd({ outfunc => sub { $promote = int(shift) } },
1324                             'cat', "/proc/sys/net/ipv4/conf/$eth/promote_secondaries");
1325                     &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=1");
1326                 }
1327                 &$ipcmd($family_opt, 'addr', 'del', $oldip, 'dev', $eth);
1328             };
1329             warn $@ if $@; # no need to die here
1330
1331             if ($ipversion == 4) {
1332                 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=$promote");
1333             }
1334         }
1335
1336         foreach my $property ($ip, $gw) {
1337             if ($newnet->{$property}) {
1338                 $optdata->{$property} = $newnet->{$property};
1339             } else {
1340                 delete $optdata->{$property};
1341             }
1342         }
1343         $conf->{$opt} = print_lxc_network($optdata);
1344         PVE::LXC::write_config($vmid, $conf);
1345         $lxc_setup->setup_network($conf);
1346     };
1347
1348     &$change_ip_config(4);
1349     &$change_ip_config(6);
1350
1351 }
1352
1353 # Internal snapshots
1354
1355 # NOTE: Snapshot create/delete involves several non-atomic
1356 # action, and can take a long time.
1357 # So we try to avoid locking the file and use 'lock' variable
1358 # inside the config file instead.
1359
1360 my $snapshot_copy_config = sub {
1361     my ($source, $dest) = @_;
1362
1363     foreach my $k (keys %$source) {
1364         next if $k eq 'snapshots';
1365         next if $k eq 'snapstate';
1366         next if $k eq 'snaptime';
1367         next if $k eq 'vmstate';
1368         next if $k eq 'lock';
1369         next if $k eq 'digest';
1370         next if $k eq 'description';
1371
1372         $dest->{$k} = $source->{$k};
1373     }
1374 };
1375
1376 my $snapshot_prepare = sub {
1377     my ($vmid, $snapname, $comment) = @_;
1378
1379     my $snap;
1380
1381     my $updatefn =  sub {
1382
1383         my $conf = load_config($vmid);
1384
1385         check_lock($conf);
1386
1387         $conf->{lock} = 'snapshot';
1388
1389         die "snapshot name '$snapname' already used\n"
1390             if defined($conf->{snapshots}->{$snapname});
1391
1392         my $storecfg = PVE::Storage::config();
1393         die "snapshot feature is not available\n" if !has_feature('snapshot', $conf, $storecfg);
1394
1395         $snap = $conf->{snapshots}->{$snapname} = {};
1396
1397         &$snapshot_copy_config($conf, $snap);
1398
1399         $snap->{'snapstate'} = "prepare";
1400         $snap->{'snaptime'} = time();
1401         $snap->{'description'} = $comment if $comment;
1402         $conf->{snapshots}->{$snapname} = $snap;
1403
1404         PVE::LXC::write_config($vmid, $conf);
1405     };
1406
1407     lock_container($vmid, 10, $updatefn);
1408
1409     return $snap;
1410 };
1411
1412 my $snapshot_commit = sub {
1413     my ($vmid, $snapname) = @_;
1414
1415     my $updatefn = sub {
1416
1417         my $conf = load_config($vmid);
1418
1419         die "missing snapshot lock\n"
1420             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
1421
1422         die "snapshot '$snapname' does not exist\n"
1423             if !defined($conf->{snapshots}->{$snapname});
1424
1425         die "wrong snapshot state\n"
1426             if !($conf->{snapshots}->{$snapname}->{'snapstate'} &&
1427                  $conf->{snapshots}->{$snapname}->{'snapstate'} eq "prepare");
1428
1429         delete $conf->{snapshots}->{$snapname}->{'snapstate'};
1430         delete $conf->{lock};
1431         $conf->{parent} = $snapname;
1432
1433         PVE::LXC::write_config($vmid, $conf);
1434     };
1435
1436     lock_container($vmid, 10 ,$updatefn);
1437 };
1438
1439 sub has_feature {
1440     my ($feature, $conf, $storecfg, $snapname) = @_;
1441
1442     #Fixme add other drives if necessary.
1443     my $err;
1444
1445     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1446     $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $rootinfo->{volume}, $snapname);
1447
1448     return $err ? 0 : 1;
1449 }
1450
1451 sub snapshot_create {
1452     my ($vmid, $snapname, $comment) = @_;
1453
1454     my $snap = &$snapshot_prepare($vmid, $snapname, $comment);
1455
1456     my $conf = load_config($vmid);
1457
1458     my $cmd = "/usr/bin/lxc-freeze -n $vmid";
1459     my $running = check_running($vmid);
1460     eval {
1461         if ($running) {
1462             PVE::Tools::run_command($cmd);
1463         };
1464
1465         my $storecfg = PVE::Storage::config();
1466         my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1467         my $volid = $rootinfo->{volume};
1468
1469         $cmd = "/usr/bin/lxc-unfreeze -n $vmid";
1470         if ($running) {
1471             PVE::Tools::run_command($cmd);
1472         };
1473
1474         PVE::Storage::volume_snapshot($storecfg, $volid, $snapname);
1475         &$snapshot_commit($vmid, $snapname);
1476     };
1477     if(my $err = $@) {
1478         snapshot_delete($vmid, $snapname, 1);
1479         die "$err\n";
1480     }
1481 }
1482
1483 sub snapshot_delete {
1484     my ($vmid, $snapname, $force) = @_;
1485
1486     my $snap;
1487
1488     my $conf;
1489
1490     my $updatefn =  sub {
1491
1492         $conf = load_config($vmid);
1493
1494         $snap = $conf->{snapshots}->{$snapname};
1495
1496         check_lock($conf);
1497
1498         die "snapshot '$snapname' does not exist\n" if !defined($snap);
1499
1500         $snap->{snapstate} = 'delete';
1501
1502         PVE::LXC::write_config($vmid, $conf);
1503     };
1504
1505     lock_container($vmid, 10, $updatefn);
1506
1507     my $storecfg = PVE::Storage::config();
1508
1509     my $del_snap =  sub {
1510
1511         check_lock($conf);
1512
1513         if ($conf->{parent} eq $snapname) {
1514             if ($conf->{snapshots}->{$snapname}->{snapname}) {
1515                 $conf->{parent} = $conf->{snapshots}->{$snapname}->{parent};
1516             } else {
1517                 delete $conf->{parent};
1518             }
1519         }
1520
1521         delete $conf->{snapshots}->{$snapname};
1522
1523         PVE::LXC::write_config($vmid, $conf);
1524     };
1525
1526     my $rootfs = $conf->{snapshots}->{$snapname}->{rootfs};
1527     my $rootinfo = PVE::LXC::parse_ct_mountpoint($rootfs);
1528     my $volid = $rootinfo->{volume};
1529
1530     eval {
1531         PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snapname);
1532     };
1533     my $err = $@;
1534
1535     if(!$err || ($err && $force)) {
1536         lock_container($vmid, 10, $del_snap);
1537         if ($err) {
1538             die "Can't delete snapshot: $vmid $snapname $err\n";
1539         }
1540     }
1541 }
1542
1543 sub snapshot_rollback {
1544     my ($vmid, $snapname) = @_;
1545
1546     my $storecfg = PVE::Storage::config();
1547
1548     my $conf = load_config($vmid);
1549
1550     my $snap = $conf->{snapshots}->{$snapname};
1551
1552     die "snapshot '$snapname' does not exist\n" if !defined($snap);
1553
1554     my $rootfs = $snap->{rootfs};
1555     my $rootinfo = PVE::LXC::parse_ct_mountpoint($rootfs);
1556     my $volid = $rootinfo->{volume};
1557
1558     PVE::Storage::volume_rollback_is_possible($storecfg, $volid, $snapname);
1559
1560     my $updatefn = sub {
1561
1562         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
1563             if $snap->{snapstate};
1564
1565         check_lock($conf);
1566
1567         system("lxc-stop -n $vmid --kill") if check_running($vmid);
1568
1569         die "unable to rollback vm $vmid: vm is running\n"
1570             if check_running($vmid);
1571
1572         $conf->{lock} = 'rollback';
1573
1574         my $forcemachine;
1575
1576         # copy snapshot config to current config
1577
1578         my $tmp_conf = $conf;
1579         &$snapshot_copy_config($tmp_conf->{snapshots}->{$snapname}, $conf);
1580         $conf->{snapshots} = $tmp_conf->{snapshots};
1581         delete $conf->{snaptime};
1582         delete $conf->{snapname};
1583         $conf->{parent} = $snapname;
1584
1585         PVE::LXC::write_config($vmid, $conf);
1586     };
1587
1588     my $unlockfn = sub {
1589         delete $conf->{lock};
1590         PVE::LXC::write_config($vmid, $conf);
1591     };
1592
1593     lock_container($vmid, 10, $updatefn);
1594
1595     PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
1596
1597     lock_container($vmid, 5, $unlockfn);
1598 }
1599
1600 1;