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
1003     PVE::LXC::foreach_mountpoint($conf, sub {
1004         my ($ms, $mountpoint) = @_;
1005
1006         return if $ms ne 'rootfs';
1007         my $volid = $mountpoint->{volume};
1008         return if !$volid || $volid =~ m|^/dev/.+|;
1009
1010         my $path = volid_path ($volid, $storage_cfg);
1011
1012         my ($storage, $volname) = PVE::Storage::parse_volume_id($volid);
1013         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1014         $path = "loop:".$path if $scfg->{path};
1015
1016         $raw .= "lxc.rootfs = $path\n";
1017     });
1018
1019     my $netcount = 0;
1020     foreach my $k (keys %$conf) {
1021         next if $k !~ m/^net(\d+)$/;
1022         my $ind = $1;
1023         my $d = parse_lxc_network($conf->{$k});
1024         $netcount++;
1025         $raw .= "lxc.network.type = veth\n";
1026         $raw .= "lxc.network.veth.pair = veth${vmid}i${ind}\n";
1027         $raw .= "lxc.network.hwaddr = $d->{hwaddr}\n" if defined($d->{hwaddr});
1028         $raw .= "lxc.network.name = $d->{name}\n" if defined($d->{name});
1029         $raw .= "lxc.network.mtu = $d->{mtu}\n" if defined($d->{mtu});
1030     }
1031
1032     if (my $lxcconf = $conf->{lxc}) {
1033         foreach my $entry (@$lxcconf) {
1034             my ($k, $v) = @$entry;
1035             $netcount++ if $k eq 'lxc.network.type';
1036             $raw .= "$k = $v\n";
1037         }
1038     }
1039
1040     $raw .= "lxc.network.type = empty\n" if !$netcount;
1041
1042     File::Path::mkpath("$dir/rootfs");
1043
1044     PVE::Tools::file_set_contents("$dir/config", $raw);
1045 }
1046
1047 # verify and cleanup nameserver list (replace \0 with ' ')
1048 sub verify_nameserver_list {
1049     my ($nameserver_list) = @_;
1050
1051     my @list = ();
1052     foreach my $server (PVE::Tools::split_list($nameserver_list)) {
1053         PVE::JSONSchema::pve_verify_ip($server);
1054         push @list, $server;
1055     }
1056
1057     return join(' ', @list);
1058 }
1059
1060 sub verify_searchdomain_list {
1061     my ($searchdomain_list) = @_;
1062
1063     my @list = ();
1064     foreach my $server (PVE::Tools::split_list($searchdomain_list)) {
1065         # todo: should we add checks for valid dns domains?
1066         push @list, $server;
1067     }
1068
1069     return join(' ', @list);
1070 }
1071
1072 sub update_pct_config {
1073     my ($vmid, $conf, $running, $param, $delete) = @_;
1074
1075     my @nohotplug;
1076
1077     my $rootdir;
1078     if ($running) {
1079         my $pid = find_lxc_pid($vmid);
1080         $rootdir = "/proc/$pid/root";
1081     }
1082
1083     if (defined($delete)) {
1084         foreach my $opt (@$delete) {
1085             if ($opt eq 'hostname' || $opt eq 'memory' || $opt eq 'rootfs') {
1086                 die "unable to delete required option '$opt'\n";
1087             } elsif ($opt eq 'swap') {
1088                 delete $conf->{$opt};
1089                 write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", -1);
1090             } elsif ($opt eq 'description' || $opt eq 'onboot' || $opt eq 'startup') {
1091                 delete $conf->{$opt};
1092             } elsif ($opt eq 'nameserver' || $opt eq 'searchdomain' ||
1093                      $opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1094                 delete $conf->{$opt};
1095                 push @nohotplug, $opt;
1096                 next if $running;
1097             } elsif ($opt =~ m/^net(\d)$/) {
1098                 delete $conf->{$opt};
1099                 next if !$running;
1100                 my $netid = $1;
1101                 PVE::Network::veth_delete("veth${vmid}i$netid");
1102             } else {
1103                 die "implement me"
1104             }
1105             PVE::LXC::write_config($vmid, $conf) if $running;
1106         }
1107     }
1108
1109     # There's no separate swap size to configure, there's memory and "total"
1110     # memory (iow. memory+swap). This means we have to change them together.
1111     my $wanted_memory = PVE::Tools::extract_param($param, 'memory');
1112     my $wanted_swap =  PVE::Tools::extract_param($param, 'swap');
1113     if (defined($wanted_memory) || defined($wanted_swap)) {
1114
1115         $wanted_memory //= ($conf->{memory} || 512);
1116         $wanted_swap //=  ($conf->{swap} || 0);
1117
1118         my $total = $wanted_memory + $wanted_swap;
1119         if ($running) {
1120             write_cgroup_value("memory", $vmid, "memory.limit_in_bytes", int($wanted_memory*1024*1024));
1121             write_cgroup_value("memory", $vmid, "memory.memsw.limit_in_bytes", int($total*1024*1024));
1122         }
1123         $conf->{memory} = $wanted_memory;
1124         $conf->{swap} = $wanted_swap;
1125
1126         PVE::LXC::write_config($vmid, $conf) if $running;
1127     }
1128
1129     foreach my $opt (keys %$param) {
1130         my $value = $param->{$opt};
1131         if ($opt eq 'hostname') {
1132             $conf->{$opt} = $value;
1133         } elsif ($opt eq 'onboot') {
1134             $conf->{$opt} = $value ? 1 : 0;
1135         } elsif ($opt eq 'startup') {
1136             $conf->{$opt} = $value;
1137         } elsif ($opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1138             $conf->{$opt} = $value;
1139             push @nohotplug, $opt;
1140             next if $running;
1141         } elsif ($opt eq 'nameserver') {
1142             my $list = verify_nameserver_list($value);
1143             $conf->{$opt} = $list;
1144             push @nohotplug, $opt;
1145             next if $running;
1146         } elsif ($opt eq 'searchdomain') {
1147             my $list = verify_searchdomain_list($value);
1148             $conf->{$opt} = $list;
1149             push @nohotplug, $opt;
1150             next if $running;
1151         } elsif ($opt eq 'cpulimit') {
1152             $conf->{$opt} = $value;
1153             push @nohotplug, $opt; # fixme: hotplug
1154             next;
1155         } elsif ($opt eq 'cpuunits') {
1156             $conf->{$opt} = $value;
1157             write_cgroup_value("cpu", $vmid, "cpu.shares", $value);
1158         } elsif ($opt eq 'description') {
1159             $conf->{$opt} = PVE::Tools::encode_text($value);
1160         } elsif ($opt =~ m/^net(\d+)$/) {
1161             my $netid = $1;
1162             my $net = parse_lxc_network($value);
1163             if (!$running) {
1164                 $conf->{$opt} = print_lxc_network($net);
1165             } else {
1166                 update_net($vmid, $conf, $opt, $net, $netid, $rootdir);
1167             }
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 = [];
1266             my $loopdevlist = [];
1267
1268             PVE::LXC::foreach_mountpoint($conf, sub {
1269                 my ($ms, $mountpoint) = @_;
1270
1271                 my $volid = $mountpoint->{volume};
1272                 return if !$volid || $volid =~ m|^/dev/.+|;
1273                 push @$vollist, $volid;
1274                 push @$loopdevlist, $volid if $ms ne 'rootfs';
1275             });
1276
1277             PVE::LXC::dettach_loops($storage_cfg, $loopdevlist);
1278             PVE::Storage::deactivate_volumes($storage_cfg, $vollist);
1279         }
1280     };
1281     warn $@ if $@; # avoid errors - just warn
1282 }
1283
1284 my $safe_num_ne = sub {
1285     my ($a, $b) = @_;
1286
1287     return 0 if !defined($a) && !defined($b);
1288     return 1 if !defined($a);
1289     return 1 if !defined($b);
1290
1291     return $a != $b;
1292 };
1293
1294 my $safe_string_ne = sub {
1295     my ($a, $b) = @_;
1296
1297     return 0 if !defined($a) && !defined($b);
1298     return 1 if !defined($a);
1299     return 1 if !defined($b);
1300
1301     return $a ne $b;
1302 };
1303
1304 sub update_net {
1305     my ($vmid, $conf, $opt, $newnet, $netid, $rootdir) = @_;
1306
1307     if ($newnet->{type} ne 'veth') {
1308         # for when there are physical interfaces
1309         die "cannot update interface of type $newnet->{type}";
1310     }
1311
1312     my $veth = "veth${vmid}i${netid}";
1313     my $eth = $newnet->{name};
1314
1315     if (my $oldnetcfg = $conf->{$opt}) {
1316         my $oldnet = parse_lxc_network($oldnetcfg);
1317
1318         if (&$safe_string_ne($oldnet->{hwaddr}, $newnet->{hwaddr}) ||
1319             &$safe_string_ne($oldnet->{name}, $newnet->{name})) {
1320
1321             PVE::Network::veth_delete($veth);
1322             delete $conf->{$opt};
1323             PVE::LXC::write_config($vmid, $conf);
1324
1325             hotplug_net($vmid, $conf, $opt, $newnet, $netid);
1326
1327         } elsif (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
1328                  &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
1329                  &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
1330
1331                 if ($oldnet->{bridge}) {
1332                     PVE::Network::tap_unplug($veth);
1333                     foreach (qw(bridge tag firewall)) {
1334                         delete $oldnet->{$_};
1335                     }
1336                     $conf->{$opt} = print_lxc_network($oldnet);
1337                     PVE::LXC::write_config($vmid, $conf);
1338                 }
1339
1340                 PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1341                 foreach (qw(bridge tag firewall)) {
1342                     $oldnet->{$_} = $newnet->{$_} if $newnet->{$_};
1343                 }
1344                 $conf->{$opt} = print_lxc_network($oldnet);
1345                 PVE::LXC::write_config($vmid, $conf);
1346         }
1347     } else {
1348         hotplug_net($vmid, $conf, $opt, $newnet, $netid);
1349     }
1350
1351     update_ipconfig($vmid, $conf, $opt, $eth, $newnet, $rootdir);
1352 }
1353
1354 sub hotplug_net {
1355     my ($vmid, $conf, $opt, $newnet, $netid) = @_;
1356
1357     my $veth = "veth${vmid}i${netid}";
1358     my $vethpeer = $veth . "p";
1359     my $eth = $newnet->{name};
1360
1361     PVE::Network::veth_create($veth, $vethpeer, $newnet->{bridge}, $newnet->{hwaddr});
1362     PVE::Network::tap_plug($veth, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
1363
1364     # attach peer in container
1365     my $cmd = ['lxc-device', '-n', $vmid, 'add', $vethpeer, "$eth" ];
1366     PVE::Tools::run_command($cmd);
1367
1368     # link up peer in container
1369     $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', 'link', 'set', $eth ,'up'  ];
1370     PVE::Tools::run_command($cmd);
1371
1372     my $done = { type => 'veth' };
1373     foreach (qw(bridge tag firewall hwaddr name)) {
1374         $done->{$_} = $newnet->{$_} if $newnet->{$_};
1375     }
1376     $conf->{$opt} = print_lxc_network($done);
1377
1378     PVE::LXC::write_config($vmid, $conf);
1379 }
1380
1381 sub update_ipconfig {
1382     my ($vmid, $conf, $opt, $eth, $newnet, $rootdir) = @_;
1383
1384     my $lxc_setup = PVE::LXCSetup->new($conf, $rootdir);
1385
1386     my $optdata = parse_lxc_network($conf->{$opt});
1387     my $deleted = [];
1388     my $added = [];
1389     my $nscmd = sub {
1390         my $cmdargs = shift;
1391         PVE::Tools::run_command(['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', @_], %$cmdargs);
1392     };
1393     my $ipcmd = sub { &$nscmd({}, '/sbin/ip', @_) };
1394
1395     my $change_ip_config = sub {
1396         my ($ipversion) = @_;
1397
1398         my $family_opt = "-$ipversion";
1399         my $suffix = $ipversion == 4 ? '' : $ipversion;
1400         my $gw= "gw$suffix";
1401         my $ip= "ip$suffix";
1402
1403         my $newip = $newnet->{$ip};
1404         my $newgw = $newnet->{$gw};
1405         my $oldip = $optdata->{$ip};
1406
1407         my $change_ip = &$safe_string_ne($oldip, $newip);
1408         my $change_gw = &$safe_string_ne($optdata->{$gw}, $newgw);
1409
1410         return if !$change_ip && !$change_gw;
1411
1412         # step 1: add new IP, if this fails we cancel
1413         if ($change_ip && $newip && $newip !~ /^(?:auto|dhcp)$/) {
1414             eval { &$ipcmd($family_opt, 'addr', 'add', $newip, 'dev', $eth); };
1415             if (my $err = $@) {
1416                 warn $err;
1417                 return;
1418             }
1419         }
1420
1421         # step 2: replace gateway
1422         #   If this fails we delete the added IP and cancel.
1423         #   If it succeeds we save the config and delete the old IP, ignoring
1424         #   errors. The config is then saved.
1425         # Note: 'ip route replace' can add
1426         if ($change_gw) {
1427             if ($newgw) {
1428                 eval { &$ipcmd($family_opt, 'route', 'replace', 'default', 'via', $newgw); };
1429                 if (my $err = $@) {
1430                     warn $err;
1431                     # the route was not replaced, the old IP is still available
1432                     # rollback (delete new IP) and cancel
1433                     if ($change_ip) {
1434                         eval { &$ipcmd($family_opt, 'addr', 'del', $newip, 'dev', $eth); };
1435                         warn $@ if $@; # no need to die here
1436                     }
1437                     return;
1438                 }
1439             } else {
1440                 eval { &$ipcmd($family_opt, 'route', 'del', 'default'); };
1441                 # if the route was not deleted, the guest might have deleted it manually
1442                 # warn and continue
1443                 warn $@ if $@;
1444             }
1445         }
1446
1447         # from this point on we save the configuration
1448         # step 3: delete old IP ignoring errors
1449         if ($change_ip && $oldip && $oldip !~ /^(?:auto|dhcp)$/) {
1450             # We need to enable promote_secondaries, otherwise our newly added
1451             # address will be removed along with the old one.
1452             my $promote = 0;
1453             eval {
1454                 if ($ipversion == 4) {
1455                     &$nscmd({ outfunc => sub { $promote = int(shift) } },
1456                             'cat', "/proc/sys/net/ipv4/conf/$eth/promote_secondaries");
1457                     &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=1");
1458                 }
1459                 &$ipcmd($family_opt, 'addr', 'del', $oldip, 'dev', $eth);
1460             };
1461             warn $@ if $@; # no need to die here
1462
1463             if ($ipversion == 4) {
1464                 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=$promote");
1465             }
1466         }
1467
1468         foreach my $property ($ip, $gw) {
1469             if ($newnet->{$property}) {
1470                 $optdata->{$property} = $newnet->{$property};
1471             } else {
1472                 delete $optdata->{$property};
1473             }
1474         }
1475         $conf->{$opt} = print_lxc_network($optdata);
1476         PVE::LXC::write_config($vmid, $conf);
1477         $lxc_setup->setup_network($conf);
1478     };
1479
1480     &$change_ip_config(4);
1481     &$change_ip_config(6);
1482
1483 }
1484
1485 # Internal snapshots
1486
1487 # NOTE: Snapshot create/delete involves several non-atomic
1488 # action, and can take a long time.
1489 # So we try to avoid locking the file and use 'lock' variable
1490 # inside the config file instead.
1491
1492 my $snapshot_copy_config = sub {
1493     my ($source, $dest) = @_;
1494
1495     foreach my $k (keys %$source) {
1496         next if $k eq 'snapshots';
1497         next if $k eq 'snapstate';
1498         next if $k eq 'snaptime';
1499         next if $k eq 'vmstate';
1500         next if $k eq 'lock';
1501         next if $k eq 'digest';
1502         next if $k eq 'description';
1503
1504         $dest->{$k} = $source->{$k};
1505     }
1506 };
1507
1508 my $snapshot_prepare = sub {
1509     my ($vmid, $snapname, $comment) = @_;
1510
1511     my $snap;
1512
1513     my $updatefn =  sub {
1514
1515         my $conf = load_config($vmid);
1516
1517         die "you can't take a snapshot if it's a template\n"
1518             if is_template($conf);
1519
1520         check_lock($conf);
1521
1522         $conf->{lock} = 'snapshot';
1523
1524         die "snapshot name '$snapname' already used\n"
1525             if defined($conf->{snapshots}->{$snapname});
1526
1527         my $storecfg = PVE::Storage::config();
1528         die "snapshot feature is not available\n" if !has_feature('snapshot', $conf, $storecfg);
1529
1530         $snap = $conf->{snapshots}->{$snapname} = {};
1531
1532         &$snapshot_copy_config($conf, $snap);
1533
1534         $snap->{'snapstate'} = "prepare";
1535         $snap->{'snaptime'} = time();
1536         $snap->{'description'} = $comment if $comment;
1537         $conf->{snapshots}->{$snapname} = $snap;
1538
1539         PVE::LXC::write_config($vmid, $conf);
1540     };
1541
1542     lock_container($vmid, 10, $updatefn);
1543
1544     return $snap;
1545 };
1546
1547 my $snapshot_commit = sub {
1548     my ($vmid, $snapname) = @_;
1549
1550     my $updatefn = sub {
1551
1552         my $conf = load_config($vmid);
1553
1554         die "missing snapshot lock\n"
1555             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
1556
1557         die "snapshot '$snapname' does not exist\n"
1558             if !defined($conf->{snapshots}->{$snapname});
1559
1560         die "wrong snapshot state\n"
1561             if !($conf->{snapshots}->{$snapname}->{'snapstate'} &&
1562                  $conf->{snapshots}->{$snapname}->{'snapstate'} eq "prepare");
1563
1564         delete $conf->{snapshots}->{$snapname}->{'snapstate'};
1565         delete $conf->{lock};
1566         $conf->{parent} = $snapname;
1567
1568         PVE::LXC::write_config($vmid, $conf);
1569     };
1570
1571     lock_container($vmid, 10 ,$updatefn);
1572 };
1573
1574 sub has_feature {
1575     my ($feature, $conf, $storecfg, $snapname) = @_;
1576
1577     #Fixme add other drives if necessary.
1578     my $err;
1579
1580     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1581     $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $rootinfo->{volume}, $snapname);
1582
1583     return $err ? 0 : 1;
1584 }
1585
1586 sub snapshot_create {
1587     my ($vmid, $snapname, $comment) = @_;
1588
1589     my $snap = &$snapshot_prepare($vmid, $snapname, $comment);
1590
1591     my $conf = load_config($vmid);
1592
1593     my $cmd = "/usr/bin/lxc-freeze -n $vmid";
1594     my $running = check_running($vmid);
1595     eval {
1596         if ($running) {
1597             PVE::Tools::run_command($cmd);
1598         };
1599
1600         my $storecfg = PVE::Storage::config();
1601         my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1602         my $volid = $rootinfo->{volume};
1603
1604         $cmd = "/usr/bin/lxc-unfreeze -n $vmid";
1605         if ($running) {
1606             PVE::Tools::run_command($cmd);
1607         };
1608
1609         PVE::Storage::volume_snapshot($storecfg, $volid, $snapname);
1610         &$snapshot_commit($vmid, $snapname);
1611     };
1612     if(my $err = $@) {
1613         snapshot_delete($vmid, $snapname, 1);
1614         die "$err\n";
1615     }
1616 }
1617
1618 sub snapshot_delete {
1619     my ($vmid, $snapname, $force) = @_;
1620
1621     my $snap;
1622
1623     my $conf;
1624
1625     my $updatefn =  sub {
1626
1627         $conf = load_config($vmid);
1628
1629         die "you can't delete a snapshot if vm is a template\n"
1630             if is_template($conf);
1631
1632         $snap = $conf->{snapshots}->{$snapname};
1633
1634         check_lock($conf);
1635
1636         die "snapshot '$snapname' does not exist\n" if !defined($snap);
1637
1638         $snap->{snapstate} = 'delete';
1639
1640         PVE::LXC::write_config($vmid, $conf);
1641     };
1642
1643     lock_container($vmid, 10, $updatefn);
1644
1645     my $storecfg = PVE::Storage::config();
1646
1647     my $del_snap =  sub {
1648
1649         check_lock($conf);
1650
1651         if ($conf->{parent} eq $snapname) {
1652             if ($conf->{snapshots}->{$snapname}->{snapname}) {
1653                 $conf->{parent} = $conf->{snapshots}->{$snapname}->{parent};
1654             } else {
1655                 delete $conf->{parent};
1656             }
1657         }
1658
1659         delete $conf->{snapshots}->{$snapname};
1660
1661         PVE::LXC::write_config($vmid, $conf);
1662     };
1663
1664     my $rootfs = $conf->{snapshots}->{$snapname}->{rootfs};
1665     my $rootinfo = PVE::LXC::parse_ct_mountpoint($rootfs);
1666     my $volid = $rootinfo->{volume};
1667
1668     eval {
1669         PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snapname);
1670     };
1671     my $err = $@;
1672
1673     if(!$err || ($err && $force)) {
1674         lock_container($vmid, 10, $del_snap);
1675         if ($err) {
1676             die "Can't delete snapshot: $vmid $snapname $err\n";
1677         }
1678     }
1679 }
1680
1681 sub snapshot_rollback {
1682     my ($vmid, $snapname) = @_;
1683
1684     my $storecfg = PVE::Storage::config();
1685
1686     my $conf = load_config($vmid);
1687
1688     die "you can't rollback if vm is a template\n" if is_template($conf);
1689
1690     my $snap = $conf->{snapshots}->{$snapname};
1691
1692     die "snapshot '$snapname' does not exist\n" if !defined($snap);
1693
1694     my $rootfs = $snap->{rootfs};
1695     my $rootinfo = PVE::LXC::parse_ct_mountpoint($rootfs);
1696     my $volid = $rootinfo->{volume};
1697
1698     PVE::Storage::volume_rollback_is_possible($storecfg, $volid, $snapname);
1699
1700     my $updatefn = sub {
1701
1702         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
1703             if $snap->{snapstate};
1704
1705         check_lock($conf);
1706
1707         system("lxc-stop -n $vmid --kill") if check_running($vmid);
1708
1709         die "unable to rollback vm $vmid: vm is running\n"
1710             if check_running($vmid);
1711
1712         $conf->{lock} = 'rollback';
1713
1714         my $forcemachine;
1715
1716         # copy snapshot config to current config
1717
1718         my $tmp_conf = $conf;
1719         &$snapshot_copy_config($tmp_conf->{snapshots}->{$snapname}, $conf);
1720         $conf->{snapshots} = $tmp_conf->{snapshots};
1721         delete $conf->{snaptime};
1722         delete $conf->{snapname};
1723         $conf->{parent} = $snapname;
1724
1725         PVE::LXC::write_config($vmid, $conf);
1726     };
1727
1728     my $unlockfn = sub {
1729         delete $conf->{lock};
1730         PVE::LXC::write_config($vmid, $conf);
1731     };
1732
1733     lock_container($vmid, 10, $updatefn);
1734
1735     PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
1736
1737     lock_container($vmid, 5, $unlockfn);
1738 }
1739
1740 sub template_create {
1741     my ($vmid, $conf) = @_;
1742
1743     my $storecfg = PVE::Storage::config();
1744
1745     my $rootinfo = PVE::LXC::parse_ct_mountpoint($conf->{rootfs});
1746     my $volid = $rootinfo->{volume};
1747
1748     die "Template feature is not available for '$volid'\n"
1749         if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
1750
1751     PVE::Storage::activate_volumes($storecfg, [$volid]);
1752
1753     my $template_volid = PVE::Storage::vdisk_create_base($storecfg, $volid);
1754     $rootinfo->{volume} = $template_volid;
1755     $conf->{rootfs} = print_ct_mountpoint($rootinfo);
1756
1757     write_config($vmid, $conf);
1758 }
1759
1760 sub is_template {
1761     my ($conf) = @_;
1762
1763     return 1 if defined $conf->{template} && $conf->{template} == 1;
1764 }
1765
1766 sub foreach_mountpoint {
1767     my ($conf, $func) = @_;
1768
1769     my $mountpoint = parse_ct_mountpoint($conf->{rootfs});
1770     $mountpoint->{mp} = '/'; # just to be sure
1771     &$func('rootfs', $mountpoint);
1772
1773     for (my $i = 0; $i < $MAX_MOUNT_POINTS; $i++) {
1774         my $key = "mp$i";
1775         next if !defined($conf->{$key});
1776         $mountpoint = parse_ct_mountpoint($conf->{$key});
1777         &$func($key, $mountpoint);
1778     }
1779 }
1780
1781 sub loopdevices_list {
1782
1783     my $loopdev = {};
1784     my $parser = sub {
1785         my $line = shift;
1786         if ($line =~ m/^(\/dev\/loop\d+)\s+\d\s+\d\s+\d\s+\d\s(\S+)$/) {
1787             $loopdev->{$1} = $2;
1788         }
1789     };
1790
1791     PVE::Tools::run_command(['losetup'], outfunc => $parser);
1792
1793     return $loopdev;
1794 }
1795
1796 sub blockdevices_list {
1797
1798     my $bdevs = {};
1799     dir_glob_foreach("/sys/dev/block/", '(\d+):(\d+)', sub {
1800         my (undef, $major, $minor) = @_;
1801         my $bdev = readlink("/sys/dev/block/$major:$minor");
1802         $bdev =~ s/\.\.\/\.\.\/devices\/virtual\/block\//\/dev\//;
1803         $bdevs->{$bdev}->{major} = $major;
1804         $bdevs->{$bdev}->{minor} = $minor;
1805     });
1806     return $bdevs;
1807 }
1808
1809 sub find_loopdev {
1810     my ($loopdevs, $path) = @_;
1811
1812     foreach my $dev (keys %$loopdevs){
1813         return $dev if $loopdevs->{$dev} eq $path;
1814     }
1815 }
1816
1817 sub check_ct_modify_config_perm {
1818     my ($rpcenv, $authuser, $vmid, $pool, $key_list) = @_;
1819
1820     return 1 if $authuser ne 'root@pam';
1821
1822     foreach my $opt (@$key_list) {
1823
1824         if ($opt eq 'cpus' || $opt eq 'cpuunits' || $opt eq 'cpulimit') {
1825             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.CPU']);
1826         } elsif ($opt eq 'disk') {
1827             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Disk']);
1828         } elsif ($opt eq 'memory' || $opt eq 'swap') {
1829             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Memory']);
1830         } elsif ($opt =~ m/^net\d+$/ || $opt eq 'nameserver' ||
1831                  $opt eq 'searchdomain' || $opt eq 'hostname') {
1832             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Network']);
1833         } else {
1834             $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Options']);
1835         }
1836     }
1837
1838     return 1;
1839 }
1840
1841
1842 sub volid_path {
1843     my ($volid, $storage_cfg, $loopdevs) = @_;
1844
1845         my ($storage, $volname) = PVE::Storage::parse_volume_id($volid);
1846         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1847         my $path = PVE::Storage::path($storage_cfg, $volid);
1848
1849         my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1850             PVE::Storage::parse_volname($storage_cfg, $volid);
1851
1852         die "unable to use template as mountpoint\n" if $isBase;
1853
1854         if ($format eq 'subvol') {
1855             #do nothing
1856         } elsif ($format eq 'raw') {
1857
1858             if ($scfg->{path}) {
1859                 $path = PVE::LXC::find_loopdev($loopdevs, $path) if $loopdevs;
1860             } elsif ($scfg->{type} eq 'drbd' || $scfg->{type} eq 'rbd') {
1861                 #do nothing
1862             } else {
1863                 die "unsupported storage type '$scfg->{type}'\n";
1864             }
1865         } else {
1866             die "unsupported image format '$format'\n";
1867         }
1868
1869         return $path;
1870
1871 }
1872
1873 sub attach_loops {
1874     my ($storage_cfg, $vollist) = @_;
1875
1876     my $loopdevs = {};
1877
1878     foreach my $volid (@$vollist) {
1879
1880         my ($storage, $volname) = PVE::Storage::parse_volume_id($volid);
1881         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1882
1883         my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1884             PVE::Storage::parse_volname($storage_cfg, $volid);
1885
1886         if($format ne 'subvol' && ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs')) {
1887             my $path = PVE::Storage::path($storage_cfg, $volid);
1888             my $loopdev;
1889
1890             my $parser = sub {
1891                 my $line = shift;
1892                 $loopdev = $line if $line =~m|^/dev/loop\d+$|;
1893                 $loopdevs->{$loopdev} = $path;
1894             };
1895
1896             PVE::Tools::run_command(['losetup', '--find', '--show', $path], outfunc => $parser);
1897         }
1898     }
1899     return $loopdevs;
1900 }
1901
1902 sub dettach_loops {
1903     my ($storage_cfg, $vollist) = @_;
1904
1905     my $loopdevs = loopdevices_list();
1906
1907     foreach my $volid (@$vollist) {
1908
1909         my ($storage, $volname) = PVE::Storage::parse_volume_id($volid);
1910         my $scfg = PVE::Storage::storage_config($storage_cfg, $storage);
1911
1912         my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1913             PVE::Storage::parse_volname($storage_cfg, $volid);
1914
1915         if($format ne 'subvol' && ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs')) {
1916             my $path = PVE::Storage::path($storage_cfg, $volid);
1917             foreach my $dev (keys %$loopdevs){
1918                 PVE::Tools::run_command(['losetup', '-d', $dev]) if $loopdevs->{$dev} eq $path;
1919             }
1920         }
1921     }
1922 }
1923
1924
1925 sub mountpoint_mount {
1926     my ($mountpoint, $rootdir, $storage_cfg, $loopdevs) = @_;
1927
1928     my $volid = $mountpoint->{volume};
1929     my $mount = $mountpoint->{mp};
1930
1931     return if !$volid || !$mount;
1932
1933     eval {
1934         my $mount_path = $rootdir.$mount;
1935         File::Path::mkpath($mount_path);
1936
1937         if ($volid =~ m|^/dev/.+|) {
1938             PVE::Tools::run_command(['mount', $volid, $mount_path]);
1939             return;
1940         }
1941
1942         my $path = PVE::LXC::volid_path($volid, $storage_cfg, $loopdevs);
1943
1944         if ($path !~ m|^/dev/.+|) {
1945             PVE::Tools::run_command(['mount', '-o', 'bind', $path, $mount_path]);
1946             return;
1947         }
1948
1949         PVE::Tools::run_command(['mount', $path, $mount_path]);
1950     };
1951     warn $@ if $@;
1952 }
1953
1954 1;