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