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) = @_;
 443
 444     my $cfspath = cfs_config_path($vmid);
 445
 446     my $conf = PVE::Cluster::cfs_read_file($cfspath);
 447     die "container $vmid does not exists\n" if !defined($conf);
 448
 449     return $conf;
 450 }
 451
 452 sub create_config {
 453     my ($vmid, $conf) = @_;
 454
 455     my $dir = "/etc/pve/nodes/$nodename/lxc";
 456     mkdir $dir;
 457
 458     write_config($vmid, $conf);
 459 }
 460
 461 sub destroy_config {
 462     my ($vmid) = @_;
 463
 464     unlink config_file($vmid, $nodename);
 465 }
 466
 467 sub write_config {
 468     my ($vmid, $conf) = @_;
 469
 470     my $cfspath = cfs_config_path($vmid);
 471
 472     PVE::Cluster::cfs_write_file($cfspath, $conf);
 473 }
 474
 475 # flock: we use one file handle per process, so lock file
 476 # can be called multiple times and succeeds for the same process.
 477
 478 my $lock_handles =  {};
 479 my $lockdir = "/run/lock/lxc";
 480
 481 sub lock_filename {
 482     my ($vmid) = @_;
 483
 484     return "$lockdir/pve-config-{$vmid}.lock";
 485 }
 486
 487 sub lock_aquire {
 488     my ($vmid, $timeout) = @_;
 489
 490     $timeout = 10 if !$timeout;
 491     my $mode = LOCK_EX;
 492
 493     my $filename = lock_filename($vmid);
 494
 495     mkdir $lockdir if !-d $lockdir;
 496
 497     my $lock_func = sub {
 498         if (!$lock_handles->{$$}->{$filename}) {
 499             my $fh = new IO::File(">>$filename") ||
 500                 die "can't open file - $!\n";
 501             $lock_handles->{$$}->{$filename} = { fh => $fh, refcount => 0};
 502         }
 503
 504         if (!flock($lock_handles->{$$}->{$filename}->{fh}, $mode |LOCK_NB)) {
 505             print STDERR "trying to aquire lock...";
 506             my $success;
 507             while(1) {
 508                 $success = flock($lock_handles->{$$}->{$filename}->{fh}, $mode);
 509                 # try again on EINTR (see bug #273)
 510                 if ($success || ($! != EINTR)) {
 511                     last;
 512                 }
 513             }
 514             if (!$success) {
 515                 print STDERR " failed\n";
 516                 die "can't aquire lock - $!\n";
 517             }
 518
 519             $lock_handles->{$$}->{$filename}->{refcount}++;
 520
 521             print STDERR " OK\n";
 522         }
 523     };
 524
 525     eval { PVE::Tools::run_with_timeout($timeout, $lock_func); };
 526     my $err = $@;
 527     if ($err) {
 528         die "can't lock file '$filename' - $err";
 529     }
 530 }
 531
 532 sub lock_release {
 533     my ($vmid) = @_;
 534
 535     my $filename = lock_filename($vmid);
 536
 537     if (my $fh = $lock_handles->{$$}->{$filename}->{fh}) {
 538         my $refcount = --$lock_handles->{$$}->{$filename}->{refcount};
 539         if ($refcount <= 0) {
 540             $lock_handles->{$$}->{$filename} = undef;
 541             close ($fh);
 542         }
 543     }
 544 }
 545
 546 sub lock_container {
 547     my ($vmid, $timeout, $code, @param) = @_;
 548
 549     my $res;
 550
 551     lock_aquire($vmid, $timeout);
 552     eval { $res = &$code(@param) };
 553     my $err = $@;
 554     lock_release($vmid);
 555
 556     die $err if $err;
 557
 558     return $res;
 559 }
 560
 561 sub option_exists {
 562     my ($name) = @_;
 563
 564     return defined($confdesc->{$name});
 565 }
 566
 567 # add JSON properties for create and set function
 568 sub json_config_properties {
 569     my $prop = shift;
 570
 571     foreach my $opt (keys %$confdesc) {
 572         next if $opt eq 'parent' || $opt eq 'snaptime';
 573         next if $prop->{$opt};
 574         $prop->{$opt} = $confdesc->{$opt};
 575     }
 576
 577     return $prop;
 578 }
 579
 580 sub json_config_properties_no_rootfs {
 581     my $prop = shift;
 582
 583     foreach my $opt (keys %$confdesc) {
 584         next if $prop->{$opt};
 585         next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'rootfs';
 586         $prop->{$opt} = $confdesc->{$opt};
 587     }
 588
 589     return $prop;
 590 }
 591
 592 # container status helpers
 593
 594 sub list_active_containers {
 595
 596     my $filename = "/proc/net/unix";
 597
 598     # similar test is used by lcxcontainers.c: list_active_containers
 599     my $res = {};
 600
 601     my $fh = IO::File->new ($filename, "r");
 602     return $res if !$fh;
 603
 604     while (defined(my $line = <$fh>)) {
 605         if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
 606             my $path = $1;
 607             if ($path =~ m!^@/var/lib/lxc/(\d+)/command$!) {
 608                 $res->{$1} = 1;
 609             }
 610         }
 611     }
 612
 613     close($fh);
 614
 615     return $res;
 616 }
 617
 618 # warning: this is slow
 619 sub check_running {
 620     my ($vmid) = @_;
 621
 622     my $active_hash = list_active_containers();
 623
 624     return 1 if defined($active_hash->{$vmid});
 625
 626     return undef;
 627 }
 628
 629 sub get_container_disk_usage {
 630     my ($vmid) = @_;
 631
 632     my $cmd = ['lxc-attach', '-n', $vmid, '--', 'df',  '-P', '-B', '1', '/'];
 633
 634     my $res = {
 635         total => 0,
 636         used => 0,
 637         avail => 0,
 638     };
 639
 640     my $parser = sub {
 641         my $line = shift;
 642         if (my ($fsid, $total, $used, $avail) = $line =~
 643             m/^(\S+.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+\d+%\s.*$/) {
 644             $res = {
 645                 total => $total,
 646                 used => $used,
 647                 avail => $avail,
 648             };
 649         }
 650     };
 651     eval { PVE::Tools::run_command($cmd, timeout => 1, outfunc => $parser); };
 652     warn $@ if $@;
 653
 654     return $res;
 655 }
 656
 657 sub vmstatus {
 658     my ($opt_vmid) = @_;
 659
 660     my $list = $opt_vmid ? { $opt_vmid => { type => 'lxc' }} : config_list();
 661
 662     my $active_hash = list_active_containers();
 663
 664     foreach my $vmid (keys %$list) {
 665         my $d = $list->{$vmid};
 666
 667         my $running = defined($active_hash->{$vmid});
 668
 669         $d->{status} = $running ? 'running' : 'stopped';
 670
 671         my $cfspath = cfs_config_path($vmid);
 672         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
 673
 674         $d->{name} = $conf->{'hostname'} || "CT$vmid";
 675         $d->{name} =~ s/[\s]//g;
 676
 677         $d->{cpus} = $conf->{cpulimit} // 0;
 678
 679         if ($running) {
 680             my $res = get_container_disk_usage($vmid);
 681             $d->{disk} = $res->{used};
 682             $d->{maxdisk} = $res->{total};
 683         } else {
 684             $d->{disk} = 0;
 685             # use 4GB by default ??
 686             if (my $rootfs = $conf->{rootfs}) {
 687                 my $rootinfo = parse_ct_mountpoint($rootfs);
 688                 $d->{maxdisk} = int(($rootinfo->{size} || 4)*1024*1024)*1024;
 689             } else {
 690                 $d->{maxdisk} = 4*1024*1024*1024;
 691             }
 692         }
 693
 694         $d->{mem} = 0;
 695         $d->{swap} = 0;
 696         $d->{maxmem} = ($conf->{memory}||512)*1024*1024;
 697         $d->{maxswap} = ($conf->{swap}//0)*1024*1024;
 698
 699         $d->{uptime} = 0;
 700         $d->{cpu} = 0;
 701
 702         $d->{netout} = 0;
 703         $d->{netin} = 0;
 704
 705         $d->{diskread} = 0;
 706         $d->{diskwrite} = 0;
 707
 708         $d->{template} = is_template($conf);
 709     }
 710
 711     foreach my $vmid (keys %$list) {
 712         my $d = $list->{$vmid};
 713         next if $d->{status} ne 'running';
 714
 715         $d->{uptime} = 100; # fixme:
 716
 717         $d->{mem} = read_cgroup_value('memory', $vmid, 'memory.usage_in_bytes');
 718         $d->{swap} = read_cgroup_value('memory', $vmid, 'memory.memsw.usage_in_bytes') - $d->{mem};
 719
 720         my $blkio_bytes = read_cgroup_value('blkio', $vmid, 'blkio.throttle.io_service_bytes', 1);
 721         my @bytes = split(/\n/, $blkio_bytes);
 722         foreach my $byte (@bytes) {
 723             if (my ($key, $value) = $byte =~ /(Read|Write)\s+(\d+)/) {
 724                 $d->{diskread} = $2 if $key eq 'Read';
 725                 $d->{diskwrite} = $2 if $key eq 'Write';
 726             }
 727         }
 728     }
 729
 730     return $list;
 731 }
 732
 733 my $parse_size = sub {
 734     my ($value) = @_;
 735
 736     return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
 737     my ($size, $unit) = ($1, $3);
 738     if ($unit) {
 739         if ($unit eq 'K') {
 740             $size = $size * 1024;
 741         } elsif ($unit eq 'M') {
 742             $size = $size * 1024 * 1024;
 743         } elsif ($unit eq 'G') {
 744             $size = $size * 1024 * 1024 * 1024;
 745         }
 746     }
 747     return int($size);
 748 };
 749
 750 sub parse_ct_mountpoint {
 751     my ($data) = @_;
 752
 753     $data //= '';
 754
 755     my $res = {};
 756
 757     foreach my $p (split (/,/, $data)) {
 758         next if $p =~ m/^\s*$/;
 759
 760         if ($p =~ m/^(volume|backup|size|mp)=(.+)$/) {
 761             my ($k, $v) = ($1, $2);
 762             return undef if defined($res->{$k});
 763             $res->{$k} = $v;
 764         } else {
 765             if (!$res->{volume} && $p !~ m/=/) {
 766                 $res->{volume} = $p;
 767             } else {
 768                 return undef;
 769             }
 770         }
 771     }
 772
 773     return undef if !$res->{volume};
 774
 775     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
 776
 777     if ($res->{size}) {
 778         return undef if !defined($res->{size} = &$parse_size($res->{size}));
 779     }
 780
 781     return $res;
 782 }
 783
 784 sub print_ct_mountpoint {
 785     my ($info) = @_;
 786
 787     my $opts = '';
 788
 789     die "missing volume\n" if !$info->{volume};
 790
 791     foreach my $o ('size', 'backup') {
 792         $opts .= ",$o=$info->{$o}" if defined($info->{$o});
 793     }
 794
 795     return "$info->{volume}$opts";
 796 }
 797
 798 sub print_lxc_network {
 799     my $net = shift;
 800
 801     die "no network name defined\n" if !$net->{name};
 802
 803     my $res = "name=$net->{name}";
 804
 805     foreach my $k (qw(hwaddr mtu bridge ip gw ip6 gw6 firewall tag)) {
 806         next if !defined($net->{$k});
 807         $res .= ",$k=$net->{$k}";
 808     }
 809
 810     return $res;
 811 }
 812
 813 sub parse_lxc_network {
 814     my ($data) = @_;
 815
 816     my $res = {};
 817
 818     return $res if !$data;
 819
 820     foreach my $pv (split (/,/, $data)) {
 821         if ($pv =~ m/^(bridge|hwaddr|mtu|name|ip|ip6|gw|gw6|firewall|tag)=(\S+)$/) {
 822             $res->{$1} = $2;
 823         } else {
 824             return undef;
 825         }
 826     }
 827
 828     $res->{type} = 'veth';
 829     $res->{hwaddr} = PVE::Tools::random_ether_addr() if !$res->{hwaddr};
 830
 831     return $res;
 832 }
 833
 834 sub read_cgroup_value {
 835     my ($group, $vmid, $name, $full) = @_;
 836
 837     my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
 838
 839     return PVE::Tools::file_get_contents($path) if $full;
 840
 841     return PVE::Tools::file_read_firstline($path);
 842 }
 843
 844 sub write_cgroup_value {
 845    my ($group, $vmid, $name, $value) = @_;
 846
 847    my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
 848    PVE::ProcFSTools::write_proc_entry($path, $value) if -e $path;
 849
 850 }
 851
 852 sub find_lxc_console_pids {
 853
 854     my $res = {};
 855
 856     PVE::Tools::dir_glob_foreach('/proc', '\d+', sub {
 857         my ($pid) = @_;
 858
 859         my $cmdline = PVE::Tools::file_read_firstline("/proc/$pid/cmdline");
 860         return if !$cmdline;
 861
 862         my @args = split(/\0/, $cmdline);
 863
 864         # serach for lxc-console -n <vmid>
 865         return if scalar(@args) != 3;
 866         return if $args[1] ne '-n';
 867         return if $args[2] !~ m/^\d+$/;
 868         return if $args[0] !~ m|^(/usr/bin/)?lxc-console$|;
 869
 870         my $vmid = $args[2];
 871
 872         push @{$res->{$vmid}}, $pid;
 873     });
 874
 875     return $res;
 876 }
 877
 878 sub find_lxc_pid {
 879     my ($vmid) = @_;
 880
 881     my $pid = undef;
 882     my $parser = sub {
 883         my $line = shift;
 884         $pid = $1 if $line =~ m/^PID:\s+(\d+)$/;
 885     };
 886     PVE::Tools::run_command(['lxc-info', '-n', $vmid], outfunc => $parser);
 887
 888     die "unable to get PID for CT $vmid (not running?)\n" if !$pid;
 889
 890     return $pid;
 891 }
 892
 893 my $ipv4_reverse_mask = [
 894     '0.0.0.0',
 895     '128.0.0.0',
 896     '192.0.0.0',
 897     '224.0.0.0',
 898     '240.0.0.0',
 899     '248.0.0.0',
 900     '252.0.0.0',
 901     '254.0.0.0',
 902     '255.0.0.0',
 903     '255.128.0.0',
 904     '255.192.0.0',
 905     '255.224.0.0',
 906     '255.240.0.0',
 907     '255.248.0.0',
 908     '255.252.0.0',
 909     '255.254.0.0',
 910     '255.255.0.0',
 911     '255.255.128.0',
 912     '255.255.192.0',
 913     '255.255.224.0',
 914     '255.255.240.0',
 915     '255.255.248.0',
 916     '255.255.252.0',
 917     '255.255.254.0',
 918     '255.255.255.0',
 919     '255.255.255.128',
 920     '255.255.255.192',
 921     '255.255.255.224',
 922     '255.255.255.240',
 923     '255.255.255.248',
 924     '255.255.255.252',
 925     '255.255.255.254',
 926     '255.255.255.255',
 927 ];
 928
 929 # Note: we cannot use Net:IP, because that only allows strict
 930 # CIDR networks
 931 sub parse_ipv4_cidr {
 932     my ($cidr, $noerr) = @_;
 933
 934     if ($cidr =~ m!^($IPV4RE)(?:/(\d+))$! && ($2 > 7) &&  ($2 < 32)) {
 935         return { address => $1, netmask => $ipv4_reverse_mask->[$2] };
 936     }
 937
 938     return undef if $noerr;
 939
 940     die "unable to parse ipv4 address/mask\n";
 941 }
 942
 943 sub check_lock {
 944     my ($conf) = @_;
 945
 946     die "VM is locked ($conf->{'lock'})\n" if $conf->{'lock'};
 947 }
 948
 949 sub update_lxc_config {
 950     my ($storage_cfg, $vmid, $conf) = @_;
 951
 952     my $dir = "/var/lib/lxc/$vmid";
 953
 954     if ($conf->{template}) {
 955
 956         unlink "$dir/config";
 957
 958         return;
 959     }
 960
 961     my $raw = '';
 962
 963     die "missing 'arch' - internal error" if !$conf->{arch};
 964     $raw .= "lxc.arch = $conf->{arch}\n";
 965
 966     my $ostype = $conf->{ostype} || die "missing 'ostype' - internal error";
 967     if ($ostype =~ /^(?:debian | ubuntu | centos | archlinux)$/x) {
 968         $raw .= "lxc.include = /usr/share/lxc/config/$ostype.common.conf\n";
 969     } else {
 970         die "implement me";
 971     }
 972
 973     if (!has_dev_console($conf)) {
 974         $raw .= "lxc.console = none\n";
 975         $raw .= "lxc.cgroup.devices.deny = c 5:1 rwm\n";
 976     }
 977
 978     my $ttycount = get_tty_count($conf);
 979     $raw .= "lxc.tty = $ttycount\n";
 980
 981     my $utsname = $conf->{hostname} || "CT$vmid";
 982     $raw .= "lxc.utsname = $utsname\n";
 983
 984     my $memory = $conf->{memory} || 512;
 985     my $swap = $conf->{swap} // 0;
 986
 987     my $lxcmem = int($memory*1024*1024);
 988     $raw .= "lxc.cgroup.memory.limit_in_bytes = $lxcmem\n";
 989
 990     my $lxcswap = int(($memory + $swap)*1024*1024);
 991     $raw .= "lxc.cgroup.memory.memsw.limit_in_bytes = $lxcswap\n";
 992
 993     if (my $cpulimit = $conf->{cpulimit}) {
 994         $raw .= "lxc.cgroup.cpu.cfs_period_us = 100000\n";
 995         my $value = int(100000*$cpulimit);
 996         $raw .= "lxc.cgroup.cpu.cfs_quota_us = $value\n";
 997     }
 998
 999     my $shares = $conf->{cpuunits} || 1024;
1000     $raw .= "lxc.cgroup.cpu.shares = $shares\n";
1001
1002     my $mountpoint = parse_ct_mountpoint($conf->{rootfs});
1003     my $volid = $mountpoint->{volume};
1004     my $path = volid_path ($volid, $storage_cfg);
1005     my ($storage, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1006
1007     if ($storage) {
1008         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1009         $path = "loop:$path" if $scfg->{path};
1010     }
1011
1012     $raw .= "lxc.rootfs = $path\n";
1013
1014     my $netcount = 0;
1015     foreach my $k (keys %$conf) {
1016         next if $k !~ m/^net(\d+)$/;
1017         my $ind = $1;
1018         my $d = parse_lxc_network($conf->{$k});
1019         $netcount++;
1020         $raw .= "lxc.network.type = veth\n";
1021         $raw .= "lxc.network.veth.pair = veth${vmid}i${ind}\n";
1022         $raw .= "lxc.network.hwaddr = $d->{hwaddr}\n" if defined($d->{hwaddr});
1023         $raw .= "lxc.network.name = $d->{name}\n" if defined($d->{name});
1024         $raw .= "lxc.network.mtu = $d->{mtu}\n" if defined($d->{mtu});
1025     }
1026
1027     if (my $lxcconf = $conf->{lxc}) {
1028         foreach my $entry (@$lxcconf) {
1029             my ($k, $v) = @$entry;
1030             $netcount++ if $k eq 'lxc.network.type';
1031             $raw .= "$k = $v\n";
1032         }
1033     }
1034
1035     $raw .= "lxc.network.type = empty\n" if !$netcount;
1036
1037     File::Path::mkpath("$dir/rootfs");
1038
1039     PVE::Tools::file_set_contents("$dir/config", $raw);
1040 }
1041
1042 # verify and cleanup nameserver list (replace \0 with ' ')
1043 sub verify_nameserver_list {
1044     my ($nameserver_list) = @_;
1045
1046     my @list = ();
1047     foreach my $server (PVE::Tools::split_list($nameserver_list)) {
1048         PVE::JSONSchema::pve_verify_ip($server);
1049         push @list, $server;
1050     }
1051
1052     return join(' ', @list);
1053 }
1054
1055 sub verify_searchdomain_list {
1056     my ($searchdomain_list) = @_;
1057
1058     my @list = ();
1059     foreach my $server (PVE::Tools::split_list($searchdomain_list)) {
1060         # todo: should we add checks for valid dns domains?
1061         push @list, $server;
1062     }
1063
1064     return join(' ', @list);
1065 }
1066
1067 sub update_pct_config {
1068     my ($vmid, $conf, $running, $param, $delete) = @_;
1069
1070     my @nohotplug;
1071
1072     my $rootdir;
1073     if ($running) {
1074         my $pid = find_lxc_pid($vmid);
1075         $rootdir = "/proc/$pid/root";
1076     }
1077
1078     if (defined($delete)) {
1079         foreach my $opt (@$delete) {
1080             if ($opt eq 'hostname' || $opt eq 'memory' || $opt eq 'rootfs') {
1081                 die "unable to delete required option '$opt'\n";
1082             } elsif ($opt eq 'swap') {
1083                 delete $conf->{$opt};
1084                 write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", -1);
1085             } elsif ($opt eq 'description' || $opt eq 'onboot' || $opt eq 'startup') {
1086                 delete $conf->{$opt};
1087             } elsif ($opt eq 'nameserver' || $opt eq 'searchdomain' ||
1088                      $opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1089                 delete $conf->{$opt};
1090                 push @nohotplug, $opt;
1091                 next if $running;
1092             } elsif ($opt =~ m/^net(\d)$/) {
1093                 delete $conf->{$opt};
1094                 next if !$running;
1095                 my $netid = $1;
1096                 PVE::Network::veth_delete("veth${vmid}i$netid");
1097             } else {
1098                 die "implement me"
1099             }
1100             PVE::LXC::write_config($vmid, $conf) if $running;
1101         }
1102     }
1103
1104     # There's no separate swap size to configure, there's memory and "total"
1105     # memory (iow. memory+swap). This means we have to change them together.
1106     my $wanted_memory = PVE::Tools::extract_param($param, 'memory');
1107     my $wanted_swap =  PVE::Tools::extract_param($param, 'swap');
1108     if (defined($wanted_memory) || defined($wanted_swap)) {
1109
1110         $wanted_memory //= ($conf->{memory} || 512);
1111         $wanted_swap //=  ($conf->{swap} || 0);
1112
1113         my $total = $wanted_memory + $wanted_swap;
1114         if ($running) {
1115             write_cgroup_value("memory", $vmid, "memory.limit_in_bytes", int($wanted_memory*1024*1024));
1116             write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", int($total*1024*1024));
1117         }
1118         $conf->{memory} = $wanted_memory;
1119         $conf->{swap} = $wanted_swap;
1120
1121         PVE::LXC::write_config($vmid, $conf) if $running;
1122     }
1123
1124     foreach my $opt (keys %$param) {
1125         my $value = $param->{$opt};
1126         if ($opt eq 'hostname') {
1127             $conf->{$opt} = $value;
1128         } elsif ($opt eq 'onboot') {
1129             $conf->{$opt} = $value ? 1 : 0;
1130         } elsif ($opt eq 'startup') {
1131             $conf->{$opt} = $value;
1132         } elsif ($opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1133             $conf->{$opt} = $value;
1134             push @nohotplug, $opt;
1135             next if $running;
1136         } elsif ($opt eq 'nameserver') {
1137             my $list = verify_nameserver_list($value);
1138             $conf->{$opt} = $list;
1139             push @nohotplug, $opt;
1140             next if $running;
1141         } elsif ($opt eq 'searchdomain') {
1142             my $list = verify_searchdomain_list($value);
1143             $conf->{$opt} = $list;
1144             push @nohotplug, $opt;
1145             next if $running;
1146         } elsif ($opt eq 'cpulimit') {
1147             $conf->{$opt} = $value;
1148             push @nohotplug, $opt; # fixme: hotplug
1149             next;
1150         } elsif ($opt eq 'cpuunits') {
1151             $conf->{$opt} = $value;
1152             write_cgroup_value("cpu", $vmid, "cpu.shares", $value);
1153         } elsif ($opt eq 'description') {
1154             $conf->{$opt} = PVE::Tools::encode_text($value);
1155         } elsif ($opt =~ m/^net(\d+)$/) {
1156             my $netid = $1;
1157             my $net = parse_lxc_network($value);
1158             if (!$running) {
1159                 $conf->{$opt} = print_lxc_network($net);
1160             } else {
1161                 update_net($vmid, $conf, $opt, $net, $netid, $rootdir);
1162             }
1163         } else {
1164             die "implement me: $opt";
1165         }
1166         PVE::LXC::write_config($vmid, $conf) if $running;
1167     }
1168
1169     if ($running && scalar(@nohotplug)) {
1170         die "unable to modify " . join(',', @nohotplug) . " while container is running\n";
1171     }
1172 }
1173
1174 sub has_dev_console {
1175     my ($conf) = @_;
1176
1177     return !(defined($conf->{console}) && !$conf->{console});
1178 }
1179
1180 sub get_tty_count {
1181     my ($conf) = @_;
1182
1183     return $conf->{tty} // $confdesc->{tty}->{default};
1184 }
1185
1186 sub get_cmode {
1187     my ($conf) = @_;
1188
1189     return $conf->{cmode} // $confdesc->{cmode}->{default};
1190 }
1191
1192 sub get_console_command {
1193     my ($vmid, $conf) = @_;
1194
1195     my $cmode = get_cmode($conf);
1196
1197     if ($cmode eq 'console') {
1198         return ['lxc-console', '-n',  $vmid, '-t', 0];
1199     } elsif ($cmode eq 'tty') {
1200         return ['lxc-console', '-n',  $vmid];
1201     } elsif ($cmode eq 'shell') {
1202         return ['lxc-attach', '--clear-env', '-n', $vmid];
1203     } else {
1204         die "internal error";
1205     }
1206 }
1207
1208 sub get_primary_ips {
1209     my ($conf) = @_;
1210
1211     # return data from net0
1212
1213     return undef if !defined($conf->{net0});
1214     my $net = parse_lxc_network($conf->{net0});
1215
1216     my $ipv4 = $net->{ip};
1217     if ($ipv4) {
1218         if ($ipv4 =~ /^(dhcp|manual)$/) {
1219             $ipv4 = undef
1220         } else {
1221             $ipv4 =~ s!/\d+$!!;
1222         }
1223     }
1224     my $ipv6 = $net->{ip6};
1225     if ($ipv6) {
1226         if ($ipv6 =~ /^(dhcp|manual)$/) {
1227             $ipv6 = undef;
1228         } else {
1229             $ipv6 =~ s!/\d+$!!;
1230         }
1231     }
1232
1233     return ($ipv4, $ipv6);
1234 }
1235
1236
1237 sub destroy_lxc_container {
1238     my ($storage_cfg, $vmid, $conf) = @_;
1239
1240     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1241     if (defined($rootinfo->{volume})) {
1242         my ($vtype, $name, $owner) = PVE::Storage::parse_volname($storage_cfg, $rootinfo->{volume});
1243         PVE::Storage::vdisk_free($storage_cfg, $rootinfo->{volume}) if $vmid == $owner;;
1244     }
1245     rmdir "/var/lib/lxc/$vmid/rootfs";
1246     unlink "/var/lib/lxc/$vmid/config";
1247     rmdir "/var/lib/lxc/$vmid";
1248     destroy_config($vmid);
1249
1250     #my $cmd = ['lxc-destroy', '-n', $vmid ];
1251     #PVE::Tools::run_command($cmd);
1252 }
1253
1254 sub vm_stop_cleanup {
1255     my ($storage_cfg, $vmid, $conf, $keepActive) = @_;
1256
1257     eval {
1258         if (!$keepActive) {
1259
1260             my $vollist = get_vm_volumes($conf);
1261             my $loopdevlist = get_vm_volumes($conf, 'rootfs');
1262
1263             PVE::LXC::dettach_loops($storage_cfg, $loopdevlist);
1264             PVE::Storage::deactivate_volumes($storage_cfg, $vollist);
1265         }
1266     };
1267     warn $@ if $@; # avoid errors - just warn
1268 }
1269
1270 my $safe_num_ne = sub {
1271     my ($a, $b) = @_;
1272
1273     return 0 if !defined($a) && !defined($b);
1274     return 1 if !defined($a);
1275     return 1 if !defined($b);
1276
1277     return $a != $b;
1278 };
1279
1280 my $safe_string_ne = sub {
1281     my ($a, $b) = @_;
1282
1283     return 0 if !defined($a) && !defined($b);
1284     return 1 if !defined($a);
1285     return 1 if !defined($b);
1286
1287     return $a ne $b;
1288 };
1289
1290 sub update_net {
1291     my ($vmid, $conf, $opt, $newnet, $netid, $rootdir) = @_;
1292
1293     if ($newnet->{type} ne 'veth') {
1294         # for when there are physical interfaces
1295         die "cannot update interface of type $newnet->{type}";
1296     }
1297
1298     my $veth = "veth${vmid}i${netid}";
1299     my $eth = $newnet->{name};
1300
1301     if (my $oldnetcfg = $conf->{$opt}) {
1302         my $oldnet = parse_lxc_network($oldnetcfg);
1303
1304         if (&$safe_string_ne($oldnet->{hwaddr}, $newnet->{hwaddr}) ||
1305             &$safe_string_ne($oldnet->{name}, $newnet->{name})) {
1306
1307             PVE::Network::veth_delete($veth);
1308             delete $conf->{$opt};
1309             PVE::LXC::write_config($vmid, $conf);
1310
1311             hotplug_net($vmid, $conf, $opt, $newnet, $netid);
1312
1313         } elsif (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
1314                  &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
1315                  &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
1316
1317                 if ($oldnet->{bridge}) {
1318                     PVE::Network::tap_unplug($veth);
1319                     foreach (qw(bridge tag firewall)) {
1320                         delete $oldnet->{$_};
1321                     }
1322                     $conf->{$opt} = print_lxc_network($oldnet);
1323                     PVE::LXC::write_config($vmid, $conf);
1324                 }
1325
1326                 PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1327                 foreach (qw(bridge tag firewall)) {
1328                     $oldnet->{$_} = $newnet->{$_} if $newnet->{$_};
1329                 }
1330                 $conf->{$opt} = print_lxc_network($oldnet);
1331                 PVE::LXC::write_config($vmid, $conf);
1332         }
1333     } else {
1334         hotplug_net($vmid, $conf, $opt, $newnet, $netid);
1335     }
1336
1337     update_ipconfig($vmid, $conf, $opt, $eth, $newnet, $rootdir);
1338 }
1339
1340 sub hotplug_net {
1341     my ($vmid, $conf, $opt, $newnet, $netid) = @_;
1342
1343     my $veth = "veth${vmid}i${netid}";
1344     my $vethpeer = $veth . "p";
1345     my $eth = $newnet->{name};
1346
1347     PVE::Network::veth_create($veth, $vethpeer, $newnet->{bridge}, $newnet->{hwaddr});
1348     PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1349
1350     # attach peer in container
1351     my $cmd = ['lxc-device', '-n', $vmid, 'add', $vethpeer, "$eth" ];
1352     PVE::Tools::run_command($cmd);
1353
1354     # link up peer in container
1355     $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', 'link', 'set', $eth ,'up'  ];
1356     PVE::Tools::run_command($cmd);
1357
1358     my $done = { type => 'veth' };
1359     foreach (qw(bridge tag firewall hwaddr name)) {
1360         $done->{$_} = $newnet->{$_} if $newnet->{$_};
1361     }
1362     $conf->{$opt} = print_lxc_network($done);
1363
1364     PVE::LXC::write_config($vmid, $conf);
1365 }
1366
1367 sub update_ipconfig {
1368     my ($vmid, $conf, $opt, $eth, $newnet, $rootdir) = @_;
1369
1370     my $lxc_setup = PVE::LXCSetup->new($conf, $rootdir);
1371
1372     my $optdata = parse_lxc_network($conf->{$opt});
1373     my $deleted = [];
1374     my $added = [];
1375     my $nscmd = sub {
1376         my $cmdargs = shift;
1377         PVE::Tools::run_command(['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', @_], %$cmdargs);
1378     };
1379     my $ipcmd = sub { &$nscmd({}, '/sbin/ip', @_) };
1380
1381     my $change_ip_config = sub {
1382         my ($ipversion) = @_;
1383
1384         my $family_opt = "-$ipversion";
1385         my $suffix = $ipversion == 4 ? '' : $ipversion;
1386         my $gw= "gw$suffix";
1387         my $ip= "ip$suffix";
1388
1389         my $newip = $newnet->{$ip};
1390         my $newgw = $newnet->{$gw};
1391         my $oldip = $optdata->{$ip};
1392
1393         my $change_ip = &$safe_string_ne($oldip, $newip);
1394         my $change_gw = &$safe_string_ne($optdata->{$gw}, $newgw);
1395
1396         return if !$change_ip && !$change_gw;
1397
1398         # step 1: add new IP, if this fails we cancel
1399         if ($change_ip && $newip && $newip !~ /^(?:auto|dhcp)$/) {
1400             eval { &$ipcmd($family_opt, 'addr', 'add', $newip, 'dev', $eth); };
1401             if (my $err = $@) {
1402                 warn $err;
1403                 return;
1404             }
1405         }
1406
1407         # step 2: replace gateway
1408         #   If this fails we delete the added IP and cancel.
1409         #   If it succeeds we save the config and delete the old IP, ignoring
1410         #   errors. The config is then saved.
1411         # Note: 'ip route replace' can add
1412         if ($change_gw) {
1413             if ($newgw) {
1414                 eval { &$ipcmd($family_opt, 'route', 'replace', 'default', 'via', $newgw); };
1415                 if (my $err = $@) {
1416                     warn $err;
1417                     # the route was not replaced, the old IP is still available
1418                     # rollback (delete new IP) and cancel
1419                     if ($change_ip) {
1420                         eval { &$ipcmd($family_opt, 'addr', 'del', $newip, 'dev', $eth); };
1421                         warn $@ if $@; # no need to die here
1422                     }
1423                     return;
1424                 }
1425             } else {
1426                 eval { &$ipcmd($family_opt, 'route', 'del', 'default'); };
1427                 # if the route was not deleted, the guest might have deleted it manually
1428                 # warn and continue
1429                 warn $@ if $@;
1430             }
1431         }
1432
1433         # from this point on we save the configuration
1434         # step 3: delete old IP ignoring errors
1435         if ($change_ip && $oldip && $oldip !~ /^(?:auto|dhcp)$/) {
1436             # We need to enable promote_secondaries, otherwise our newly added
1437             # address will be removed along with the old one.
1438             my $promote = 0;
1439             eval {
1440                 if ($ipversion == 4) {
1441                     &$nscmd({ outfunc => sub { $promote = int(shift) } },
1442                             'cat', "/proc/sys/net/ipv4/conf/$eth/promote_secondaries");
1443                     &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=1");
1444                 }
1445                 &$ipcmd($family_opt, 'addr', 'del', $oldip, 'dev', $eth);
1446             };
1447             warn $@ if $@; # no need to die here
1448
1449             if ($ipversion == 4) {
1450                 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=$promote");
1451             }
1452         }
1453
1454         foreach my $property ($ip, $gw) {
1455             if ($newnet->{$property}) {
1456                 $optdata->{$property} = $newnet->{$property};
1457             } else {
1458                 delete $optdata->{$property};
1459             }
1460         }
1461         $conf->{$opt} = print_lxc_network($optdata);
1462         PVE::LXC::write_config($vmid, $conf);
1463         $lxc_setup->setup_network($conf);
1464     };
1465
1466     &$change_ip_config(4);
1467     &$change_ip_config(6);
1468
1469 }
1470
1471 # Internal snapshots
1472
1473 # NOTE: Snapshot create/delete involves several non-atomic
1474 # action, and can take a long time.
1475 # So we try to avoid locking the file and use 'lock' variable
1476 # inside the config file instead.
1477
1478 my $snapshot_copy_config = sub {
1479     my ($source, $dest) = @_;
1480
1481     foreach my $k (keys %$source) {
1482         next if $k eq 'snapshots';
1483         next if $k eq 'snapstate';
1484         next if $k eq 'snaptime';
1485         next if $k eq 'vmstate';
1486         next if $k eq 'lock';
1487         next if $k eq 'digest';
1488         next if $k eq 'description';
1489
1490         $dest->{$k} = $source->{$k};
1491     }
1492 };
1493
1494 my $snapshot_prepare = sub {
1495     my ($vmid, $snapname, $comment) = @_;
1496
1497     my $snap;
1498
1499     my $updatefn =  sub {
1500
1501         my $conf = load_config($vmid);
1502
1503         die "you can't take a snapshot if it's a template\n"
1504             if is_template($conf);
1505
1506         check_lock($conf);
1507
1508         $conf->{lock} = 'snapshot';
1509
1510         die "snapshot name '$snapname' already used\n"
1511             if defined($conf->{snapshots}->{$snapname});
1512
1513         my $storecfg = PVE::Storage::config();
1514         die "snapshot feature is not available\n" if !has_feature('snapshot', $conf, $storecfg);
1515
1516         $snap = $conf->{snapshots}->{$snapname} = {};
1517
1518         &$snapshot_copy_config($conf, $snap);
1519
1520         $snap->{'snapstate'} = "prepare";
1521         $snap->{'snaptime'} = time();
1522         $snap->{'description'} = $comment if $comment;
1523         $conf->{snapshots}->{$snapname} = $snap;
1524
1525         PVE::LXC::write_config($vmid, $conf);
1526     };
1527
1528     lock_container($vmid, 10, $updatefn);
1529
1530     return $snap;
1531 };
1532
1533 my $snapshot_commit = sub {
1534     my ($vmid, $snapname) = @_;
1535
1536     my $updatefn = sub {
1537
1538         my $conf = load_config($vmid);
1539
1540         die "missing snapshot lock\n"
1541             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
1542
1543         die "snapshot '$snapname' does not exist\n"
1544             if !defined($conf->{snapshots}->{$snapname});
1545
1546         die "wrong snapshot state\n"
1547             if !($conf->{snapshots}->{$snapname}->{'snapstate'} &&
1548                  $conf->{snapshots}->{$snapname}->{'snapstate'} eq "prepare");
1549
1550         delete $conf->{snapshots}->{$snapname}->{'snapstate'};
1551         delete $conf->{lock};
1552         $conf->{parent} = $snapname;
1553
1554         PVE::LXC::write_config($vmid, $conf);
1555     };
1556
1557     lock_container($vmid, 10 ,$updatefn);
1558 };
1559
1560 sub has_feature {
1561     my ($feature, $conf, $storecfg, $snapname) = @_;
1562
1563     #Fixme add other drives if necessary.
1564     my $err;
1565
1566     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1567     $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $rootinfo->{volume}, $snapname);
1568
1569     return $err ? 0 : 1;
1570 }
1571
1572 sub snapshot_create {
1573     my ($vmid, $snapname, $comment) = @_;
1574
1575     my $snap = &$snapshot_prepare($vmid, $snapname, $comment);
1576
1577     my $conf = load_config($vmid);
1578
1579     my $cmd = "/usr/bin/lxc-freeze -n $vmid";
1580     my $running = check_running($vmid);
1581     eval {
1582         if ($running) {
1583             PVE::Tools::run_command($cmd);
1584         };
1585
1586         my $storecfg = PVE::Storage::config();
1587         my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1588         my $volid = $rootinfo->{volume};
1589
1590         $cmd = "/usr/bin/lxc-unfreeze -n $vmid";
1591         if ($running) {
1592             PVE::Tools::run_command($cmd);
1593         };
1594
1595         PVE::Storage::volume_snapshot($storecfg, $volid, $snapname);
1596         &$snapshot_commit($vmid, $snapname);
1597     };
1598     if(my $err = $@) {
1599         snapshot_delete($vmid, $snapname, 1);
1600         die "$err\n";
1601     }
1602 }
1603
1604 sub snapshot_delete {
1605     my ($vmid, $snapname, $force) = @_;
1606
1607     my $snap;
1608
1609     my $conf;
1610
1611     my $updatefn =  sub {
1612
1613         $conf = load_config($vmid);
1614
1615         die "you can't delete a snapshot if vm is a template\n"
1616             if is_template($conf);
1617
1618         $snap = $conf->{snapshots}->{$snapname};
1619
1620         check_lock($conf);
1621
1622         die "snapshot '$snapname' does not exist\n" if !defined($snap);
1623
1624         $snap->{snapstate} = 'delete';
1625
1626         PVE::LXC::write_config($vmid, $conf);
1627     };
1628
1629     lock_container($vmid, 10, $updatefn);
1630
1631     my $storecfg = PVE::Storage::config();
1632
1633     my $del_snap =  sub {
1634
1635         check_lock($conf);
1636
1637         if ($conf->{parent} eq $snapname) {
1638             if ($conf->{snapshots}->{$snapname}->{snapname}) {
1639                 $conf->{parent} = $conf->{snapshots}->{$snapname}->{parent};
1640             } else {
1641                 delete $conf->{parent};
1642             }
1643         }
1644
1645         delete $conf->{snapshots}->{$snapname};
1646
1647         PVE::LXC::write_config($vmid, $conf);
1648     };
1649
1650     my $rootfs = $conf->{snapshots}->{$snapname}->{rootfs};
1651     my $rootinfo = PVE::LXC::parse_ct_mountpoint($rootfs);
1652     my $volid = $rootinfo->{volume};
1653
1654     eval {
1655         PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snapname);
1656     };
1657     my $err = $@;
1658
1659     if(!$err || ($err && $force)) {
1660         lock_container($vmid, 10, $del_snap);
1661         if ($err) {
1662             die "Can't delete snapshot: $vmid $snapname $err\n";
1663         }
1664     }
1665 }
1666
1667 sub snapshot_rollback {
1668     my ($vmid, $snapname) = @_;
1669
1670     my $storecfg = PVE::Storage::config();
1671
1672     my $conf = load_config($vmid);
1673
1674     die "you can't rollback if vm is a template\n" if is_template($conf);
1675
1676     my $snap = $conf->{snapshots}->{$snapname};
1677
1678     die "snapshot '$snapname' does not exist\n" if !defined($snap);
1679
1680     my $rootfs = $snap->{rootfs};
1681     my $rootinfo = PVE::LXC::parse_ct_mountpoint($rootfs);
1682     my $volid = $rootinfo->{volume};
1683
1684     PVE::Storage::volume_rollback_is_possible($storecfg, $volid, $snapname);
1685
1686     my $updatefn = sub {
1687
1688         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
1689             if $snap->{snapstate};
1690
1691         check_lock($conf);
1692
1693         system("lxc-stop -n $vmid --kill") if check_running($vmid);
1694
1695         die "unable to rollback vm $vmid: vm is running\n"
1696             if check_running($vmid);
1697
1698         $conf->{lock} = 'rollback';
1699
1700         my $forcemachine;
1701
1702         # copy snapshot config to current config
1703
1704         my $tmp_conf = $conf;
1705         &$snapshot_copy_config($tmp_conf->{snapshots}->{$snapname}, $conf);
1706         $conf->{snapshots} = $tmp_conf->{snapshots};
1707         delete $conf->{snaptime};
1708         delete $conf->{snapname};
1709         $conf->{parent} = $snapname;
1710
1711         PVE::LXC::write_config($vmid, $conf);
1712     };
1713
1714     my $unlockfn = sub {
1715         delete $conf->{lock};
1716         PVE::LXC::write_config($vmid, $conf);
1717     };
1718
1719     lock_container($vmid, 10, $updatefn);
1720
1721     PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
1722
1723     lock_container($vmid, 5, $unlockfn);
1724 }
1725
1726 sub template_create {
1727     my ($vmid, $conf) = @_;
1728
1729     my $storecfg = PVE::Storage::config();
1730
1731     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1732     my $volid = $rootinfo->{volume};
1733
1734     die "Template feature is not available for '$volid'\n"
1735         if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
1736
1737     PVE::Storage::activate_volumes($storecfg, [$volid]);
1738
1739     my $template_volid = PVE::Storage::vdisk_create_base($storecfg, $volid);
1740     $rootinfo->{volume} = $template_volid;
1741     $conf->{rootfs} = print_ct_mountpoint($rootinfo);
1742
1743     write_config($vmid, $conf);
1744 }
1745
1746 sub is_template {
1747     my ($conf) = @_;
1748
1749     return 1 if defined $conf->{template} && $conf->{template} == 1;
1750 }
1751
1752 sub foreach_mountpoint {
1753     my ($conf, $func) = @_;
1754
1755     my $mountpoint = parse_ct_mountpoint($conf->{rootfs});
1756     $mountpoint->{mp} = '/'; # just to be sure
1757     &$func('rootfs', $mountpoint);
1758
1759     for (my $i = 0; $i < $MAX_MOUNT_POINTS; $i++) {
1760         my $key = "mp$i";
1761         next if !defined($conf->{$key});
1762         $mountpoint = parse_ct_mountpoint($conf->{$key});
1763         &$func($key, $mountpoint);
1764     }
1765 }
1766
1767 sub loopdevices_list {
1768
1769     my $loopdev = {};
1770     my $parser = sub {
1771         my $line = shift;
1772         if ($line =~ m/^(\/dev\/loop\d+)\s+\d\s+\d\s+\d\s+\d\s(\S+)$/) {
1773             $loopdev->{$1} = $2;
1774         }
1775     };
1776
1777     PVE::Tools::run_command(['losetup'], outfunc => $parser);
1778
1779     return $loopdev;
1780 }
1781
1782 sub blockdevices_list {
1783
1784     my $bdevs = {};
1785     dir_glob_foreach("/sys/dev/block/", '(\d+):(\d+)', sub {
1786         my (undef, $major, $minor) = @_;
1787         my $bdev = readlink("/sys/dev/block/$major:$minor");
1788         $bdev =~ s/\.\.\/\.\.\/devices\/virtual\/block\//\/dev\//;
1789         $bdevs->{$bdev}->{major} = $major;
1790         $bdevs->{$bdev}->{minor} = $minor;
1791     });
1792     return $bdevs;
1793 }
1794
1795 sub find_loopdev {
1796     my ($loopdevs, $path) = @_;
1797
1798     foreach my $dev (keys %$loopdevs){
1799         return $dev if $loopdevs->{$dev} eq $path;
1800     }
1801 }
1802
1803 sub check_ct_modify_config_perm {
1804     my ($rpcenv, $authuser, $vmid, $pool, $key_list) = @_;
1805
1806     return 1 if $authuser ne 'root@pam';
1807
1808     foreach my $opt (@$key_list) {
1809
1810         if ($opt eq 'cpus' || $opt eq 'cpuunits' || $opt eq 'cpulimit') {
1811             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.CPU']);
1812         } elsif ($opt eq 'disk') {
1813             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Disk']);
1814         } elsif ($opt eq 'memory' || $opt eq 'swap') {
1815             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Memory']);
1816         } elsif ($opt =~ m/^net\d+$/ || $opt eq 'nameserver' ||
1817                  $opt eq 'searchdomain' || $opt eq 'hostname') {
1818             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Network']);
1819         } else {
1820             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Options']);
1821         }
1822     }
1823
1824     return 1;
1825 }
1826
1827
1828 sub volid_path {
1829     my ($volid, $storage_cfg, $loopdevs) = @_;
1830
1831     my $path;
1832
1833     my ($storage, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1834
1835     if ($storage) {
1836
1837         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1838         $path = PVE::Storage::path($storage_cfg, $volid);
1839
1840         my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1841             PVE::Storage::parse_volname($storage_cfg, $volid);
1842
1843         die "unable to use template as mountpoint\n" if $isBase;
1844
1845         if ($format eq 'subvol') {
1846             # do nothing
1847         } elsif ($format eq 'raw') {
1848
1849             if ($scfg->{path}) {
1850                 $path = PVE::LXC::find_loopdev($loopdevs, $path) if $loopdevs;
1851             } elsif ($scfg->{type} eq 'drbd' || $scfg->{type} eq 'rbd') {
1852                 # do nothing
1853             } else {
1854                 die "unsupported storage type '$scfg->{type}'\n";
1855             }
1856         } else {
1857             die "unsupported image format '$format'\n";
1858         }
1859     } elsif ($volid =~ m|^/dev/.+|) {
1860         $path = $volid;
1861     } elsif ($volid !~ m|^/dev/.+| && $volid =~ m|^/.+| && -d $volid) {
1862         $path = $volid;
1863     } else {
1864         die "unsupported storage";
1865     }
1866
1867     return $path;
1868 }
1869
1870 sub attach_loops {
1871     my ($storage_cfg, $vollist) = @_;
1872
1873     my $loopdevs = {};
1874
1875     foreach my $volid (@$vollist) {
1876
1877         my ($storage, $volname) = PVE::Storage::parse_volume_id($volid);
1878         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1879
1880         my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1881             PVE::Storage::parse_volname($storage_cfg, $volid);
1882
1883         if (($format ne 'subvol') &&
1884             ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs')) {
1885             my $path = PVE::Storage::path($storage_cfg, $volid);
1886             my $loopdev;
1887
1888             my $parser = sub {
1889                 my $line = shift;
1890                 $loopdev = $line if $line =~m|^/dev/loop\d+$|;
1891                 $loopdevs->{$loopdev} = $path;
1892             };
1893
1894             PVE::Tools::run_command(['losetup', '--find', '--show', $path], outfunc => $parser);
1895         }
1896     }
1897
1898     return $loopdevs;
1899 }
1900
1901 sub dettach_loops {
1902     my ($storage_cfg, $vollist) = @_;
1903
1904     my $loopdevs = loopdevices_list();
1905
1906     foreach my $volid (@$vollist) {
1907
1908         my ($storage, $volname) = PVE::Storage::parse_volume_id($volid);
1909         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1910
1911         my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1912             PVE::Storage::parse_volname($storage_cfg, $volid);
1913
1914         if($format ne 'subvol' && ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs')) {
1915             my $path = PVE::Storage::path($storage_cfg, $volid);
1916             foreach my $dev (keys %$loopdevs){
1917                 PVE::Tools::run_command(['losetup', '-d', $dev]) if $loopdevs->{$dev} eq $path;
1918             }
1919         }
1920     }
1921 }
1922
1923
1924 sub mountpoint_mount {
1925     my ($mountpoint, $rootdir, $storage_cfg, $loopdevs) = @_;
1926
1927     my $volid = $mountpoint->{volume};
1928     my $mount = $mountpoint->{mp};
1929
1930     return if !$volid || !$mount;
1931
1932     $rootdir =~ s!/+$!!;
1933     my $mount_path = "$rootdir/$mount";
1934     File::Path::mkpath($mount_path);
1935
1936     if ($volid =~ m|^/dev/.+|) {
1937         PVE::Tools::run_command(['mount', $volid, $mount_path]);
1938         return;
1939     }
1940
1941     my $path = PVE::LXC::volid_path($volid, $storage_cfg, $loopdevs);
1942
1943     if ($path !~ m|^/dev/.+|) {
1944         PVE::Tools::run_command(['mount', '-o', 'bind', $path, $mount_path]);
1945         return;
1946     }
1947
1948     PVE::Tools::run_command(['mount', $path, $mount_path]);
1949 }
1950
1951 sub get_vm_volumes {
1952     my ($conf, $excludes) = @_;
1953
1954     my $vollist = [];
1955
1956     PVE::LXC::foreach_mountpoint($conf, sub {
1957         my ($ms, $mountpoint) = @_;
1958
1959         return if $excludes && $ms eq $excludes;
1960
1961         my $volid = $mountpoint->{volume};
1962
1963         return if !$volid || $volid =~ m|^/|;
1964
1965         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1966         return if !$sid;
1967
1968         push @$vollist, $volid;
1969     });
1970
1971     return $vollist;
1972 }
1973
1974 1;