10 use PVE
::Cluster
qw(cfs_register_file cfs_read_file);
14 use PVE
::JSONSchema
qw(get_standard_option);
15 use PVE
::Tools
qw($IPV6RE $IPV4RE dir_glob_foreach);
17 use PVE
::AccessControl
;
22 my $nodename = PVE
::INotify
::nodename
();
24 cfs_register_file
('/lxc/', \
&parse_pct_config
, \
&write_pct_config
);
26 PVE
::JSONSchema
::register_format
('pve-lxc-network', \
&verify_lxc_network
);
27 sub verify_lxc_network
{
28 my ($value, $noerr) = @_;
30 return $value if parse_lxc_network
($value);
32 return undef if $noerr;
34 die "unable to parse network setting\n";
37 PVE
::JSONSchema
::register_format
('pve-ct-mountpoint', \
&verify_ct_mountpoint
);
38 sub verify_ct_mountpoint
{
39 my ($value, $noerr) = @_;
41 return $value if parse_ct_mountpoint
($value);
43 return undef if $noerr;
45 die "unable to parse CT mountpoint options\n";
48 PVE
::JSONSchema
::register_standard_option
('pve-ct-rootfs', {
49 type
=> 'string', format
=> 'pve-ct-mountpoint',
50 typetext
=> '[volume=]volume,] [,backup=yes|no] [,size=\d+]',
51 description
=> "Use volume as container root.",
55 PVE
::JSONSchema
::register_standard_option
('pve-lxc-snapshot-name', {
56 description
=> "The name of the snapshot.",
57 type
=> 'string', format
=> 'pve-configid',
65 description
=> "Lock/unlock the VM.",
66 enum
=> [qw(migrate backup snapshot rollback)],
71 description
=> "Specifies whether a VM will be started during system bootup.",
74 startup
=> get_standard_option
('pve-startup-order'),
78 description
=> "Enable/disable Template.",
84 enum
=> ['amd64', 'i386'],
85 description
=> "OS architecture type.",
91 enum
=> ['debian', 'ubuntu', 'centos', 'archlinux'],
92 description
=> "OS type. Corresponds to lxc setup scripts in /usr/share/lxc/config/<ostype>.common.conf.",
97 description
=> "Attach a console device (/dev/console) to the container.",
103 description
=> "Specify the number of tty available to the container",
111 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.",
119 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.",
127 description
=> "Amount of RAM for the VM in MB.",
134 description
=> "Amount of SWAP for the VM in MB.",
140 description
=> "Set a host name for the container.",
147 description
=> "Container description. Only used on the configuration web interface.",
152 description
=> "Sets DNS search domains for a container. Create will automatically use the setting from the host if you neither set searchdomain or nameserver.",
157 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.",
159 rootfs
=> get_standard_option
('pve-ct-rootfs'),
162 type
=> 'string', format
=> 'pve-configid',
164 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
168 description
=> "Timestamp for snapshots.",
174 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).",
176 enum
=> ['shell', 'console', 'tty'],
182 description
=> "Sets the protection flag of the container. This will prevent the remove operation.",
187 my $valid_lxc_conf_keys = {
191 'lxc.haltsignal' => 1,
192 'lxc.rebootsignal' => 1,
193 'lxc.stopsignal' => 1,
195 'lxc.network.type' => 1,
196 'lxc.network.flags' => 1,
197 'lxc.network.link' => 1,
198 'lxc.network.mtu' => 1,
199 'lxc.network.name' => 1,
200 'lxc.network.hwaddr' => 1,
201 'lxc.network.ipv4' => 1,
202 'lxc.network.ipv4.gateway' => 1,
203 'lxc.network.ipv6' => 1,
204 'lxc.network.ipv6.gateway' => 1,
205 'lxc.network.script.up' => 1,
206 'lxc.network.script.down' => 1,
208 'lxc.console.logfile' => 1,
211 'lxc.devttydir' => 1,
212 'lxc.hook.autodev' => 1,
216 'lxc.mount.entry' => 1,
217 'lxc.mount.auto' => 1,
219 'lxc.rootfs.mount' => 1,
220 'lxc.rootfs.options' => 1,
224 'lxc.aa_profile' => 1,
225 'lxc.aa_allow_incomplete' => 1,
226 'lxc.se_context' => 1,
229 'lxc.hook.pre-start' => 1,
230 'lxc.hook.pre-mount' => 1,
231 'lxc.hook.mount' => 1,
232 'lxc.hook.start' => 1,
233 'lxc.hook.post-stop' => 1,
234 'lxc.hook.clone' => 1,
235 'lxc.hook.destroy' => 1,
238 'lxc.start.auto' => 1,
239 'lxc.start.delay' => 1,
240 'lxc.start.order' => 1,
242 'lxc.environment' => 1,
249 my $MAX_LXC_NETWORKS = 10;
250 for (my $i = 0; $i < $MAX_LXC_NETWORKS; $i++) {
251 $confdesc->{"net$i"} = {
253 type
=> 'string', format
=> 'pve-lxc-network',
254 description
=> "Specifies network interfaces for the container.\n\n".
255 "The string should have the follow format:\n\n".
256 "-net<[0-9]> bridge=<vmbr<Nummber>>[,hwaddr=<MAC>]\n".
257 "[,mtu=<Number>][,name=<String>][,ip=<IPv4Format/CIDR>]\n".
258 ",ip6=<IPv6Format/CIDR>][,gw=<GatwayIPv4>]\n".
259 ",gw6=<GatwayIPv6>][,firewall=<[1|0]>][,tag=<VlanNo>]",
263 my $MAX_MOUNT_POINTS = 10;
264 for (my $i = 0; $i < $MAX_MOUNT_POINTS; $i++) {
265 $confdesc->{"mp$i"} = {
267 type
=> 'string', format
=> 'pve-ct-mountpoint',
268 typetext
=> '[volume=]volume,] [,backup=yes|no] [,size=\d+] [,mp=mountpoint]',
269 description
=> "Use volume as container mount point (experimental feature).",
274 sub write_pct_config
{
275 my ($filename, $conf) = @_;
277 delete $conf->{snapstate
}; # just to be sure
279 my $generate_raw_config = sub {
284 # add description as comment to top of file
285 my $descr = $conf->{description
} || '';
286 foreach my $cl (split(/\n/, $descr)) {
287 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
290 foreach my $key (sort keys %$conf) {
291 next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' ||
292 $key eq 'snapshots' || $key eq 'snapname' || $key eq 'lxc';
293 $raw .= "$key: $conf->{$key}\n";
296 if (my $lxcconf = $conf->{lxc
}) {
297 foreach my $entry (@$lxcconf) {
298 my ($k, $v) = @$entry;
306 my $raw = &$generate_raw_config($conf);
308 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
309 $raw .= "\n[$snapname]\n";
310 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
317 my ($key, $value) = @_;
319 die "unknown setting '$key'\n" if !$confdesc->{$key};
321 my $type = $confdesc->{$key}->{type
};
323 if (!defined($value)) {
324 die "got undefined value\n";
327 if ($value =~ m/[\n\r]/) {
328 die "property contains a line feed\n";
331 if ($type eq 'boolean') {
332 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
333 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
334 die "type check ('boolean') failed - got '$value'\n";
335 } elsif ($type eq 'integer') {
336 return int($1) if $value =~ m/^(\d+)$/;
337 die "type check ('integer') failed - got '$value'\n";
338 } elsif ($type eq 'number') {
339 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
340 die "type check ('number') failed - got '$value'\n";
341 } elsif ($type eq 'string') {
342 if (my $fmt = $confdesc->{$key}->{format
}) {
343 PVE
::JSONSchema
::check_format
($fmt, $value);
352 sub parse_pct_config
{
353 my ($filename, $raw) = @_;
355 return undef if !defined($raw);
358 digest
=> Digest
::SHA
::sha1_hex
($raw),
362 $filename =~ m
|/lxc/(\d
+).conf
$|
363 || die "got strange filename '$filename'";
371 my @lines = split(/\n/, $raw);
372 foreach my $line (@lines) {
373 next if $line =~ m/^\s*$/;
375 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
377 $conf->{description
} = $descr if $descr;
379 $conf = $res->{snapshots
}->{$section} = {};
383 if ($line =~ m/^\#(.*)\s*$/) {
384 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
388 if ($line =~ m/^(lxc\.[a-z0-9_\.]+)(:|\s*=)\s*(.*?)\s*$/) {
391 if ($valid_lxc_conf_keys->{$key} || $key =~ m/^lxc\.cgroup\./) {
392 push @{$conf->{lxc
}}, [$key, $value];
394 warn "vm $vmid - unable to parse config: $line\n";
396 } elsif ($line =~ m/^(description):\s*(.*\S)\s*$/) {
397 $descr .= PVE
::Tools
::decode_text
($2);
398 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
399 $conf->{snapstate
} = $1;
400 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
403 eval { $value = check_type
($key, $value); };
404 warn "vm $vmid - unable to parse value of '$key' - $@" if $@;
405 $conf->{$key} = $value;
407 warn "vm $vmid - unable to parse config: $line\n";
411 $conf->{description
} = $descr if $descr;
413 delete $res->{snapstate
}; # just to be sure
419 my $vmlist = PVE
::Cluster
::get_vmlist
();
421 return $res if !$vmlist || !$vmlist->{ids
};
422 my $ids = $vmlist->{ids
};
424 foreach my $vmid (keys %$ids) {
425 next if !$vmid; # skip CT0
426 my $d = $ids->{$vmid};
427 next if !$d->{node
} || $d->{node
} ne $nodename;
428 next if !$d->{type
} || $d->{type
} ne 'lxc';
429 $res->{$vmid}->{type
} = 'lxc';
434 sub cfs_config_path
{
435 my ($vmid, $node) = @_;
437 $node = $nodename if !$node;
438 return "nodes/$node/lxc/$vmid.conf";
442 my ($vmid, $node) = @_;
444 my $cfspath = cfs_config_path
($vmid, $node);
445 return "/etc/pve/$cfspath";
449 my ($vmid, $node) = @_;
451 $node = $nodename if !$node;
452 my $cfspath = cfs_config_path
($vmid, $node);
454 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
455 die "container $vmid does not exists\n" if !defined($conf);
461 my ($vmid, $conf) = @_;
463 my $dir = "/etc/pve/nodes/$nodename/lxc";
466 write_config
($vmid, $conf);
472 unlink config_file
($vmid, $nodename);
476 my ($vmid, $conf) = @_;
478 my $cfspath = cfs_config_path
($vmid);
480 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
483 # flock: we use one file handle per process, so lock file
484 # can be called multiple times and succeeds for the same process.
486 my $lock_handles = {};
487 my $lockdir = "/run/lock/lxc";
492 return "$lockdir/pve-config-${vmid}.lock";
496 my ($vmid, $timeout) = @_;
498 $timeout = 10 if !$timeout;
501 my $filename = lock_filename
($vmid);
503 mkdir $lockdir if !-d
$lockdir;
505 my $lock_func = sub {
506 if (!$lock_handles->{$$}->{$filename}) {
507 my $fh = new IO
::File
(">>$filename") ||
508 die "can't open file - $!\n";
509 $lock_handles->{$$}->{$filename} = { fh
=> $fh, refcount
=> 0};
512 if (!flock($lock_handles->{$$}->{$filename}->{fh
}, $mode |LOCK_NB
)) {
513 print STDERR
"trying to aquire lock...";
516 $success = flock($lock_handles->{$$}->{$filename}->{fh
}, $mode);
517 # try again on EINTR (see bug #273)
518 if ($success || ($! != EINTR
)) {
523 print STDERR
" failed\n";
524 die "can't aquire lock - $!\n";
527 print STDERR
" OK\n";
530 $lock_handles->{$$}->{$filename}->{refcount
}++;
533 eval { PVE
::Tools
::run_with_timeout
($timeout, $lock_func); };
536 die "can't lock file '$filename' - $err";
543 my $filename = lock_filename
($vmid);
545 if (my $fh = $lock_handles->{$$}->{$filename}->{fh
}) {
546 my $refcount = --$lock_handles->{$$}->{$filename}->{refcount
};
547 if ($refcount <= 0) {
548 $lock_handles->{$$}->{$filename} = undef;
555 my ($vmid, $timeout, $code, @param) = @_;
559 lock_aquire
($vmid, $timeout);
560 eval { $res = &$code(@param) };
572 return defined($confdesc->{$name});
575 # add JSON properties for create and set function
576 sub json_config_properties
{
579 foreach my $opt (keys %$confdesc) {
580 next if $opt eq 'parent' || $opt eq 'snaptime';
581 next if $prop->{$opt};
582 $prop->{$opt} = $confdesc->{$opt};
588 sub json_config_properties_no_rootfs
{
591 foreach my $opt (keys %$confdesc) {
592 next if $prop->{$opt};
593 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'rootfs';
594 $prop->{$opt} = $confdesc->{$opt};
600 # container status helpers
602 sub list_active_containers
{
604 my $filename = "/proc/net/unix";
606 # similar test is used by lcxcontainers.c: list_active_containers
609 my $fh = IO
::File-
>new ($filename, "r");
612 while (defined(my $line = <$fh>)) {
613 if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
615 if ($path =~ m!^@/var/lib/lxc/(\d+)/command$!) {
626 # warning: this is slow
630 my $active_hash = list_active_containers
();
632 return 1 if defined($active_hash->{$vmid});
637 sub get_container_disk_usage
{
640 my $cmd = ['lxc-attach', '-n', $vmid, '--', 'df', '-P', '-B', '1', '/'];
650 if (my ($fsid, $total, $used, $avail) = $line =~
651 m/^(\S+.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+\d+%\s.*$/) {
659 eval { PVE
::Tools
::run_command
($cmd, timeout
=> 1, outfunc
=> $parser); };
668 my $list = $opt_vmid ?
{ $opt_vmid => { type
=> 'lxc' }} : config_list
();
670 my $active_hash = list_active_containers
();
672 foreach my $vmid (keys %$list) {
673 my $d = $list->{$vmid};
675 my $running = defined($active_hash->{$vmid});
677 $d->{status
} = $running ?
'running' : 'stopped';
679 my $cfspath = cfs_config_path
($vmid);
680 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
682 $d->{name
} = $conf->{'hostname'} || "CT$vmid";
683 $d->{name
} =~ s/[\s]//g;
685 $d->{cpus
} = $conf->{cpulimit
} // 0;
688 my $res = get_container_disk_usage
($vmid);
689 $d->{disk
} = $res->{used
};
690 $d->{maxdisk
} = $res->{total
};
693 # use 4GB by default ??
694 if (my $rootfs = $conf->{rootfs
}) {
695 my $rootinfo = parse_ct_mountpoint
($rootfs);
696 $d->{maxdisk
} = int(($rootinfo->{size
} || 4)*1024*1024)*1024;
698 $d->{maxdisk
} = 4*1024*1024*1024;
704 $d->{maxmem
} = ($conf->{memory
}||512)*1024*1024;
705 $d->{maxswap
} = ($conf->{swap
}//0)*1024*1024;
716 $d->{template
} = is_template
($conf);
719 foreach my $vmid (keys %$list) {
720 my $d = $list->{$vmid};
721 next if $d->{status
} ne 'running';
723 $d->{uptime
} = 100; # fixme:
725 $d->{mem
} = read_cgroup_value
('memory', $vmid, 'memory.usage_in_bytes');
726 $d->{swap
} = read_cgroup_value
('memory', $vmid, 'memory.memsw.usage_in_bytes') - $d->{mem
};
728 my $blkio_bytes = read_cgroup_value
('blkio', $vmid, 'blkio.throttle.io_service_bytes', 1);
729 my @bytes = split(/\n/, $blkio_bytes);
730 foreach my $byte (@bytes) {
731 if (my ($key, $value) = $byte =~ /(Read|Write)\s+(\d+)/) {
732 $d->{diskread
} = $2 if $key eq 'Read';
733 $d->{diskwrite
} = $2 if $key eq 'Write';
741 my $parse_size = sub {
744 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
745 my ($size, $unit) = ($1, $3);
748 $size = $size * 1024;
749 } elsif ($unit eq 'M') {
750 $size = $size * 1024 * 1024;
751 } elsif ($unit eq 'G') {
752 $size = $size * 1024 * 1024 * 1024;
758 my $format_size = sub {
763 my $kb = int($size/1024);
764 return $size if $kb*1024 != $size;
766 my $mb = int($kb/1024);
767 return "${kb}K" if $mb*1024 != $kb;
769 my $gb = int($mb/1024);
770 return "${mb}M" if $gb*1024 != $mb;
775 sub parse_ct_mountpoint
{
782 foreach my $p (split (/,/, $data)) {
783 next if $p =~ m/^\s*$/;
785 if ($p =~ m/^(volume|backup|size|mp)=(.+)$/) {
786 my ($k, $v) = ($1, $2);
787 return undef if defined($res->{$k});
790 if (!$res->{volume
} && $p !~ m/=/) {
798 return undef if !defined($res->{volume
});
800 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
803 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
809 sub print_ct_mountpoint
{
810 my ($info, $nomp) = @_;
814 die "missing volume\n" if !$info->{volume
};
816 foreach my $o (qw(backup)) {
817 $opts .= ",$o=$info->{$o}" if defined($info->{$o});
821 $opts .= ",size=" . &$format_size($info->{size
});
824 $opts .= ",mp=$info->{mp}" if !$nomp;
826 return "$info->{volume}$opts";
829 sub print_lxc_network
{
832 die "no network name defined\n" if !$net->{name
};
834 my $res = "name=$net->{name}";
836 foreach my $k (qw(hwaddr mtu bridge ip gw ip6 gw6 firewall tag)) {
837 next if !defined($net->{$k});
838 $res .= ",$k=$net->{$k}";
844 sub parse_lxc_network
{
849 return $res if !$data;
851 foreach my $pv (split (/,/, $data)) {
852 if ($pv =~ m/^(bridge|hwaddr|mtu|name|ip|ip6|gw|gw6|firewall|tag)=(\S+)$/) {
859 $res->{type
} = 'veth';
860 $res->{hwaddr
} = PVE
::Tools
::random_ether_addr
() if !$res->{hwaddr
};
865 sub read_cgroup_value
{
866 my ($group, $vmid, $name, $full) = @_;
868 my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
870 return PVE
::Tools
::file_get_contents
($path) if $full;
872 return PVE
::Tools
::file_read_firstline
($path);
875 sub write_cgroup_value
{
876 my ($group, $vmid, $name, $value) = @_;
878 my $path = "/sys/fs/cgroup/$group/lxc/$vmid/$name";
879 PVE
::ProcFSTools
::write_proc_entry
($path, $value) if -e
$path;
883 sub find_lxc_console_pids
{
887 PVE
::Tools
::dir_glob_foreach
('/proc', '\d+', sub {
890 my $cmdline = PVE
::Tools
::file_read_firstline
("/proc/$pid/cmdline");
893 my @args = split(/\0/, $cmdline);
895 # serach for lxc-console -n <vmid>
896 return if scalar(@args) != 3;
897 return if $args[1] ne '-n';
898 return if $args[2] !~ m/^\d+$/;
899 return if $args[0] !~ m
|^(/usr/bin
/)?lxc-console
$|;
903 push @{$res->{$vmid}}, $pid;
915 $pid = $1 if $line =~ m/^PID:\s+(\d+)$/;
917 PVE
::Tools
::run_command
(['lxc-info', '-n', $vmid], outfunc
=> $parser);
919 die "unable to get PID for CT $vmid (not running?)\n" if !$pid;
924 my $ipv4_reverse_mask = [
960 # Note: we cannot use Net:IP, because that only allows strict
962 sub parse_ipv4_cidr
{
963 my ($cidr, $noerr) = @_;
965 if ($cidr =~ m!^($IPV4RE)(?:/(\d+))$! && ($2 > 7) && ($2 < 32)) {
966 return { address
=> $1, netmask
=> $ipv4_reverse_mask->[$2] };
969 return undef if $noerr;
971 die "unable to parse ipv4 address/mask\n";
977 die "VM is locked ($conf->{'lock'})\n" if $conf->{'lock'};
980 sub update_lxc_config
{
981 my ($storage_cfg, $vmid, $conf) = @_;
983 my $dir = "/var/lib/lxc/$vmid";
985 if ($conf->{template
}) {
987 unlink "$dir/config";
994 die "missing 'arch' - internal error" if !$conf->{arch
};
995 $raw .= "lxc.arch = $conf->{arch}\n";
997 my $ostype = $conf->{ostype
} || die "missing 'ostype' - internal error";
998 if ($ostype =~ /^(?:debian | ubuntu | centos | archlinux)$/x) {
999 $raw .= "lxc.include = /usr/share/lxc/config/$ostype.common.conf\n";
1004 if (!has_dev_console
($conf)) {
1005 $raw .= "lxc.console = none\n";
1006 $raw .= "lxc.cgroup.devices.deny = c 5:1 rwm\n";
1009 my $ttycount = get_tty_count
($conf);
1010 $raw .= "lxc.tty = $ttycount\n";
1012 my $utsname = $conf->{hostname
} || "CT$vmid";
1013 $raw .= "lxc.utsname = $utsname\n";
1015 my $memory = $conf->{memory
} || 512;
1016 my $swap = $conf->{swap
} // 0;
1018 my $lxcmem = int($memory*1024*1024);
1019 $raw .= "lxc.cgroup.memory.limit_in_bytes = $lxcmem\n";
1021 my $lxcswap = int(($memory + $swap)*1024*1024);
1022 $raw .= "lxc.cgroup.memory.memsw.limit_in_bytes = $lxcswap\n";
1024 if (my $cpulimit = $conf->{cpulimit
}) {
1025 $raw .= "lxc.cgroup.cpu.cfs_period_us = 100000\n";
1026 my $value = int(100000*$cpulimit);
1027 $raw .= "lxc.cgroup.cpu.cfs_quota_us = $value\n";
1030 my $shares = $conf->{cpuunits
} || 1024;
1031 $raw .= "lxc.cgroup.cpu.shares = $shares\n";
1033 my $mountpoint = parse_ct_mountpoint
($conf->{rootfs
});
1034 $mountpoint->{mp
} = '/';
1036 my ($path, $use_loopdev) = mountpoint_mount_path
($mountpoint, $storage_cfg);
1037 $path = "loop:$path" if $use_loopdev;
1039 $raw .= "lxc.rootfs = $path\n";
1042 foreach my $k (keys %$conf) {
1043 next if $k !~ m/^net(\d+)$/;
1045 my $d = parse_lxc_network
($conf->{$k});
1047 $raw .= "lxc.network.type = veth\n";
1048 $raw .= "lxc.network.veth.pair = veth${vmid}i${ind}\n";
1049 $raw .= "lxc.network.hwaddr = $d->{hwaddr}\n" if defined($d->{hwaddr
});
1050 $raw .= "lxc.network.name = $d->{name}\n" if defined($d->{name
});
1051 $raw .= "lxc.network.mtu = $d->{mtu}\n" if defined($d->{mtu
});
1054 if (my $lxcconf = $conf->{lxc
}) {
1055 foreach my $entry (@$lxcconf) {
1056 my ($k, $v) = @$entry;
1057 $netcount++ if $k eq 'lxc.network.type';
1058 $raw .= "$k = $v\n";
1062 $raw .= "lxc.network.type = empty\n" if !$netcount;
1064 File
::Path
::mkpath
("$dir/rootfs");
1066 PVE
::Tools
::file_set_contents
("$dir/config", $raw);
1069 # verify and cleanup nameserver list (replace \0 with ' ')
1070 sub verify_nameserver_list
{
1071 my ($nameserver_list) = @_;
1074 foreach my $server (PVE
::Tools
::split_list
($nameserver_list)) {
1075 PVE
::JSONSchema
::pve_verify_ip
($server);
1076 push @list, $server;
1079 return join(' ', @list);
1082 sub verify_searchdomain_list
{
1083 my ($searchdomain_list) = @_;
1086 foreach my $server (PVE
::Tools
::split_list
($searchdomain_list)) {
1087 # todo: should we add checks for valid dns domains?
1088 push @list, $server;
1091 return join(' ', @list);
1094 sub update_pct_config
{
1095 my ($vmid, $conf, $running, $param, $delete) = @_;
1103 my $pid = find_lxc_pid
($vmid);
1104 $rootdir = "/proc/$pid/root";
1107 if (defined($delete)) {
1108 foreach my $opt (@$delete) {
1109 if ($opt eq 'hostname' || $opt eq 'memory' || $opt eq 'rootfs') {
1110 die "unable to delete required option '$opt'\n";
1111 } elsif ($opt eq 'swap') {
1112 delete $conf->{$opt};
1113 write_cgroup_value
("memory", $vmid, "memory.memsw.limit_in_bytes", -1);
1114 } elsif ($opt eq 'description' || $opt eq 'onboot' || $opt eq 'startup') {
1115 delete $conf->{$opt};
1116 } elsif ($opt eq 'nameserver' || $opt eq 'searchdomain' ||
1117 $opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1118 delete $conf->{$opt};
1119 push @nohotplug, $opt;
1121 } elsif ($opt =~ m/^net(\d)$/) {
1122 delete $conf->{$opt};
1125 PVE
::Network
::veth_delete
("veth${vmid}i$netid");
1126 } elsif ($opt eq 'protection') {
1127 delete $conf->{$opt};
1128 } elsif ($opt =~ m/^mp(\d+)$/) {
1129 delete $conf->{$opt};
1130 push @nohotplug, $opt;
1132 } elsif ($opt eq 'rootfs') {
1137 write_config
($vmid, $conf) if $running;
1141 # There's no separate swap size to configure, there's memory and "total"
1142 # memory (iow. memory+swap). This means we have to change them together.
1143 my $wanted_memory = PVE
::Tools
::extract_param
($param, 'memory');
1144 my $wanted_swap = PVE
::Tools
::extract_param
($param, 'swap');
1145 if (defined($wanted_memory) || defined($wanted_swap)) {
1147 $wanted_memory //= ($conf->{memory
} || 512);
1148 $wanted_swap //= ($conf->{swap
} || 0);
1150 my $total = $wanted_memory + $wanted_swap;
1152 write_cgroup_value
("memory", $vmid, "memory.limit_in_bytes", int($wanted_memory*1024*1024));
1153 write_cgroup_value
("memory", $vmid, "memory.memsw.limit_in_bytes", int($total*1024*1024));
1155 $conf->{memory
} = $wanted_memory;
1156 $conf->{swap
} = $wanted_swap;
1158 write_config
($vmid, $conf) if $running;
1161 foreach my $opt (keys %$param) {
1162 my $value = $param->{$opt};
1163 if ($opt eq 'hostname') {
1164 $conf->{$opt} = $value;
1165 } elsif ($opt eq 'onboot') {
1166 $conf->{$opt} = $value ?
1 : 0;
1167 } elsif ($opt eq 'startup') {
1168 $conf->{$opt} = $value;
1169 } elsif ($opt eq 'tty' || $opt eq 'console' || $opt eq 'cmode') {
1170 $conf->{$opt} = $value;
1171 push @nohotplug, $opt;
1173 } elsif ($opt eq 'nameserver') {
1174 my $list = verify_nameserver_list
($value);
1175 $conf->{$opt} = $list;
1176 push @nohotplug, $opt;
1178 } elsif ($opt eq 'searchdomain') {
1179 my $list = verify_searchdomain_list
($value);
1180 $conf->{$opt} = $list;
1181 push @nohotplug, $opt;
1183 } elsif ($opt eq 'cpulimit') {
1184 $conf->{$opt} = $value;
1185 push @nohotplug, $opt; # fixme: hotplug
1187 } elsif ($opt eq 'cpuunits') {
1188 $conf->{$opt} = $value;
1189 write_cgroup_value
("cpu", $vmid, "cpu.shares", $value);
1190 } elsif ($opt eq 'description') {
1191 $conf->{$opt} = PVE
::Tools
::encode_text
($value);
1192 } elsif ($opt =~ m/^net(\d+)$/) {
1194 my $net = parse_lxc_network
($value);
1196 $conf->{$opt} = print_lxc_network
($net);
1198 update_net
($vmid, $conf, $opt, $net, $netid, $rootdir);
1200 } elsif ($opt eq 'protection') {
1201 $conf->{$opt} = $value ?
1 : 0;
1202 } elsif ($opt =~ m/^mp(\d+)$/) {
1203 $conf->{$opt} = $value;
1204 push @$new_disks, $opt;
1205 push @nohotplug, $opt;
1207 } elsif ($opt eq 'rootfs') {
1208 die "implement me: $opt";
1210 die "implement me: $opt";
1212 write_config
($vmid, $conf) if $running;
1215 if ($running && scalar(@nohotplug)) {
1216 die "unable to modify " . join(',', @nohotplug) . " while container is running\n";
1220 my $storage_cfg = PVE
::Storage
::config
();
1221 create_disks
($storage_cfg, $vmid, $conf, $conf);
1222 mount_all
($vmid, $storage_cfg, $conf, $new_disks, 1);
1223 umount_all
($vmid, $storage_cfg, $conf, 0);
1227 sub has_dev_console
{
1230 return !(defined($conf->{console
}) && !$conf->{console
});
1236 return $conf->{tty
} // $confdesc->{tty
}->{default};
1242 return $conf->{cmode
} // $confdesc->{cmode
}->{default};
1245 sub get_console_command
{
1246 my ($vmid, $conf) = @_;
1248 my $cmode = get_cmode
($conf);
1250 if ($cmode eq 'console') {
1251 return ['lxc-console', '-n', $vmid, '-t', 0];
1252 } elsif ($cmode eq 'tty') {
1253 return ['lxc-console', '-n', $vmid];
1254 } elsif ($cmode eq 'shell') {
1255 return ['lxc-attach', '--clear-env', '-n', $vmid];
1257 die "internal error";
1261 sub get_primary_ips
{
1264 # return data from net0
1266 return undef if !defined($conf->{net0
});
1267 my $net = parse_lxc_network
($conf->{net0
});
1269 my $ipv4 = $net->{ip
};
1271 if ($ipv4 =~ /^(dhcp|manual)$/) {
1277 my $ipv6 = $net->{ip6
};
1279 if ($ipv6 =~ /^(dhcp|manual)$/) {
1286 return ($ipv4, $ipv6);
1290 sub destroy_lxc_container
{
1291 my ($storage_cfg, $vmid, $conf) = @_;
1293 foreach_mountpoint
($conf, sub {
1294 my ($ms, $mountpoint) = @_;
1295 my ($vtype, $name, $owner) = PVE
::Storage
::parse_volname
($storage_cfg, $mountpoint->{volume
});
1296 PVE
::Storage
::vdisk_free
($storage_cfg, $mountpoint->{volume
}) if $vmid == $owner;
1299 rmdir "/var/lib/lxc/$vmid/rootfs";
1300 unlink "/var/lib/lxc/$vmid/config";
1301 rmdir "/var/lib/lxc/$vmid";
1302 destroy_config
($vmid);
1304 #my $cmd = ['lxc-destroy', '-n', $vmid ];
1305 #PVE::Tools::run_command($cmd);
1308 sub vm_stop_cleanup
{
1309 my ($storage_cfg, $vmid, $conf, $keepActive) = @_;
1314 my $vollist = get_vm_volumes
($conf);
1315 PVE
::Storage
::deactivate_volumes
($storage_cfg, $vollist);
1318 warn $@ if $@; # avoid errors - just warn
1321 my $safe_num_ne = sub {
1324 return 0 if !defined($a) && !defined($b);
1325 return 1 if !defined($a);
1326 return 1 if !defined($b);
1331 my $safe_string_ne = sub {
1334 return 0 if !defined($a) && !defined($b);
1335 return 1 if !defined($a);
1336 return 1 if !defined($b);
1342 my ($vmid, $conf, $opt, $newnet, $netid, $rootdir) = @_;
1344 if ($newnet->{type
} ne 'veth') {
1345 # for when there are physical interfaces
1346 die "cannot update interface of type $newnet->{type}";
1349 my $veth = "veth${vmid}i${netid}";
1350 my $eth = $newnet->{name
};
1352 if (my $oldnetcfg = $conf->{$opt}) {
1353 my $oldnet = parse_lxc_network
($oldnetcfg);
1355 if (&$safe_string_ne($oldnet->{hwaddr
}, $newnet->{hwaddr
}) ||
1356 &$safe_string_ne($oldnet->{name
}, $newnet->{name
})) {
1358 PVE
::Network
::veth_delete
($veth);
1359 delete $conf->{$opt};
1360 write_config
($vmid, $conf);
1362 hotplug_net
($vmid, $conf, $opt, $newnet, $netid);
1364 } elsif (&$safe_string_ne($oldnet->{bridge
}, $newnet->{bridge
}) ||
1365 &$safe_num_ne($oldnet->{tag
}, $newnet->{tag
}) ||
1366 &$safe_num_ne($oldnet->{firewall
}, $newnet->{firewall
})) {
1368 if ($oldnet->{bridge
}) {
1369 PVE
::Network
::tap_unplug
($veth);
1370 foreach (qw(bridge tag firewall)) {
1371 delete $oldnet->{$_};
1373 $conf->{$opt} = print_lxc_network
($oldnet);
1374 write_config
($vmid, $conf);
1377 PVE
::Network
::tap_plug
($veth, $newnet->{bridge
}, $newnet->{tag
}, $newnet->{firewall
});
1378 foreach (qw(bridge tag firewall)) {
1379 $oldnet->{$_} = $newnet->{$_} if $newnet->{$_};
1381 $conf->{$opt} = print_lxc_network
($oldnet);
1382 write_config
($vmid, $conf);
1385 hotplug_net
($vmid, $conf, $opt, $newnet, $netid);
1388 update_ipconfig
($vmid, $conf, $opt, $eth, $newnet, $rootdir);
1392 my ($vmid, $conf, $opt, $newnet, $netid) = @_;
1394 my $veth = "veth${vmid}i${netid}";
1395 my $vethpeer = $veth . "p";
1396 my $eth = $newnet->{name
};
1398 PVE
::Network
::veth_create
($veth, $vethpeer, $newnet->{bridge
}, $newnet->{hwaddr
});
1399 PVE
::Network
::tap_plug
($veth, $newnet->{bridge
}, $newnet->{tag
}, $newnet->{firewall
});
1401 # attach peer in container
1402 my $cmd = ['lxc-device', '-n', $vmid, 'add', $vethpeer, "$eth" ];
1403 PVE
::Tools
::run_command
($cmd);
1405 # link up peer in container
1406 $cmd = ['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', '/sbin/ip', 'link', 'set', $eth ,'up' ];
1407 PVE
::Tools
::run_command
($cmd);
1409 my $done = { type
=> 'veth' };
1410 foreach (qw(bridge tag firewall hwaddr name)) {
1411 $done->{$_} = $newnet->{$_} if $newnet->{$_};
1413 $conf->{$opt} = print_lxc_network
($done);
1415 write_config
($vmid, $conf);
1418 sub update_ipconfig
{
1419 my ($vmid, $conf, $opt, $eth, $newnet, $rootdir) = @_;
1421 my $lxc_setup = PVE
::LXC
::Setup-
>new($conf, $rootdir);
1423 my $optdata = parse_lxc_network
($conf->{$opt});
1427 my $cmdargs = shift;
1428 PVE
::Tools
::run_command
(['lxc-attach', '-n', $vmid, '-s', 'NETWORK', '--', @_], %$cmdargs);
1430 my $ipcmd = sub { &$nscmd({}, '/sbin/ip', @_) };
1432 my $change_ip_config = sub {
1433 my ($ipversion) = @_;
1435 my $family_opt = "-$ipversion";
1436 my $suffix = $ipversion == 4 ?
'' : $ipversion;
1437 my $gw= "gw$suffix";
1438 my $ip= "ip$suffix";
1440 my $newip = $newnet->{$ip};
1441 my $newgw = $newnet->{$gw};
1442 my $oldip = $optdata->{$ip};
1444 my $change_ip = &$safe_string_ne($oldip, $newip);
1445 my $change_gw = &$safe_string_ne($optdata->{$gw}, $newgw);
1447 return if !$change_ip && !$change_gw;
1449 # step 1: add new IP, if this fails we cancel
1450 if ($change_ip && $newip && $newip !~ /^(?:auto|dhcp)$/) {
1451 eval { &$ipcmd($family_opt, 'addr', 'add', $newip, 'dev', $eth); };
1458 # step 2: replace gateway
1459 # If this fails we delete the added IP and cancel.
1460 # If it succeeds we save the config and delete the old IP, ignoring
1461 # errors. The config is then saved.
1462 # Note: 'ip route replace' can add
1465 eval { &$ipcmd($family_opt, 'route', 'replace', 'default', 'via', $newgw); };
1468 # the route was not replaced, the old IP is still available
1469 # rollback (delete new IP) and cancel
1471 eval { &$ipcmd($family_opt, 'addr', 'del', $newip, 'dev', $eth); };
1472 warn $@ if $@; # no need to die here
1477 eval { &$ipcmd($family_opt, 'route', 'del', 'default'); };
1478 # if the route was not deleted, the guest might have deleted it manually
1484 # from this point on we save the configuration
1485 # step 3: delete old IP ignoring errors
1486 if ($change_ip && $oldip && $oldip !~ /^(?:auto|dhcp)$/) {
1487 # We need to enable promote_secondaries, otherwise our newly added
1488 # address will be removed along with the old one.
1491 if ($ipversion == 4) {
1492 &$nscmd({ outfunc
=> sub { $promote = int(shift) } },
1493 'cat', "/proc/sys/net/ipv4/conf/$eth/promote_secondaries");
1494 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=1");
1496 &$ipcmd($family_opt, 'addr', 'del', $oldip, 'dev', $eth);
1498 warn $@ if $@; # no need to die here
1500 if ($ipversion == 4) {
1501 &$nscmd({}, 'sysctl', "net.ipv4.conf.$eth.promote_secondaries=$promote");
1505 foreach my $property ($ip, $gw) {
1506 if ($newnet->{$property}) {
1507 $optdata->{$property} = $newnet->{$property};
1509 delete $optdata->{$property};
1512 $conf->{$opt} = print_lxc_network
($optdata);
1513 write_config
($vmid, $conf);
1514 $lxc_setup->setup_network($conf);
1517 &$change_ip_config(4);
1518 &$change_ip_config(6);
1522 # Internal snapshots
1524 # NOTE: Snapshot create/delete involves several non-atomic
1525 # action, and can take a long time.
1526 # So we try to avoid locking the file and use 'lock' variable
1527 # inside the config file instead.
1529 my $snapshot_copy_config = sub {
1530 my ($source, $dest) = @_;
1532 foreach my $k (keys %$source) {
1533 next if $k eq 'snapshots';
1534 next if $k eq 'snapstate';
1535 next if $k eq 'snaptime';
1536 next if $k eq 'vmstate';
1537 next if $k eq 'lock';
1538 next if $k eq 'digest';
1539 next if $k eq 'description';
1541 $dest->{$k} = $source->{$k};
1545 my $snapshot_prepare = sub {
1546 my ($vmid, $snapname, $comment) = @_;
1550 my $updatefn = sub {
1552 my $conf = load_config
($vmid);
1554 die "you can't take a snapshot if it's a template\n"
1555 if is_template
($conf);
1559 $conf->{lock} = 'snapshot';
1561 die "snapshot name '$snapname' already used\n"
1562 if defined($conf->{snapshots
}->{$snapname});
1564 my $storecfg = PVE
::Storage
::config
();
1565 die "snapshot feature is not available\n" if !has_feature
('snapshot', $conf, $storecfg);
1567 $snap = $conf->{snapshots
}->{$snapname} = {};
1569 &$snapshot_copy_config($conf, $snap);
1571 $snap->{'snapstate'} = "prepare";
1572 $snap->{'snaptime'} = time();
1573 $snap->{'description'} = $comment if $comment;
1574 $conf->{snapshots
}->{$snapname} = $snap;
1576 write_config
($vmid, $conf);
1579 lock_container
($vmid, 10, $updatefn);
1584 my $snapshot_commit = sub {
1585 my ($vmid, $snapname) = @_;
1587 my $updatefn = sub {
1589 my $conf = load_config
($vmid);
1591 die "missing snapshot lock\n"
1592 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
1594 die "snapshot '$snapname' does not exist\n"
1595 if !defined($conf->{snapshots
}->{$snapname});
1597 die "wrong snapshot state\n"
1598 if !($conf->{snapshots
}->{$snapname}->{'snapstate'} &&
1599 $conf->{snapshots
}->{$snapname}->{'snapstate'} eq "prepare");
1601 delete $conf->{snapshots
}->{$snapname}->{'snapstate'};
1602 delete $conf->{lock};
1603 $conf->{parent
} = $snapname;
1605 write_config
($vmid, $conf);
1608 lock_container
($vmid, 10 ,$updatefn);
1612 my ($feature, $conf, $storecfg, $snapname) = @_;
1616 foreach_mountpoint
($conf, sub {
1617 my ($ms, $mountpoint) = @_;
1619 return if $err; # skip further test
1621 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $mountpoint->{volume
}, $snapname);
1623 # TODO: implement support for mountpoints
1624 die "unable to handle mountpoint '$ms' - feature not implemented\n"
1628 return $err ?
0 : 1;
1631 sub snapshot_create
{
1632 my ($vmid, $snapname, $comment) = @_;
1634 my $snap = &$snapshot_prepare($vmid, $snapname, $comment);
1636 my $conf = load_config
($vmid);
1638 my $cmd = "/usr/bin/lxc-freeze -n $vmid";
1639 my $running = check_running
($vmid);
1642 PVE
::Tools
::run_command
($cmd);
1645 my $storecfg = PVE
::Storage
::config
();
1646 my $rootinfo = parse_ct_mountpoint
($conf->{rootfs
});
1647 my $volid = $rootinfo->{volume
};
1649 $cmd = "/usr/bin/lxc-unfreeze -n $vmid";
1651 PVE
::Tools
::run_command
($cmd);
1654 PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snapname);
1655 &$snapshot_commit($vmid, $snapname);
1658 snapshot_delete
($vmid, $snapname, 1);
1663 sub snapshot_delete
{
1664 my ($vmid, $snapname, $force) = @_;
1670 my $updatefn = sub {
1672 $conf = load_config
($vmid);
1674 die "you can't delete a snapshot if vm is a template\n"
1675 if is_template
($conf);
1677 $snap = $conf->{snapshots
}->{$snapname};
1681 die "snapshot '$snapname' does not exist\n" if !defined($snap);
1683 $snap->{snapstate
} = 'delete';
1685 write_config
($vmid, $conf);
1688 lock_container
($vmid, 10, $updatefn);
1690 my $storecfg = PVE
::Storage
::config
();
1692 my $del_snap = sub {
1696 if ($conf->{parent
} eq $snapname) {
1697 if ($conf->{snapshots
}->{$snapname}->{snapname
}) {
1698 $conf->{parent
} = $conf->{snapshots
}->{$snapname}->{parent
};
1700 delete $conf->{parent
};
1704 delete $conf->{snapshots
}->{$snapname};
1706 write_config
($vmid, $conf);
1709 my $rootfs = $conf->{snapshots
}->{$snapname}->{rootfs
};
1710 my $rootinfo = parse_ct_mountpoint
($rootfs);
1711 my $volid = $rootinfo->{volume
};
1714 PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snapname);
1718 if(!$err || ($err && $force)) {
1719 lock_container
($vmid, 10, $del_snap);
1721 die "Can't delete snapshot: $vmid $snapname $err\n";
1726 sub snapshot_rollback
{
1727 my ($vmid, $snapname) = @_;
1729 my $storecfg = PVE
::Storage
::config
();
1731 my $conf = load_config
($vmid);
1733 die "you can't rollback if vm is a template\n" if is_template
($conf);
1735 my $snap = $conf->{snapshots
}->{$snapname};
1737 die "snapshot '$snapname' does not exist\n" if !defined($snap);
1739 my $rootfs = $snap->{rootfs
};
1740 my $rootinfo = parse_ct_mountpoint
($rootfs);
1741 my $volid = $rootinfo->{volume
};
1743 PVE
::Storage
::volume_rollback_is_possible
($storecfg, $volid, $snapname);
1745 my $updatefn = sub {
1747 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
1748 if $snap->{snapstate
};
1752 system("lxc-stop -n $vmid --kill") if check_running
($vmid);
1754 die "unable to rollback vm $vmid: vm is running\n"
1755 if check_running
($vmid);
1757 $conf->{lock} = 'rollback';
1761 # copy snapshot config to current config
1763 my $tmp_conf = $conf;
1764 &$snapshot_copy_config($tmp_conf->{snapshots
}->{$snapname}, $conf);
1765 $conf->{snapshots
} = $tmp_conf->{snapshots
};
1766 delete $conf->{snaptime
};
1767 delete $conf->{snapname
};
1768 $conf->{parent
} = $snapname;
1770 write_config
($vmid, $conf);
1773 my $unlockfn = sub {
1774 delete $conf->{lock};
1775 write_config
($vmid, $conf);
1778 lock_container
($vmid, 10, $updatefn);
1780 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
1782 lock_container
($vmid, 5, $unlockfn);
1785 sub template_create
{
1786 my ($vmid, $conf) = @_;
1788 my $storecfg = PVE
::Storage
::config
();
1790 my $rootinfo = parse_ct_mountpoint
($conf->{rootfs
});
1791 my $volid = $rootinfo->{volume
};
1793 die "Template feature is not available for '$volid'\n"
1794 if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
1796 PVE
::Storage
::activate_volumes
($storecfg, [$volid]);
1798 my $template_volid = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
1799 $rootinfo->{volume
} = $template_volid;
1800 $conf->{rootfs
} = print_ct_mountpoint
($rootinfo, 1);
1802 write_config
($vmid, $conf);
1808 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
1811 sub mountpoint_names
{
1814 my @names = ('rootfs');
1816 for (my $i = 0; $i < $MAX_MOUNT_POINTS; $i++) {
1817 push @names, "mp$i";
1820 return $reverse ?
reverse @names : @names;
1823 sub foreach_mountpoint_full
{
1824 my ($conf, $reverse, $func) = @_;
1826 foreach my $key (mountpoint_names
($reverse)) {
1827 my $value = $conf->{$key};
1828 next if !defined($value);
1829 my $mountpoint = parse_ct_mountpoint
($value);
1830 $mountpoint->{mp
} = '/' if $key eq 'rootfs'; # just to be sure
1831 &$func($key, $mountpoint);
1835 sub foreach_mountpoint
{
1836 my ($conf, $func) = @_;
1838 foreach_mountpoint_full
($conf, 0, $func);
1841 sub foreach_mountpoint_reverse
{
1842 my ($conf, $func) = @_;
1844 foreach_mountpoint_full
($conf, 1, $func);
1847 sub check_ct_modify_config_perm
{
1848 my ($rpcenv, $authuser, $vmid, $pool, $key_list) = @_;
1850 return 1 if $authuser ne 'root@pam';
1852 foreach my $opt (@$key_list) {
1854 if ($opt eq 'cpus' || $opt eq 'cpuunits' || $opt eq 'cpulimit') {
1855 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.CPU']);
1856 } elsif ($opt eq 'disk') {
1857 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Disk']);
1858 } elsif ($opt eq 'memory' || $opt eq 'swap') {
1859 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Memory']);
1860 } elsif ($opt =~ m/^net\d+$/ || $opt eq 'nameserver' ||
1861 $opt eq 'searchdomain' || $opt eq 'hostname') {
1862 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Network']);
1864 $rpcenv->check_vm_perm($authuser, $vmid, $pool, ['VM.Config.Options']);
1872 my ($vmid, $storage_cfg, $conf, $noerr) = @_;
1874 my $rootdir = "/var/lib/lxc/$vmid/rootfs";
1875 my $volid_list = get_vm_volumes
($conf);
1877 foreach_mountpoint_reverse
($conf, sub {
1878 my ($ms, $mountpoint) = @_;
1880 my $volid = $mountpoint->{volume
};
1881 my $mount = $mountpoint->{mp
};
1883 return if !$volid || !$mount;
1885 my $mount_path = "$rootdir/$mount";
1886 $mount_path =~ s!/+!/!g;
1888 return if !PVE
::ProcFSTools
::is_mounted
($mount_path);
1891 PVE
::Tools
::run_command
(['umount', '-d', $mount_path]);
1904 my ($vmid, $storage_cfg, $conf, $mkdirs) = @_;
1906 my $rootdir = "/var/lib/lxc/$vmid/rootfs";
1907 File
::Path
::make_path
($rootdir);
1909 my $volid_list = get_vm_volumes
($conf);
1910 PVE
::Storage
::activate_volumes
($storage_cfg, $volid_list);
1913 foreach_mountpoint
($conf, sub {
1914 my ($ms, $mountpoint) = @_;
1916 my $volid = $mountpoint->{volume
};
1917 my $mount = $mountpoint->{mp
};
1919 return if !$volid || !$mount;
1921 my $image_path = PVE
::Storage
::path
($storage_cfg, $volid);
1922 my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1923 PVE
::Storage
::parse_volname
($storage_cfg, $volid);
1925 die "unable to mount base volume - internal error" if $isBase;
1927 File
::Path
::make_path
"$rootdir/$mount" if $mkdirs;
1928 mountpoint_mount
($mountpoint, $rootdir, $storage_cfg);
1932 warn "mounting container failed - $err";
1933 umount_all
($vmid, $storage_cfg, $conf, 1);
1940 sub mountpoint_mount_path
{
1941 my ($mountpoint, $storage_cfg, $snapname) = @_;
1943 return mountpoint_mount
($mountpoint, undef, $storage_cfg, $snapname);
1946 # use $rootdir = undef to just return the corresponding mount path
1947 sub mountpoint_mount
{
1948 my ($mountpoint, $rootdir, $storage_cfg, $snapname) = @_;
1950 my $volid = $mountpoint->{volume
};
1951 my $mount = $mountpoint->{mp
};
1953 return if !$volid || !$mount;
1957 if (defined($rootdir)) {
1958 $rootdir =~ s!/+$!!;
1959 $mount_path = "$rootdir/$mount";
1960 $mount_path =~ s!/+!/!g;
1961 File
::Path
::mkpath
($mount_path);
1964 my ($storage, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1966 die "unknown snapshot path for '$volid'" if !$storage && defined($snapname);
1970 my $scfg = PVE
::Storage
::storage_config
($storage_cfg, $storage);
1971 my $path = PVE
::Storage
::path
($storage_cfg, $volid, $snapname);
1973 my ($vtype, undef, undef, undef, undef, $isBase, $format) =
1974 PVE
::Storage
::parse_volname
($storage_cfg, $volid);
1976 if ($format eq 'subvol') {
1979 if ($scfg->{type
} eq 'zfspool') {
1980 my $path_arg = $path;
1981 $path_arg =~ s!^/+!!;
1982 PVE
::Tools
::run_command
(['mount', '-o', 'ro', '-t', 'zfs', $path_arg, $mount_path]);
1984 die "cannot mount subvol snapshots for storage type '$scfg->{type}'\n";
1987 PVE
::Tools
::run_command
(['mount', '-o', 'bind', $path, $mount_path]);
1990 return wantarray ?
($path, 0) : $path;
1991 } elsif ($format eq 'raw') {
1992 my $use_loopdev = 0;
1994 if ($scfg->{path
}) {
1995 push @extra_opts, '-o', 'loop';
1997 } elsif ($scfg->{type
} eq 'drbd' || $scfg->{type
} eq 'lvm' || $scfg->{type
} eq 'rbd') {
2000 die "unsupported storage type '$scfg->{type}'\n";
2003 if ($isBase || defined($snapname)) {
2004 PVE
::Tools
::run_command
(['mount', '-o', "ro", @extra_opts, $path, $mount_path]);
2006 PVE
::Tools
::run_command
(['mount', @extra_opts, $path, $mount_path]);
2009 return wantarray ?
($path, $use_loopdev) : $path;
2011 die "unsupported image format '$format'\n";
2013 } elsif ($volid =~ m
|^/dev/.+|) {
2014 PVE
::Tools
::run_command
(['mount', $volid, $mount_path]) if $mount_path;
2015 return wantarray ?
($volid, 0) : $volid;
2016 } elsif ($volid !~ m
|^/dev/.+| && $volid =~ m
|^/.+| && -d
$volid) {
2017 PVE
::Tools
::run_command
(['mount', '-o', 'bind', $volid, $mount_path]) if $mount_path;
2018 return wantarray ?
($volid, 0) : $volid;
2021 die "unsupported storage";
2024 sub get_vm_volumes
{
2025 my ($conf, $excludes) = @_;
2029 foreach_mountpoint
($conf, sub {
2030 my ($ms, $mountpoint) = @_;
2032 return if $excludes && $ms eq $excludes;
2034 my $volid = $mountpoint->{volume
};
2036 return if !$volid || $volid =~ m
|^/|;
2038 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2041 push @$vollist, $volid;
2050 PVE
::Tools
::run_command
(['mkfs.ext4', '-O', 'mmp', $dev]);
2054 my ($storage_cfg, $volid) = @_;
2056 if ($volid =~ m!^/dev/.+!) {
2061 my ($storage, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2063 die "cannot format volume '$volid' with no storage\n" if !$storage;
2065 PVE
::Storage
::activate_volumes
($storage_cfg, [$volid]);
2067 my $path = PVE
::Storage
::path
($storage_cfg, $volid);
2069 my ($vtype, undef, undef, undef, undef, $isBase, $format) =
2070 PVE
::Storage
::parse_volname
($storage_cfg, $volid);
2072 die "cannot format volume '$volid' (format == $format)\n"
2073 if $format ne 'raw';
2079 my ($storecfg, $vollist) = @_;
2081 foreach my $volid (@$vollist) {
2082 eval { PVE
::Storage
::vdisk_free
($storecfg, $volid); };
2088 my ($storecfg, $vmid, $settings, $conf) = @_;
2093 foreach_mountpoint
($settings, sub {
2094 my ($ms, $mountpoint) = @_;
2096 my $volid = $mountpoint->{volume
};
2097 my $mp = $mountpoint->{mp
};
2099 my ($storage, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2101 return if !$storage;
2103 if ($volid =~ m/^([^:\s]+):(\d+(\.\d+)?)$/) {
2104 my ($storeid, $size_gb) = ($1, $2);
2106 my $size_kb = int(${size_gb
}*1024) * 1024;
2108 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storage);
2109 # fixme: use better naming ct-$vmid-disk-X.raw?
2111 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs') {
2113 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'raw',
2115 format_disk
($storecfg, $volid);
2117 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'subvol',
2120 } elsif ($scfg->{type
} eq 'zfspool') {
2122 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'subvol',
2124 } elsif ($scfg->{type
} eq 'drbd' || $scfg->{type
} eq 'lvm') {
2126 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'raw', undef, $size_kb);
2127 format_disk
($storecfg, $volid);
2129 } elsif ($scfg->{type
} eq 'rbd') {
2131 die "krbd option must be enabled on storage type '$scfg->{type}'\n" if !$scfg->{krbd
};
2132 $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $storage, $vmid, 'raw', undef, $size_kb);
2133 format_disk
($storecfg, $volid);
2135 die "unable to create containers on storage type '$scfg->{type}'\n";
2137 push @$vollist, $volid;
2138 my $new_mountpoint = { volume
=> $volid, size
=> $size_kb*1024, mp
=> $mp };
2139 $conf->{$ms} = print_ct_mountpoint
($new_mountpoint, $ms eq 'rootfs');
2141 # use specified/existing volid
2145 # free allocated images on error
2147 destroy_disks
($storecfg, $vollist);
2153 # bash completion helper
2155 sub complete_os_templates
{
2156 my ($cmdname, $pname, $cvalue) = @_;
2158 my $cfg = PVE
::Storage
::config
();
2162 if ($cvalue =~ m/^([^:]+):/) {
2166 my $vtype = $cmdname eq 'restore' ?
'backup' : 'vztmpl';
2167 my $data = PVE
::Storage
::template_list
($cfg, $storeid, $vtype);
2170 foreach my $id (keys %$data) {
2171 foreach my $item (@{$data->{$id}}) {
2172 push @$res, $item->{volid
} if defined($item->{volid
});
2179 my $complete_ctid_full = sub {
2182 my $idlist = vmstatus
();
2184 my $active_hash = list_active_containers
();
2188 foreach my $id (keys %$idlist) {
2189 my $d = $idlist->{$id};
2190 if (defined($running)) {
2191 next if $d->{template
};
2192 next if $running && !$active_hash->{$id};
2193 next if !$running && $active_hash->{$id};
2202 return &$complete_ctid_full();
2205 sub complete_ctid_stopped
{
2206 return &$complete_ctid_full(0);
2209 sub complete_ctid_running
{
2210 return &$complete_ctid_full(1);