src/PVE/LXC.pm

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