12 use PVE
::Cluster
qw(cfs_register_file cfs_read_file);
16 use PVE
::JSONSchema
qw(get_standard_option);
17 use PVE
::Tools
qw($IPV6RE $IPV4RE dir_glob_foreach);
19 use PVE
::AccessControl
;
24 my $nodename = PVE
::INotify
::nodename
();
26 cfs_register_file
('/lxc/', \
&parse_pct_config
, \
&write_pct_config
);
28 PVE
::JSONSchema
::register_format
('pve-lxc-network', \
&verify_lxc_network
);
29 sub verify_lxc_network
{
30 my ($value, $noerr) = @_;
32 return $value if parse_lxc_network
($value);
34 return undef if $noerr;
36 die "unable to parse network setting\n";
39 PVE
::JSONSchema
::register_format
('pve-ct-mountpoint', \
&verify_ct_mountpoint
);
40 sub verify_ct_mountpoint
{
41 my ($value, $noerr) = @_;
43 return $value if parse_ct_mountpoint
($value);
45 return undef if $noerr;
47 die "unable to parse CT mountpoint options\n";
50 PVE
::JSONSchema
::register_standard_option
('pve-ct-rootfs', {
51 type
=> 'string', format
=> 'pve-ct-mountpoint',
52 typetext
=> '[volume=]volume,] [,backup=yes|no] [,size=\d+]',
53 description
=> "Use volume as container root.",
57 PVE
::JSONSchema
::register_standard_option
('pve-lxc-snapshot-name', {
58 description
=> "The name of the snapshot.",
59 type
=> 'string', format
=> 'pve-configid',
67 description
=> "Lock/unlock the VM.",
68 enum
=> [qw(migrate backup snapshot rollback)],
73 description
=> "Specifies whether a VM will be started during system bootup.",
76 startup
=> get_standard_option
('pve-startup-order'),
80 description
=> "Enable/disable Template.",
86 enum
=> ['amd64', 'i386'],
87 description
=> "OS architecture type.",
93 enum
=> ['debian', 'ubuntu', 'centos', 'archlinux'],
94 description
=> "OS type. Corresponds to lxc setup scripts in /usr/share/lxc/config/<ostype>.common.conf.",
99 description
=> "Attach a console device (/dev/console) to the container.",
105 description
=> "Specify the number of tty available to the container",
113 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.",
121 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.",
129 description
=> "Amount of RAM for the VM in MB.",
136 description
=> "Amount of SWAP for the VM in MB.",
142 description
=> "Set a host name for the container.",
143 type
=> 'string', format
=> 'dns-name',
149 description
=> "Container description. Only used on the configuration web interface.",
153 type
=> 'string', format
=> 'dns-name-list',
154 description
=> "Sets DNS search domains for a container. Create will automatically use the setting from the host if you neither set searchdomain or nameserver.",
158 type
=> 'string', format
=> 'address-list',
159 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.",
161 rootfs
=> get_standard_option
('pve-ct-rootfs'),
164 type
=> 'string', format
=> 'pve-configid',
166 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
170 description
=> "Timestamp for snapshots.",
176 description
=> "Console mode. By default, the console command tries to open a connection to one of the available tty devices. By setting cmode to 'console' it tries to attach to /dev/console instead. If you set cmode to 'shell', it simply invokes a shell inside the container (no login).",
178 enum
=> ['shell', 'console', 'tty'],
184 description
=> "Sets the protection flag of the container. This will prevent the remove operation.",
189 my $valid_lxc_conf_keys = {
193 'lxc.haltsignal' => 1,
194 'lxc.rebootsignal' => 1,
195 'lxc.stopsignal' => 1,
197 'lxc.network.type' => 1,
198 'lxc.network.flags' => 1,
199 'lxc.network.link' => 1,
200 'lxc.network.mtu' => 1,
201 'lxc.network.name' => 1,
202 'lxc.network.hwaddr' => 1,
203 'lxc.network.ipv4' => 1,
204 'lxc.network.ipv4.gateway' => 1,
205 'lxc.network.ipv6' => 1,
206 'lxc.network.ipv6.gateway' => 1,
207 'lxc.network.script.up' => 1,
208 'lxc.network.script.down' => 1,
210 'lxc.console.logfile' => 1,
213 'lxc.devttydir' => 1,
214 'lxc.hook.autodev' => 1,
218 'lxc.mount.entry' => 1,
219 'lxc.mount.auto' => 1,
221 'lxc.rootfs.mount' => 1,
222 'lxc.rootfs.options' => 1,
226 'lxc.aa_profile' => 1,
227 'lxc.aa_allow_incomplete' => 1,
228 'lxc.se_context' => 1,
231 'lxc.hook.pre-start' => 1,
232 'lxc.hook.pre-mount' => 1,
233 'lxc.hook.mount' => 1,
234 'lxc.hook.start' => 1,
235 'lxc.hook.post-stop' => 1,
236 'lxc.hook.clone' => 1,
237 'lxc.hook.destroy' => 1,
240 'lxc.start.auto' => 1,
241 'lxc.start.delay' => 1,
242 'lxc.start.order' => 1,
244 'lxc.environment' => 1,
251 my $MAX_LXC_NETWORKS = 10;
252 for (my $i = 0; $i < $MAX_LXC_NETWORKS; $i++) {
253 $confdesc->{"net$i"} = {
255 type
=> 'string', format
=> 'pve-lxc-network',
256 description
=> "Specifies network interfaces for the container.\n\n".
257 "The string should have the follow format:\n\n".
258 "-net<[0-9]> bridge=<vmbr<Nummber>>[,hwaddr=<MAC>]\n".
259 "[,mtu=<Number>][,name=<String>][,ip=<IPv4Format/CIDR>]\n".
260 ",ip6=<IPv6Format/CIDR>][,gw=<GatwayIPv4>]\n".
261 ",gw6=<GatwayIPv6>][,firewall=<[1|0]>][,tag=<VlanNo>]",
265 my $MAX_MOUNT_POINTS = 10;
266 for (my $i = 0; $i < $MAX_MOUNT_POINTS; $i++) {
267 $confdesc->{"mp$i"} = {
269 type
=> 'string', format
=> 'pve-ct-mountpoint',
270 typetext
=> '[volume=]volume,] [,backup=yes|no] [,size=\d+] [,mp=mountpoint]',
271 description
=> "Use volume as container mount point (experimental feature).",
276 sub write_pct_config
{
277 my ($filename, $conf) = @_;
279 delete $conf->{snapstate
}; # just to be sure
281 my $generate_raw_config = sub {
286 # add description as comment to top of file
287 my $descr = $conf->{description
} || '';
288 foreach my $cl (split(/\n/, $descr)) {
289 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
292 foreach my $key (sort keys %$conf) {
293 next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' ||
294 $key eq 'snapshots' || $key eq 'snapname' || $key eq 'lxc';
295 my $value = $conf->{$key};
296 die "detected invalid newline inside property '$key'\n" if $value =~ m/\n/;
297 $raw .= "$key: $value\n";
300 if (my $lxcconf = $conf->{lxc
}) {
301 foreach my $entry (@$lxcconf) {
302 my ($k, $v) = @$entry;
310 my $raw = &$generate_raw_config($conf);
312 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
313 $raw .= "\n[$snapname]\n";
314 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
321 my ($key, $value) = @_;
323 die "unknown setting '$key'\n" if !$confdesc->{$key};
325 my $type = $confdesc->{$key}->{type
};
327 if (!defined($value)) {
328 die "got undefined value\n";
331 if ($value =~ m/[\n\r]/) {
332 die "property contains a line feed\n";
335 if ($type eq 'boolean') {
336 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
337 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
338 die "type check ('boolean') failed - got '$value'\n";
339 } elsif ($type eq 'integer') {
340 return int($1) if $value =~ m/^(\d+)$/;
341 die "type check ('integer') failed - got '$value'\n";
342 } elsif ($type eq 'number') {
343 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
344 die "type check ('number') failed - got '$value'\n";
345 } elsif ($type eq 'string') {
346 if (my $fmt = $confdesc->{$key}->{format
}) {
347 PVE
::JSONSchema
::check_format
($fmt, $value);
356 sub parse_pct_config
{
357 my ($filename, $raw) = @_;
359 return undef if !defined($raw);
362 digest
=> Digest
::SHA
::sha1_hex
($raw),
366 $filename =~ m
|/lxc/(\d
+).conf
$|
367 || die "got strange filename '$filename'";
375 my @lines = split(/\n/, $raw);
376 foreach my $line (@lines) {
377 next if $line =~ m/^\s*$/;
379 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
381 $conf->{description
} = $descr if $descr;
383 $conf = $res->{snapshots
}->{$section} = {};
387 if ($line =~ m/^\#(.*)\s*$/) {
388 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
392 if ($line =~ m/^(lxc\.[a-z0-9_\-\.]+)(:|\s*=)\s*(.*?)\s*$/) {
395 if ($valid_lxc_conf_keys->{$key} || $key =~ m/^lxc\.cgroup\./) {
396 push @{$conf->{lxc
}}, [$key, $value];
398 warn "vm $vmid - unable to parse config: $line\n";
400 } elsif ($line =~ m/^(description):\s*(.*\S)\s*$/) {
401 $descr .= PVE
::Tools
::decode_text
($2);
402 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
403 $conf->{snapstate
} = $1;
404 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S.*)\s*$/) {
407 eval { $value = check_type
($key, $value); };
408 warn "vm $vmid - unable to parse value of '$key' - $@" if $@;
409 $conf->{$key} = $value;
411 warn "vm $vmid - unable to parse config: $line\n";
415 $conf->{description
} = $descr if $descr;
417 delete $res->{snapstate
}; # just to be sure
423 my $vmlist = PVE
::Cluster
::get_vmlist
();
425 return $res if !$vmlist || !$vmlist->{ids
};
426 my $ids = $vmlist->{ids
};
428 foreach my $vmid (keys %$ids) {
429 next if !$vmid; # skip CT0
430 my $d = $ids->{$vmid};
431 next if !$d->{node
} || $d->{node
} ne $nodename;
432 next if !$d->{type
} || $d->{type
} ne 'lxc';
433 $res->{$vmid}->{type
} = 'lxc';
438 sub cfs_config_path
{
439 my ($vmid, $node) = @_;
441 $node = $nodename if !$node;
442 return "nodes/$node/lxc/$vmid.conf";
446 my ($vmid, $node) = @_;
448 my $cfspath = cfs_config_path
($vmid, $node);
449 return "/etc/pve/$cfspath";
453 my ($vmid, $node) = @_;
455 $node = $nodename if !$node;
456 my $cfspath = cfs_config_path
($vmid, $node);
458 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
459 die "container $vmid does not exists\n" if !defined($conf);
465 my ($vmid, $conf) = @_;
467 my $dir = "/etc/pve/nodes/$nodename/lxc";
470 write_config
($vmid, $conf);
476 unlink config_file
($vmid, $nodename);
480 my ($vmid, $conf) = @_;
482 my $cfspath = cfs_config_path
($vmid);
484 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
487 # flock: we use one file handle per process, so lock file
488 # can be called multiple times and succeeds for the same process.
490 my $lock_handles = {};
491 my $lockdir = "/run/lock/lxc";
496 return "$lockdir/pve-config-${vmid}.lock";
500 my ($vmid, $timeout) = @_;
502 $timeout = 10 if !$timeout;
505 my $filename = lock_filename
($vmid);
507 mkdir $lockdir if !-d
$lockdir;
509 my $lock_func = sub {
510 if (!$lock_handles->{$$}->{$filename}) {
511 my $fh = new IO
::File
(">>$filename") ||
512 die "can't open file - $!\n";
513 $lock_handles->{$$}->{$filename} = { fh
=> $fh, refcount
=> 0};
516 if (!flock($lock_handles->{$$}->{$filename}->{fh
}, $mode |LOCK_NB
)) {
517 print STDERR
"trying to aquire lock...";
520 $success = flock($lock_handles->{$$}->{$filename}->{fh
}, $mode);
521 # try again on EINTR (see bug #273)
522 if ($success || ($! != EINTR
)) {
527 print STDERR
" failed\n";
528 die "can't aquire lock - $!\n";
531 print STDERR
" OK\n";
534 $lock_handles->{$$}->{$filename}->{refcount
}++;
537 eval { PVE
::Tools
::run_with_timeout
($timeout, $lock_func); };
540 die "can't lock file '$filename' - $err";
547 my $filename = lock_filename
($vmid);
549 if (my $fh = $lock_handles->{$$}->{$filename}->{fh
}) {
550 my $refcount = --$lock_handles->{$$}->{$filename}->{refcount
};
551 if ($refcount <= 0) {
552 $lock_handles->{$$}->{$filename} = undef;
559 my ($vmid, $timeout, $code, @param) = @_;
563 lock_aquire
($vmid, $timeout);
564 eval { $res = &$code(@param) };
576 return defined($confdesc->{$name});
579 # add JSON properties for create and set function
580 sub json_config_properties
{
583 foreach my $opt (keys %$confdesc) {
584 next if $opt eq 'parent' || $opt eq 'snaptime';
585 next if $prop->{$opt};
586 $prop->{$opt} = $confdesc->{$opt};
592 sub json_config_properties_no_rootfs
{
595 foreach my $opt (keys %$confdesc) {
596 next if $prop->{$opt};
597 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'rootfs';
598 $prop->{$opt} = $confdesc->{$opt};
604 # container status helpers
606 sub list_active_containers
{
608 my $filename = "/proc/net/unix";
610 # similar test is used by lcxcontainers.c: list_active_containers
613 my $fh = IO
::File-
>new ($filename, "r");
616 while (defined(my $line = <$fh>)) {
617 if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
619 if ($path =~ m!^@/var/lib/lxc/(\d+)/command$!) {
630 # warning: this is slow
634 my $active_hash = list_active_containers
();
636 return 1 if defined($active_hash->{$vmid});
641 sub get_container_disk_usage
{
644 my $cmd = ['lxc-attach', '-n', $vmid, '--', 'df', '-P', '-B', '1', '/'];
654 if (my ($fsid, $total, $used, $avail) = $line =~
655 m/^(\S+.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+\d+%\s.*$/) {
663 eval { PVE
::Tools
::run_command
($cmd, timeout
=> 1, outfunc
=> $parser); };
672 my $list = $opt_vmid ?
{ $opt_vmid => { type
=> 'lxc' }} : config_list
();
674 my $active_hash = list_active_containers
();
676 foreach my $vmid (keys %$list) {
677 my $d = $list->{$vmid};
679 my $running = defined($active_hash->{$vmid});
681 $d->{status
} = $running ?
'running' : 'stopped';
683 my $cfspath = cfs_config_path
($vmid);
684 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
686 $d->{name
} = $conf->{'hostname'} || "CT$vmid";
687 $d->{name
} =~ s/[\s]//g;
689 $d->{cpus
} = $conf->{cpulimit
} // 0;
692 my $res = get_container_disk_usage
($vmid);
693 $d->{disk
} = $res->{used
};
694 $d->{maxdisk
} = $res->{total
};
697 # use 4GB by default ??
698 if (my $rootfs = $conf->{rootfs
}) {
699 my $rootinfo = parse_ct_mountpoint
($rootfs);
700 $d->{maxdisk
} = int(($rootinfo->{size
} || 4)*1024*1024)*1024;
702 $d->{maxdisk
} = 4*1024*1024*1024;
708 $d->{maxmem
} = ($conf->{memory
}||512)*1024*1024;
709 $d->{maxswap
} = ($conf->{swap
}//0)*1024*1024;
720 $d->{template
} = is_template
($conf);
723 foreach my $vmid (keys %$list) {
724 my $d = $list->{$vmid};
725 next if $d->{status
} ne 'running';
727 $d->{uptime
} = 100; # fixme:
729 $d->{mem
} = read_cgroup_value
('memory', $vmid, 'memory.usage_in_bytes');
730 $d->{swap
} = read_cgroup_value
('memory', $vmid, 'memory.memsw.usage_in_bytes') - $d->{mem
};
732 my $blkio_bytes = read_cgroup_value
('blkio', $vmid, 'blkio.throttle.io_service_bytes', 1);
733 my @bytes = split(/\n/, $blkio_bytes);
734 foreach my $byte (@bytes) {
735 if (my ($key, $value) = $byte =~ /(Read|Write)\s+(\d+)/) {
736 $d->{diskread
} = $2 if $key eq 'Read';
737 $d->{diskwrite
} = $2 if $key eq 'Write';
745 my $parse_size = sub {
748 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
749 my ($size, $unit) = ($1, $3);
752 $size = $size * 1024;
753 } elsif ($unit eq 'M') {
754 $size = $size * 1024 * 1024;
755 } elsif ($unit eq 'G') {
756 $size = $size * 1024 * 1024 * 1024;
762 my $format_size = sub {
767 my $kb = int($size/1024);
768 return $size if $kb*1024 != $size;
770 my $mb = int($kb/1024);
771 return "${kb}K" if $mb*1024 != $kb;
773 my $gb = int($mb/1024);
774 return "${mb}M" if $gb*1024 != $mb;
779 sub parse_ct_mountpoint
{
786 foreach my $p (split (/,/, $data)) {
787 next if $p =~ m/^\s*$/;
789 if ($p =~ m/^(volume|backup|size|mp)=(.+)$/) {
790 my ($k, $v) = ($1, $2);
791 return undef if defined($res->{$k});
794 if (!$res->{volume
} && $p !~ m/=/) {
802 return undef if !defined($res->{volume
});
804 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
807 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
813 sub print_ct_mountpoint
{
814 my ($info, $nomp) = @_;
818 die "missing volume\n" if !$info->{volume
};
820 foreach my $o (qw(backup)) {
821 $opts .= ",$o=$info->{$o}" if defined($info->{$o});
825 $opts .= ",size=" . &$format_size($info->{size
});
828 $opts .= ",mp=$info->{mp}" if !$nomp;
830 return "$info->{volume}$opts";
833 sub print_lxc_network
{
836 die "no network name defined\n" if !$net->{name
};
838 my $res = "name=$net->{name}";
840 foreach my $k (qw(hwaddr mtu bridge ip gw ip6 gw6 firewall tag)) {
841 next if !defined($net->{$k});
842 $res .= ",$k=$net->{$k}";
848 sub parse_lxc_network
{
853 return $res if !$data;
855 foreach my $pv (split (/,/, $data)) {
856 if ($pv =~ m/^(bridge|hwaddr|mtu|name|ip|ip6|gw|gw6|firewall|tag)=(\S+)$/) {
863 $res->{type
} = 'veth';
864 $res->{hwaddr
} = PVE
::Tools
::random_ether_addr
() if !$res->{hwaddr
};
869 sub read_cgroup_value
{
870 my ($group, $vmid, $name, $full) = @_;
872 my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
874 return PVE
::Tools
::file_get_contents
($path) if $full;
876 return PVE
::Tools
::file_read_firstline
($path);
879 sub write_cgroup_value
{
880 my ($group, $vmid, $name, $value) = @_;
882 my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
883 PVE
::ProcFSTools
::write_proc_entry
($path, $value) if -e
$path;
887 sub find_lxc_console_pids
{
891 PVE
::Tools
::dir_glob_foreach
('/proc', '\d+', sub {
894 my $cmdline = PVE
::Tools
::file_read_firstline
("/proc/$pid/cmdline");
897 my @args = split(/\0/, $cmdline);
899 # serach for lxc-console -n <vmid>
900 return if scalar(@args) != 3;
901 return if $args[1] ne '-n';
902 return if $args[2] !~ m/^\d+$/;
903 return if $args[0] !~ m
|^(/usr/bin
/)?lxc-console
$|;
907 push @{$res->{$vmid}}, $pid;
919 $pid = $1 if $line =~ m/^PID:\s+(\d+)$/;
921 PVE
::Tools
::run_command
(['lxc-info', '-n', $vmid], outfunc
=> $parser);
923 die "unable to get PID for CT $vmid (not running?)\n" if !$pid;
928 my $ipv4_reverse_mask = [
964 # Note: we cannot use Net:IP, because that only allows strict
966 sub parse_ipv4_cidr
{
967 my ($cidr, $noerr) = @_;
969 if ($cidr =~ m!^($IPV4RE)(?:/(\d+))$! && ($2 > 7) && ($2 < 32)) {
970 return { address
=> $1, netmask
=> $ipv4_reverse_mask->[$2] };
973 return undef if $noerr;
975 die "unable to parse ipv4 address/mask\n";
981 die "VM is locked ($conf->{'lock'})\n" if $conf->{'lock'};
984 sub update_lxc_config
{
985 my ($storage_cfg, $vmid, $conf) = @_;
987 my $dir = "/var/lib/lxc/$vmid";
989 if ($conf->{template
}) {
991 unlink "$dir/config";
998 die "missing 'arch' - internal error" if !$conf->{arch
};
999 $raw .= "lxc.arch = $conf->{arch}\n";
1001 my $ostype = $conf->{ostype
} || die "missing 'ostype' - internal error";
1002 if ($ostype =~ /^(?:debian | ubuntu | centos | archlinux)$/x) {
1003 $raw .= "lxc.include = /usr/share/lxc/config/$ostype.common.conf\n";
1008 if (!has_dev_console
($conf)) {
1009 $raw .= "lxc.console = none\n";
1010 $raw .= "lxc.cgroup.devices.deny = c 5:1 rwm\n";
1013 my $ttycount = get_tty_count
($conf);
1014 $raw .= "lxc.tty = $ttycount\n";
1016 my $utsname = $conf->{hostname
} || "CT$vmid";
1017 $raw .= "lxc.utsname = $utsname\n";
1019 my $memory = $conf->{memory
} || 512;
1020 my $swap = $conf->{swap
} // 0;
1022 my $lxcmem = int($memory*1024*1024);
1023 $raw .= "lxc.cgroup.memory.limit_in_bytes = $lxcmem\n";
1025 my $lxcswap = int(($memory + $swap)*1024*1024);
1026 $raw .= "lxc.cgroup.memory.memsw.limit_in_bytes = $lxcswap\n";
1028 if (my $cpulimit = $conf->{cpulimit
}) {
1029 $raw .= "lxc.cgroup.cpu.cfs_period_us = 100000\n";
1030 my $value = int(100000*$cpulimit);
1031 $raw .= "lxc.cgroup.cpu.cfs_quota_us = $value\n";
1034 my $shares = $conf->{cpuunits
} || 1024;
1035 $raw .= "lxc.cgroup.cpu.shares = $shares\n";
1037 my $mountpoint = parse_ct_mountpoint
($conf->{rootfs
});
1038 $mountpoint->{mp
} = '/';
1040 my ($path, $use_loopdev) = mountpoint_mount_path
($mountpoint, $storage_cfg);
1041 $path = "loop:$path" if $use_loopdev;
1043 $raw .= "lxc.rootfs = $path\n";
1046 foreach my $k (keys %$conf) {
1047 next if $k !~ m/^net(\d+)$/;
1049 my $d = parse_lxc_network
($conf->{$k});
1051 $raw .= "lxc.network.type = veth\n";
1052 $raw .= "lxc.network.veth.pair = veth${vmid}i${ind}\n";
1053 $raw .= "lxc.network.hwaddr = $d->{hwaddr}\n" if defined($d->{hwaddr
});
1054 $raw .= "lxc.network.name = $d->{name}\n" if defined($d->{name
});
1055 $raw .= "lxc.network.mtu = $d->{mtu}\n" if defined($d->{mtu
});
1058 if (my $lxcconf = $conf->{lxc
}) {
1059 foreach my $entry (@$lxcconf) {
1060 my ($k, $v) = @$entry;
1061 $netcount++ if $k eq 'lxc.network.type';
1062 $raw .= "$k = $v\n";
1066 $raw .= "lxc.network.type = empty\n" if !$netcount;
1068 File
::Path
::mkpath
("$dir/rootfs");
1070 PVE
::Tools
::file_set_contents
("$dir/config", $raw);
1073 # verify and cleanup nameserver list (replace \0 with ' ')
1074 sub verify_nameserver_list
{
1075 my ($nameserver_list) = @_;
1078 foreach my $server (PVE
::Tools
::split_list
($nameserver_list)) {
1079 PVE
::JSONSchema
::pve_verify_ip
($server);
1080 push @list, $server;
1083 return join(' ', @list);
1086 sub verify_searchdomain_list
{
1087 my ($searchdomain_list) = @_;
1090 foreach my $server (PVE
::Tools
::split_list
($searchdomain_list)) {
1091 # todo: should we add checks for valid dns domains?
1092 push @list, $server;
1095 return join(' ', @list);
1098 sub update_pct_config
{
1099 my ($vmid, $conf, $running, $param, $delete) = @_;
1107 my $pid = find_lxc_pid
($vmid);
1108 $rootdir = "/proc/$pid/root";
1111 if (defined($delete)) {
1112 foreach my $opt (@$delete) {
1113 if ($opt eq 'hostname' || $opt eq 'memory' || $opt eq 'rootfs') {
1114 die "unable to delete required option '$opt'\n";
1115 } elsif ($opt eq 'swap') {
1116 delete $conf->{$opt};
1117 write_cgroup_value
("memory", $vmid, "memory.memsw.limit_in_bytes", -1);
1118 } elsif ($opt eq 'description' || $opt eq 'onboot' || $opt eq 'startup') {
1119 delete $conf->{$opt};
1120 } elsif ($opt eq 'nameserver' || $opt eq 'searchdomain' ||
1121 $opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1122 delete $conf->{$opt};
1123 push @nohotplug, $opt;
1125 } elsif ($opt =~ m/^net(\d)$/) {
1126 delete $conf->{$opt};
1129 PVE
::Network
::veth_delete
("veth${vmid}i$netid");
1130 } elsif ($opt eq 'protection') {
1131 delete $conf->{$opt};
1132 } elsif ($opt =~ m/^mp(\d+)$/) {
1133 delete $conf->{$opt};
1134 push @nohotplug, $opt;
1136 } elsif ($opt eq 'rootfs') {
1141 write_config
($vmid, $conf) if $running;
1145 # There's no separate swap size to configure, there's memory and "total"
1146 # memory (iow. memory+swap). This means we have to change them together.
1147 my $wanted_memory = PVE
::Tools
::extract_param
($param, 'memory');
1148 my $wanted_swap = PVE
::Tools
::extract_param
($param, 'swap');
1149 if (defined($wanted_memory) || defined($wanted_swap)) {
1151 $wanted_memory //= ($conf->{memory
} || 512);
1152 $wanted_swap //= ($conf->{swap
} || 0);
1154 my $total = $wanted_memory + $wanted_swap;
1156 write_cgroup_value
("memory", $vmid, "memory.limit_in_bytes", int($wanted_memory*1024*1024));
1157 write_cgroup_value
("memory", $vmid, "memory.memsw.limit_in_bytes", int($total*1024*1024));
1159 $conf->{memory
} = $wanted_memory;
1160 $conf->{swap
} = $wanted_swap;
1162 write_config
($vmid, $conf) if $running;
1165 foreach my $opt (keys %$param) {
1166 my $value = $param->{$opt};
1167 if ($opt eq 'hostname') {
1168 $conf->{$opt} = $value;
1169 } elsif ($opt eq 'onboot') {
1170 $conf->{$opt} = $value ?
1 : 0;
1171 } elsif ($opt eq 'startup') {
1172 $conf->{$opt} = $value;
1173 } elsif ($opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1174 $conf->{$opt} = $value;
1175 push @nohotplug, $opt;
1177 } elsif ($opt eq 'nameserver') {
1178 my $list = verify_nameserver_list
($value);
1179 $conf->{$opt} = $list;
1180 push @nohotplug, $opt;
1182 } elsif ($opt eq 'searchdomain') {
1183 my $list = verify_searchdomain_list
($value);
1184 $conf->{$opt} = $list;
1185 push @nohotplug, $opt;
1187 } elsif ($opt eq 'cpulimit') {
1188 $conf->{$opt} = $value;
1189 push @nohotplug, $opt; # fixme: hotplug
1191 } elsif ($opt eq 'cpuunits') {
1192 $conf->{$opt} = $value;
1193 write_cgroup_value
("cpu", $vmid, "cpu.shares", $value);
1194 } elsif ($opt eq 'description') {
1195 $conf->{$opt} = PVE
::Tools
::encode_text
($value);
1196 } elsif ($opt =~ m/^net(\d+)$/) {
1198 my $net = parse_lxc_network
($value);
1200 $conf->{$opt} = print_lxc_network
($net);
1202 update_net
($vmid, $conf, $opt, $net, $netid, $rootdir);
1204 } elsif ($opt eq 'protection') {
1205 $conf->{$opt} = $value ?
1 : 0;
1206 } elsif ($opt =~ m/^mp(\d+)$/) {
1207 $conf->{$opt} = $value;
1209 push @nohotplug, $opt;
1211 } elsif ($opt eq 'rootfs') {
1212 die "implement me: $opt";
1214 die "implement me: $opt";
1216 write_config
($vmid, $conf) if $running;
1219 if ($running && scalar(@nohotplug)) {
1220 die "unable to modify " . join(',', @nohotplug) . " while container is running\n";
1224 my $storage_cfg = PVE
::Storage
::config
();
1225 create_disks
($storage_cfg, $vmid, $conf, $conf);
1229 sub has_dev_console
{
1232 return !(defined($conf->{console
}) && !$conf->{console
});
1238 return $conf->{tty
} // $confdesc->{tty
}->{default};
1244 return $conf->{cmode
} // $confdesc->{cmode
}->{default};
1247 sub get_console_command
{
1248 my ($vmid, $conf) = @_;
1250 my $cmode = get_cmode
($conf);
1252 if ($cmode eq 'console') {
1253 return ['lxc-console', '-n', $vmid, '-t', 0];
1254 } elsif ($cmode eq 'tty') {
1255 return ['lxc-console', '-n', $vmid];
1256 } elsif ($cmode eq 'shell') {
1257 return ['lxc-attach', '--clear-env', '-n', $vmid];
1259 die "internal error";
1263 sub get_primary_ips
{
1266 # return data from net0
1268 return undef if !defined($conf->{net0
});
1269 my $net = parse_lxc_network
($conf->{net0
});
1271 my $ipv4 = $net->{ip
};
1273 if ($ipv4 =~ /^(dhcp|manual)$/) {
1279 my $ipv6 = $net->{ip6
};
1281 if ($ipv6 =~ /^(dhcp|manual)$/) {
1288 return ($ipv4, $ipv6);
1292 sub destroy_lxc_container
{
1293 my ($storage_cfg, $vmid, $conf) = @_;
1295 foreach_mountpoint
($conf, sub {
1296 my ($ms, $mountpoint) = @_;
1297 my ($vtype, $name, $owner) = PVE
::Storage
::parse_volname
($storage_cfg, $mountpoint->{volume
});
1298 PVE
::Storage
::vdisk_free
($storage_cfg, $mountpoint->{volume
}) if $vmid == $owner;
1301 rmdir "/var/lib/lxc/$vmid/rootfs";
1302 unlink "/var/lib/lxc/$vmid/config";
1303 rmdir "/var/lib/lxc/$vmid";
1304 destroy_config
($vmid);
1306 #my $cmd = ['lxc-destroy', '-n', $vmid ];
1307 #PVE::Tools::run_command($cmd);
1310 sub vm_stop_cleanup
{
1311 my ($storage_cfg, $vmid, $conf, $keepActive) = @_;
1316 my $vollist = get_vm_volumes
($conf);
1317 PVE
::Storage
::deactivate_volumes
($storage_cfg, $vollist);
1320 warn $@ if $@; # avoid errors - just warn
1323 my $safe_num_ne = sub {
1326 return 0 if !defined($a) && !defined($b);
1327 return 1 if !defined($a);
1328 return 1 if !defined($b);
1333 my $safe_string_ne = sub {
1336 return 0 if !defined($a) && !defined($b);
1337 return 1 if !defined($a);
1338 return 1 if !defined($b);
1344 my ($vmid, $conf, $opt, $newnet, $netid, $rootdir) = @_;
1346 if ($newnet->{type
} ne 'veth') {
1347 # for when there are physical interfaces
1348 die "cannot update interface of type $newnet->{type}";
1351 my $veth = "veth${vmid}i${netid}";
1352 my $eth = $newnet->{name
};
1354 if (my $oldnetcfg = $conf->{$opt}) {
1355 my $oldnet = parse_lxc_network
($oldnetcfg);
1357 if (&$safe_string_ne($oldnet->{hwaddr
}, $newnet->{hwaddr
}) ||
1358 &$safe_string_ne($oldnet->{name
}, $newnet->{name
})) {
1360 PVE
::Network
::veth_delete
($veth);
1361 delete $conf->{$opt};
1362 write_config
($vmid, $conf);
1364 hotplug_net
($vmid, $conf, $opt, $newnet, $netid);
1366 } elsif (&$safe_string_ne($oldnet->{bridge
}, $newnet->{bridge
}) ||
1367 &$safe_num_ne($oldnet->{tag
}, $newnet->{tag
}) ||
1368 &$safe_num_ne($oldnet->{firewall
}, $newnet->{firewall
})) {
1370 if ($oldnet->{bridge
}) {
1371 PVE
::Network
::tap_unplug
($veth);
1372 foreach (qw(bridge tag firewall)) {
1373 delete $oldnet->{$_};
1375 $conf->{$opt} = print_lxc_network
($oldnet);
1376 write_config
($vmid, $conf);
1379 PVE
::Network
::tap_plug
($veth, $newnet->{bridge
}, $newnet->{tag
}, $newnet->{firewall
});
1380 foreach (qw(bridge tag firewall)) {
1381 $oldnet->{$_} = $newnet->{$_} if $newnet->{$_};
1383 $conf->{$opt} = print_lxc_network
($oldnet);
1384 write_config
($vmid, $conf);
1387 hotplug_net
($vmid, $conf, $opt, $newnet, $netid);
1390 update_ipconfig
($vmid, $conf, $opt, $eth, $newnet, $rootdir);
1394 my ($vmid, $conf, $opt, $newnet, $netid) = @_;
1396 my $veth = "veth${vmid}i${netid}";
1397 my $vethpeer = $veth . "p";
1398 my $eth = $newnet->{name
};
1400 PVE
::Network
::veth_create
($veth, $vethpeer, $newnet->{bridge
}, $newnet->{hwaddr
});
1401 PVE
::Network
::tap_plug
($veth, $newnet->{bridge
}, $newnet->{tag
}, $newnet->{firewall
});
1403 # attach peer in container
1404 my $cmd = ['lxc-device', '-n', $vmid, 'add', $vethpeer, "$eth" ];
1405 PVE
::Tools
::run_command
($cmd);
1407 # link up peer in container
1408 $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', 'link', 'set', $eth ,'up' ];
1409 PVE
::Tools
::run_command
($cmd);
1411 my $done = { type
=> 'veth' };
1412 foreach (qw(bridge tag firewall hwaddr name)) {
1413 $done->{$_} = $newnet->{$_} if $newnet->{$_};
1415 $conf->{$opt} = print_lxc_network
($done);
1417 write_config
($vmid, $conf);
1420 sub update_ipconfig
{
1421 my ($vmid, $conf, $opt, $eth, $newnet, $rootdir) = @_;
1423 my $lxc_setup = PVE
::LXC
::Setup-
>new($conf, $rootdir);
1425 my $optdata = parse_lxc_network
($conf->{$opt});
1429 my $cmdargs = shift;
1430 PVE
::Tools
::run_command
(['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', @_], %$cmdargs);
1432 my $ipcmd = sub { &$nscmd({}, '/sbin/ip', @_) };
1434 my $change_ip_config = sub {
1435 my ($ipversion) = @_;
1437 my $family_opt = "-$ipversion";
1438 my $suffix = $ipversion == 4 ?
'' : $ipversion;
1439 my $gw= "gw$suffix";
1440 my $ip= "ip$suffix";
1442 my $newip = $newnet->{$ip};
1443 my $newgw = $newnet->{$gw};
1444 my $oldip = $optdata->{$ip};
1446 my $change_ip = &$safe_string_ne($oldip, $newip);
1447 my $change_gw = &$safe_string_ne($optdata->{$gw}, $newgw);
1449 return if !$change_ip && !$change_gw;
1451 # step 1: add new IP, if this fails we cancel
1452 if ($change_ip && $newip && $newip !~ /^(?:auto|dhcp)$/) {
1453 eval { &$ipcmd($family_opt, 'addr', 'add', $newip, 'dev', $eth); };
1460 # step 2: replace gateway
1461 # If this fails we delete the added IP and cancel.
1462 # If it succeeds we save the config and delete the old IP, ignoring
1463 # errors. The config is then saved.
1464 # Note: 'ip route replace' can add
1467 eval { &$ipcmd($family_opt, 'route', 'replace', 'default', 'via', $newgw); };
1470 # the route was not replaced, the old IP is still available
1471 # rollback (delete new IP) and cancel
1473 eval { &$ipcmd($family_opt, 'addr', 'del', $newip, 'dev', $eth); };
1474 warn $@ if $@; # no need to die here
1479 eval { &$ipcmd($family_opt, 'route', 'del', 'default'); };
1480 # if the route was not deleted, the guest might have deleted it manually
1486 # from this point on we save the configuration
1487 # step 3: delete old IP ignoring errors
1488 if ($change_ip && $oldip && $oldip !~ /^(?:auto|dhcp)$/) {
1489 # We need to enable promote_secondaries, otherwise our newly added
1490 # address will be removed along with the old one.
1493 if ($ipversion == 4) {
1494 &$nscmd({ outfunc
=> sub { $promote = int(shift) } },
1495 'cat', "/proc/sys/net/ipv4/conf/$eth/promote_secondaries");
1496 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=1");
1498 &$ipcmd($family_opt, 'addr', 'del', $oldip, 'dev', $eth);
1500 warn $@ if $@; # no need to die here
1502 if ($ipversion == 4) {
1503 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=$promote");
1507 foreach my $property ($ip, $gw) {
1508 if ($newnet->{$property}) {
1509 $optdata->{$property} = $newnet->{$property};
1511 delete $optdata->{$property};
1514 $conf->{$opt} = print_lxc_network
($optdata);
1515 write_config
($vmid, $conf);
1516 $lxc_setup->setup_network($conf);
1519 &$change_ip_config(4);
1520 &$change_ip_config(6);
1524 # Internal snapshots
1526 # NOTE: Snapshot create/delete involves several non-atomic
1527 # action, and can take a long time.
1528 # So we try to avoid locking the file and use 'lock' variable
1529 # inside the config file instead.
1531 my $snapshot_copy_config = sub {
1532 my ($source, $dest) = @_;
1534 foreach my $k (keys %$source) {
1535 next if $k eq 'snapshots';
1536 next if $k eq 'snapstate';
1537 next if $k eq 'snaptime';
1538 next if $k eq 'vmstate';
1539 next if $k eq 'lock';
1540 next if $k eq 'digest';
1541 next if $k eq 'description';
1543 $dest->{$k} = $source->{$k};
1547 my $snapshot_prepare = sub {
1548 my ($vmid, $snapname, $comment) = @_;
1552 my $updatefn = sub {
1554 my $conf = load_config
($vmid);
1556 die "you can't take a snapshot if it's a template\n"
1557 if is_template
($conf);
1561 $conf->{lock} = 'snapshot';
1563 die "snapshot name '$snapname' already used\n"
1564 if defined($conf->{snapshots
}->{$snapname});
1566 my $storecfg = PVE
::Storage
::config
();
1567 die "snapshot feature is not available\n" if !has_feature
('snapshot', $conf, $storecfg);
1569 $snap = $conf->{snapshots
}->{$snapname} = {};
1571 &$snapshot_copy_config($conf, $snap);
1573 $snap->{'snapstate'} = "prepare";
1574 $snap->{'snaptime'} = time();
1575 $snap->{'description'} = $comment if $comment;
1576 $conf->{snapshots
}->{$snapname} = $snap;
1578 write_config
($vmid, $conf);
1581 lock_container
($vmid, 10, $updatefn);
1586 my $snapshot_commit = sub {
1587 my ($vmid, $snapname) = @_;
1589 my $updatefn = sub {
1591 my $conf = load_config
($vmid);
1593 die "missing snapshot lock\n"
1594 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
1596 die "snapshot '$snapname' does not exist\n"
1597 if !defined($conf->{snapshots
}->{$snapname});
1599 die "wrong snapshot state\n"
1600 if !($conf->{snapshots
}->{$snapname}->{'snapstate'} &&
1601 $conf->{snapshots
}->{$snapname}->{'snapstate'} eq "prepare");
1603 delete $conf->{snapshots
}->{$snapname}->{'snapstate'};
1604 delete $conf->{lock};
1605 $conf->{parent
} = $snapname;
1607 write_config
($vmid, $conf);
1610 lock_container
($vmid, 10 ,$updatefn);
1614 my ($feature, $conf, $storecfg, $snapname) = @_;
1618 foreach_mountpoint
($conf, sub {
1619 my ($ms, $mountpoint) = @_;
1621 return if $err; # skip further test
1623 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $mountpoint->{volume
}, $snapname);
1625 # TODO: implement support for mountpoints
1626 die "unable to handle mountpoint '$ms' - feature not implemented\n"
1630 return $err ?
0 : 1;
1633 sub snapshot_create
{
1634 my ($vmid, $snapname, $comment) = @_;
1636 my $snap = &$snapshot_prepare($vmid, $snapname, $comment);
1638 my $conf = load_config
($vmid);
1640 my $cmd = "/usr/bin/lxc-freeze -n $vmid";
1641 my $running = check_running
($vmid);
1644 PVE
::Tools
::run_command
($cmd);
1647 my $storecfg = PVE
::Storage
::config
();
1648 my $rootinfo = parse_ct_mountpoint
($conf->{rootfs
});
1649 my $volid = $rootinfo->{volume
};
1651 $cmd = "/usr/bin/lxc-unfreeze -n $vmid";
1653 PVE
::Tools
::run_command
($cmd);
1656 PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snapname);
1657 &$snapshot_commit($vmid, $snapname);
1660 snapshot_delete
($vmid, $snapname, 1);
1665 sub snapshot_delete
{
1666 my ($vmid, $snapname, $force) = @_;
1672 my $updatefn = sub {
1674 $conf = load_config
($vmid);
1676 die "you can't delete a snapshot if vm is a template\n"
1677 if is_template
($conf);
1679 $snap = $conf->{snapshots
}->{$snapname};
1683 die "snapshot '$snapname' does not exist\n" if !defined($snap);
1685 $snap->{snapstate
} = 'delete';
1687 write_config
($vmid, $conf);
1690 lock_container
($vmid, 10, $updatefn);
1692 my $storecfg = PVE
::Storage
::config
();
1694 my $del_snap = sub {
1698 if ($conf->{parent
} eq $snapname) {
1699 if ($conf->{snapshots
}->{$snapname}->{snapname
}) {
1700 $conf->{parent
} = $conf->{snapshots
}->{$snapname}->{parent
};
1702 delete $conf->{parent
};
1706 delete $conf->{snapshots
}->{$snapname};
1708 write_config
($vmid, $conf);
1711 my $rootfs = $conf->{snapshots
}->{$snapname}->{rootfs
};
1712 my $rootinfo = parse_ct_mountpoint
($rootfs);
1713 my $volid = $rootinfo->{volume
};
1716 PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snapname);
1720 if(!$err || ($err && $force)) {
1721 lock_container
($vmid, 10, $del_snap);
1723 die "Can't delete snapshot: $vmid $snapname $err\n";
1728 sub snapshot_rollback
{
1729 my ($vmid, $snapname) = @_;
1731 my $storecfg = PVE
::Storage
::config
();
1733 my $conf = load_config
($vmid);
1735 die "you can't rollback if vm is a template\n" if is_template
($conf);
1737 my $snap = $conf->{snapshots
}->{$snapname};
1739 die "snapshot '$snapname' does not exist\n" if !defined($snap);
1741 my $rootfs = $snap->{rootfs
};
1742 my $rootinfo = parse_ct_mountpoint
($rootfs);
1743 my $volid = $rootinfo->{volume
};
1745 PVE
::Storage
::volume_rollback_is_possible
($storecfg, $volid, $snapname);
1747 my $updatefn = sub {
1749 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
1750 if $snap->{snapstate
};
1754 system("lxc-stop -n $vmid --kill") if check_running
($vmid);
1756 die "unable to rollback vm $vmid: vm is running\n"
1757 if check_running
($vmid);
1759 $conf->{lock} = 'rollback';
1763 # copy snapshot config to current config
1765 my $tmp_conf = $conf;
1766 &$snapshot_copy_config($tmp_conf->{snapshots
}->{$snapname}, $conf);
1767 $conf->{snapshots
} = $tmp_conf->{snapshots
};
1768 delete $conf->{snaptime
};
1769 delete $conf->{snapname
};
1770 $conf->{parent
} = $snapname;
1772 write_config
($vmid, $conf);
1775 my $unlockfn = sub {
1776 delete $conf->{lock};
1777 write_config
($vmid, $conf);
1780 lock_container
($vmid, 10, $updatefn);
1782 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
1784 lock_container
($vmid, 5, $unlockfn);
1787 sub template_create
{
1788 my ($vmid, $conf) = @_;
1790 my $storecfg = PVE
::Storage
::config
();
1792 my $rootinfo = parse_ct_mountpoint
($conf->{rootfs
});
1793 my $volid = $rootinfo->{volume
};
1795 die "Template feature is not available for '$volid'\n"
1796 if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
1798 PVE
::Storage
::activate_volumes
($storecfg, [$volid]);
1800 my $template_volid = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
1801 $rootinfo->{volume
} = $template_volid;
1802 $conf->{rootfs
} = print_ct_mountpoint
($rootinfo, 1);
1804 write_config
($vmid, $conf);
1810 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
1813 sub mountpoint_names
{
1816 my @names = ('rootfs');
1818 for (my $i = 0; $i < $MAX_MOUNT_POINTS; $i++) {
1819 push @names, "mp$i";
1822 return $reverse ?
reverse @names : @names;
1825 # The container might have *different* symlinks than the host. realpath/abs_path
1826 # use the actual filesystem to resolve links.
1827 sub sanitize_mountpoint
{
1829 $mp = '/' . $mp; # we always start with a slash
1830 $mp =~ s
@/{2,}@/@g; # collapse sequences of slashes
1831 $mp =~ s
@/\./@@g; # collapse /./
1832 $mp =~ s
@/\.(/)?
$@$1@; # collapse a trailing /. or /./
1833 $mp =~ s
@(.*)/[^/]+/\.\./@$1/@g; # collapse /../ without regard for symlinks
1834 $mp =~ s
@/\.\
.(/)?
$@$1@; # collapse trailing /.. or /../ disregarding symlinks
1838 sub foreach_mountpoint_full
{
1839 my ($conf, $reverse, $func) = @_;
1841 foreach my $key (mountpoint_names
($reverse)) {
1842 my $value = $conf->{$key};
1843 next if !defined($value);
1844 my $mountpoint = parse_ct_mountpoint
($value);
1846 # just to be sure: rootfs is /
1847 my $path = $key eq 'rootfs' ?
'/' : $mountpoint->{mp
};
1848 $mountpoint->{mp
} = sanitize_mountpoint
($path);
1850 $path = $mountpoint->{volume
};
1851 $mountpoint->{volume
} = sanitize_mountpoint
($path) if $path =~ m
|^/|;
1853 &$func($key, $mountpoint);
1857 sub foreach_mountpoint
{
1858 my ($conf, $func) = @_;
1860 foreach_mountpoint_full
($conf, 0, $func);
1863 sub foreach_mountpoint_reverse
{
1864 my ($conf, $func) = @_;
1866 foreach_mountpoint_full
($conf, 1, $func);
1869 sub check_ct_modify_config_perm
{
1870 my ($rpcenv, $authuser, $vmid, $pool, $key_list) = @_;
1872 return 1 if $authuser ne 'root@pam';
1874 foreach my $opt (@$key_list) {
1876 if ($opt eq 'cpus' || $opt eq 'cpuunits' || $opt eq 'cpulimit') {
1877 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.CPU']);
1878 } elsif ($opt eq 'rootfs' || $opt =~ /^mp\d+$/) {
1879 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Disk']);
1880 } elsif ($opt eq 'memory' || $opt eq 'swap') {
1881 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Memory']);
1882 } elsif ($opt =~ m/^net\d+$/ || $opt eq 'nameserver' ||
1883 $opt eq 'searchdomain' || $opt eq 'hostname') {
1884 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Network']);
1886 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Options']);
1894 my ($vmid, $storage_cfg, $conf, $noerr) = @_;
1896 my $rootdir = "/var/lib/lxc/$vmid/rootfs";
1897 my $volid_list = get_vm_volumes
($conf);
1899 foreach_mountpoint_reverse
($conf, sub {
1900 my ($ms, $mountpoint) = @_;
1902 my $volid = $mountpoint->{volume
};
1903 my $mount = $mountpoint->{mp
};
1905 return if !$volid || !$mount;
1907 my $mount_path = "$rootdir/$mount";
1908 $mount_path =~ s!/+!/!g;
1910 return if !PVE
::ProcFSTools
::is_mounted
($mount_path);
1913 PVE
::Tools
::run_command
(['umount', '-d', $mount_path]);
1926 my ($vmid, $storage_cfg, $conf) = @_;
1928 my $rootdir = "/var/lib/lxc/$vmid/rootfs";
1929 File
::Path
::make_path
($rootdir);
1931 my $volid_list = get_vm_volumes
($conf);
1932 PVE
::Storage
::activate_volumes
($storage_cfg, $volid_list);
1935 foreach_mountpoint
($conf, sub {
1936 my ($ms, $mountpoint) = @_;
1938 my $volid = $mountpoint->{volume
};
1939 my $mount = $mountpoint->{mp
};
1941 return if !$volid || !$mount;
1943 my $image_path = PVE
::Storage
::path
($storage_cfg, $volid);
1944 my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1945 PVE
::Storage
::parse_volname
($storage_cfg, $volid);
1947 die "unable to mount base volume - internal error" if $isBase;
1949 mountpoint_mount
($mountpoint, $rootdir, $storage_cfg);
1953 warn "mounting container failed - $err";
1954 umount_all
($vmid, $storage_cfg, $conf, 1);
1961 sub mountpoint_mount_path
{
1962 my ($mountpoint, $storage_cfg, $snapname) = @_;
1964 return mountpoint_mount
($mountpoint, undef, $storage_cfg, $snapname);
1967 my $check_mount_path = sub {
1969 $path = File
::Spec-
>canonpath($path);
1970 my $real = Cwd
::realpath
($path);
1971 if ($real ne $path) {
1972 die "mount path modified by symlink: $path != $real";
1976 # use $rootdir = undef to just return the corresponding mount path
1977 sub mountpoint_mount
{
1978 my ($mountpoint, $rootdir, $storage_cfg, $snapname) = @_;
1980 my $volid = $mountpoint->{volume
};
1981 my $mount = $mountpoint->{mp
};
1983 return if !$volid || !$mount;
1987 if (defined($rootdir)) {
1988 $rootdir =~ s!/+$!!;
1989 $mount_path = "$rootdir/$mount";
1990 $mount_path =~ s!/+!/!g;
1991 &$check_mount_path($mount_path);
1992 File
::Path
::mkpath
($mount_path);
1995 my ($storage, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1997 die "unknown snapshot path for '$volid'" if !$storage && defined($snapname);
2001 my $scfg = PVE
::Storage
::storage_config
($storage_cfg, $storage);
2002 my $path = PVE
::Storage
::path
($storage_cfg, $volid, $snapname);
2004 my ($vtype, undef, undef, undef, undef, $isBase, $format) =
2005 PVE
::Storage
::parse_volname
($storage_cfg, $volid);
2007 if ($format eq 'subvol') {
2010 if ($scfg->{type
} eq 'zfspool') {
2011 my $path_arg = $path;
2012 $path_arg =~ s!^/+!!;
2013 PVE
::Tools
::run_command
(['mount', '-o', 'ro', '-t', 'zfs', $path_arg, $mount_path]);
2015 die "cannot mount subvol snapshots for storage type '$scfg->{type}'\n";
2018 PVE
::Tools
::run_command
(['mount', '-o', 'bind', $path, $mount_path]);
2021 return wantarray ?
($path, 0) : $path;
2022 } elsif ($format eq 'raw') {
2023 my $use_loopdev = 0;
2025 if ($scfg->{path
}) {
2026 push @extra_opts, '-o', 'loop';
2028 } elsif ($scfg->{type
} eq 'drbd' || $scfg->{type
} eq 'lvm' || $scfg->{type
} eq 'rbd') {
2031 die "unsupported storage type '$scfg->{type}'\n";
2034 if ($isBase || defined($snapname)) {
2035 PVE
::Tools
::run_command
(['mount', '-o', "ro", @extra_opts, $path, $mount_path]);
2037 PVE
::Tools
::run_command
(['mount', @extra_opts, $path, $mount_path]);
2040 return wantarray ?
($path, $use_loopdev) : $path;
2042 die "unsupported image format '$format'\n";
2044 } elsif ($volid =~ m
|^/dev/.+|) {
2045 PVE
::Tools
::run_command
(['mount', $volid, $mount_path]) if $mount_path;
2046 return wantarray ?
($volid, 0) : $volid;
2047 } elsif ($volid !~ m
|^/dev/.+| && $volid =~ m
|^/.+| && -d
$volid) {
2048 &$check_mount_path($volid);
2049 PVE
::Tools
::run_command
(['mount', '-o', 'bind', $volid, $mount_path]) if $mount_path;
2050 return wantarray ?
($volid, 0) : $volid;
2053 die "unsupported storage";
2056 sub get_vm_volumes
{
2057 my ($conf, $excludes) = @_;
2061 foreach_mountpoint
($conf, sub {
2062 my ($ms, $mountpoint) = @_;
2064 return if $excludes && $ms eq $excludes;
2066 my $volid = $mountpoint->{volume
};
2068 return if !$volid || $volid =~ m
|^/|;
2070 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2073 push @$vollist, $volid;
2082 PVE
::Tools
::run_command
(['mkfs.ext4', '-O', 'mmp', $dev]);
2086 my ($storage_cfg, $volid) = @_;
2088 if ($volid =~ m!^/dev/.+!) {
2093 my ($storage, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2095 die "cannot format volume '$volid' with no storage\n" if !$storage;
2097 PVE
::Storage
::activate_volumes
($storage_cfg, [$volid]);
2099 my $path = PVE
::Storage
::path
($storage_cfg, $volid);
2101 my ($vtype, undef, undef, undef, undef, $isBase, $format) =
2102 PVE
::Storage
::parse_volname
($storage_cfg, $volid);
2104 die "cannot format volume '$volid' (format == $format)\n"
2105 if $format ne 'raw';
2111 my ($storecfg, $vollist) = @_;
2113 foreach my $volid (@$vollist) {
2114 eval { PVE
::Storage
::vdisk_free
($storecfg, $volid); };
2120 my ($storecfg, $vmid, $settings, $conf) = @_;
2125 foreach_mountpoint
($settings, sub {
2126 my ($ms, $mountpoint) = @_;
2128 my $volid = $mountpoint->{volume
};
2129 my $mp = $mountpoint->{mp
};
2131 my ($storage, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2133 return if !$storage;
2135 if ($volid =~ m/^([^:\s]+):(\d+(\.\d+)?)$/) {
2136 my ($storeid, $size_gb) = ($1, $2);
2138 my $size_kb = int(${size_gb
}*1024) * 1024;
2140 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storage);
2141 # fixme: use better naming ct-$vmid-disk-X.raw?
2143 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs') {
2145 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'raw',
2147 format_disk
($storecfg, $volid);
2149 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'subvol',
2152 } elsif ($scfg->{type
} eq 'zfspool') {
2154 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'subvol',
2156 } elsif ($scfg->{type
} eq 'drbd' || $scfg->{type
} eq 'lvm') {
2158 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'raw', undef, $size_kb);
2159 format_disk
($storecfg, $volid);
2161 } elsif ($scfg->{type
} eq 'rbd') {
2163 die "krbd option must be enabled on storage type '$scfg->{type}'\n" if !$scfg->{krbd
};
2164 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'raw', undef, $size_kb);
2165 format_disk
($storecfg, $volid);
2167 die "unable to create containers on storage type '$scfg->{type}'\n";
2169 push @$vollist, $volid;
2170 my $new_mountpoint = { volume
=> $volid, size
=> $size_kb*1024, mp
=> $mp };
2171 $conf->{$ms} = print_ct_mountpoint
($new_mountpoint, $ms eq 'rootfs');
2173 # use specified/existing volid
2177 # free allocated images on error
2179 destroy_disks
($storecfg, $vollist);
2185 # bash completion helper
2187 sub complete_os_templates
{
2188 my ($cmdname, $pname, $cvalue) = @_;
2190 my $cfg = PVE
::Storage
::config
();
2194 if ($cvalue =~ m/^([^:]+):/) {
2198 my $vtype = $cmdname eq 'restore' ?
'backup' : 'vztmpl';
2199 my $data = PVE
::Storage
::template_list
($cfg, $storeid, $vtype);
2202 foreach my $id (keys %$data) {
2203 foreach my $item (@{$data->{$id}}) {
2204 push @$res, $item->{volid
} if defined($item->{volid
});
2211 my $complete_ctid_full = sub {
2214 my $idlist = vmstatus
();
2216 my $active_hash = list_active_containers
();
2220 foreach my $id (keys %$idlist) {
2221 my $d = $idlist->{$id};
2222 if (defined($running)) {
2223 next if $d->{template
};
2224 next if $running && !$active_hash->{$id};
2225 next if !$running && $active_hash->{$id};
2234 return &$complete_ctid_full();
2237 sub complete_ctid_stopped
{
2238 return &$complete_ctid_full(0);
2241 sub complete_ctid_running
{
2242 return &$complete_ctid_full(1);