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