use IO::Select;
use IO::File;
use IO::Socket::IP;
+use IPC::Open3;
use File::Basename;
use File::Path;
use Cwd 'abs_path';
use Socket;
+use Time::Local qw(timelocal);
use PVE::Tools qw(run_command file_read_firstline dir_glob_foreach $IPV6RE);
use PVE::Cluster qw(cfs_read_file cfs_write_file cfs_lock_file);
use PVE::DataCenterConfig;
-use PVE::Exception qw(raise_param_exc);
+use PVE::Exception qw(raise_param_exc raise);
use PVE::JSONSchema;
use PVE::INotify;
use PVE::RPCEnvironment;
use PVE::Storage::GlusterfsPlugin;
use PVE::Storage::ZFSPoolPlugin;
use PVE::Storage::ZFSPlugin;
-use PVE::Storage::DRBDPlugin;
use PVE::Storage::PBSPlugin;
+use PVE::Storage::BTRFSPlugin;
-# Storage API version. Icrement it on changes in storage API interface.
-use constant APIVER => 5;
+# Storage API version. Increment it on changes in storage API interface.
+use constant APIVER => 10;
# Age is the number of versions we're backward compatible with.
# This is like having 'current=APIVER' and age='APIAGE' in libtool,
# see https://www.gnu.org/software/libtool/manual/html_node/Libtool-versioning.html
-use constant APIAGE => 4;
+use constant APIAGE => 1;
# load standard plugins
PVE::Storage::DirPlugin->register();
PVE::Storage::GlusterfsPlugin->register();
PVE::Storage::ZFSPoolPlugin->register();
PVE::Storage::ZFSPlugin->register();
-PVE::Storage::DRBDPlugin->register();
PVE::Storage::PBSPlugin->register();
+PVE::Storage::BTRFSPlugin->register();
# load third-party plugins
if ( -d '/usr/share/perl5/PVE/Storage/Custom' ) {
require $file;
# Check perl interface:
- die "not derived from PVE::Storage::Plugin\n"
- if !$modname->isa('PVE::Storage::Plugin');
- die "does not provide an api() method\n"
- if !$modname->can('api');
+ die "not derived from PVE::Storage::Plugin\n" if !$modname->isa('PVE::Storage::Plugin');
+ die "does not provide an api() method\n" if !$modname->can('api');
# Check storage API version and that file is really storage plugin.
my $version = $modname->api();
die "implements an API version newer than current ($version > " . APIVER . ")\n"
my $min_version = (APIVER - APIAGE);
die "API version too old, please update the plugin ($version < $min_version)\n"
if $version < $min_version;
+ # all OK, do import and register (i.e., "use")
import $file;
$modname->register();
- # If we got this far and the API version is not the same, make some
- # noise:
+ # If we got this far and the API version is not the same, make some noise:
warn "Plugin \"$modname\" is implementing an older storage API, an upgrade is recommended\n"
if $version != APIVER;
};
# initialize all plugins
PVE::Storage::Plugin->init();
-my $UDEVADM = '/sbin/udevadm';
-
our $iso_extension_re = qr/\.(?:iso|img)/i;
+our $vztmpl_extension_re = qr/\.tar\.(gz|xz|zst)/i;
+
# PVE::Storage utility functions
sub config {
}
}
+# FIXME remove maxfiles for PVE 8.0 or PVE 9.0
+my $convert_maxfiles_to_prune_backups = sub {
+ my ($scfg) = @_;
+
+ return if !$scfg;
+
+ my $maxfiles = delete $scfg->{maxfiles};
+
+ if (!defined($scfg->{'prune-backups'}) && defined($maxfiles)) {
+ my $prune_backups;
+ if ($maxfiles) {
+ $prune_backups = { 'keep-last' => $maxfiles };
+ } else { # maxfiles 0 means no limit
+ $prune_backups = { 'keep-all' => 1 };
+ }
+ $scfg->{'prune-backups'} = PVE::JSONSchema::print_property_string(
+ $prune_backups,
+ 'prune-backups'
+ );
+ }
+};
+
sub storage_config {
my ($cfg, $storeid, $noerr) = @_;
die "storage '$storeid' does not exist\n" if (!$noerr && !$scfg);
+ $convert_maxfiles_to_prune_backups->($scfg);
+
return $scfg;
}
# storage_can_replicate:
# return true if storage supports replication
-# (volumes alocated with vdisk_alloc() has replication feature)
+# (volumes allocated with vdisk_alloc() has replication feature)
sub storage_can_replicate {
my ($cfg, $storeid, $format) = @_;
return PVE::Storage::Plugin::file_size_info($filename, $timeout);
}
+sub get_volume_attribute {
+ my ($cfg, $volid, $attribute) = @_;
+
+ my ($storeid, $volname) = parse_volume_id($volid);
+ my $scfg = storage_config($cfg, $storeid);
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
+
+ return $plugin->get_volume_attribute($scfg, $storeid, $volname, $attribute);
+}
+
+sub update_volume_attribute {
+ my ($cfg, $volid, $attribute, $value) = @_;
+
+ my ($storeid, $volname) = parse_volume_id($volid);
+ my $scfg = storage_config($cfg, $storeid);
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
+
+ return $plugin->update_volume_attribute($scfg, $storeid, $volname, $attribute, $value);
+}
+
sub volume_size_info {
my ($cfg, $volid, $timeout) = @_;
}
sub volume_rollback_is_possible {
- my ($cfg, $volid, $snap) = @_;
+ my ($cfg, $volid, $snap, $blockers) = @_;
my ($storeid, $volname) = parse_volume_id($volid, 1);
if ($storeid) {
my $scfg = storage_config($cfg, $storeid);
my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
- return $plugin->volume_rollback_is_possible($scfg, $storeid, $volname, $snap);
+ return $plugin->volume_rollback_is_possible($scfg, $storeid, $volname, $snap, $blockers);
} elsif ($volid =~ m|^(/.+)$| && -e $volid) {
die "snapshot rollback file/device '$volid' is not possible\n";
} else {
}
}
+# check if a filesystem on top of a volume needs to flush its journal for
+# consistency (see fsfreeze(8)) before a snapshot is taken - needed for
+# container mountpoints
+sub volume_snapshot_needs_fsfreeze {
+ my ($cfg, $volid) = @_;
+
+ my ($storeid, $volname) = parse_volume_id($volid);
+ my $scfg = storage_config($cfg, $storeid);
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
+ return $plugin->volume_snapshot_needs_fsfreeze();
+}
+
# check if a volume or snapshot supports a given feature
# $feature - one of:
# clone - linked clone is possible
# snapshot - taking a snapshot is possible
# sparseinit - volume is sparsely initialized
# template - conversion to base image is possible
+# rename - renaming volumes is possible
# $snap - check if the feature is supported for a given snapshot
# $running - if the guest owning the volume is running
# $opts - hash with further options:
}
}
-sub volume_snapshot_list {
+sub volume_snapshot_info {
my ($cfg, $volid) = @_;
- my ($storeid, $volname) = parse_volume_id($volid, 1);
- if ($storeid) {
- my $scfg = storage_config($cfg, $storeid);
- my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
- return $plugin->volume_snapshot_list($scfg, $storeid, $volname);
- } elsif ($volid =~ m|^(/.+)$| && -e $volid) {
- die "send file/device '$volid' is not possible\n";
- } else {
- die "unable to parse volume ID '$volid'\n";
- }
- # return an empty array if dataset does not exist.
+ my ($storeid, $volname) = parse_volume_id($volid);
+ my $scfg = storage_config($cfg, $storeid);
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
+ return $plugin->volume_snapshot_info($scfg, $storeid, $volname);
}
sub get_image_dir {
return undef;
}
-my $volume_is_base_and_used__no_lock = sub {
- my ($scfg, $storeid, $plugin, $volname) = @_;
+# NOTE: this check does not work for LVM-thin, where the clone -> base
+# reference is not encoded in the volume ID.
+# see note in PVE::Storage::LvmThinPlugin for details.
+sub volume_is_base_and_used {
+ my ($cfg, $volid) = @_;
+
+ my ($storeid, $volname) = parse_volume_id($volid);
+ my $scfg = storage_config($cfg, $storeid);
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
my ($vtype, $name, $vmid, undef, undef, $isBase, undef) =
$plugin->parse_volname($volname);
}
}
return 0;
-};
-
-# NOTE: this check does not work for LVM-thin, where the clone -> base
-# reference is not encoded in the volume ID.
-# see note in PVE::Storage::LvmThinPlugin for details.
-sub volume_is_base_and_used {
- my ($cfg, $volid) = @_;
-
- my ($storeid, $volname) = parse_volume_id($volid);
- my $scfg = storage_config($cfg, $storeid);
- my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
-
- $plugin->cluster_lock_storage($storeid, $scfg->{shared}, undef, sub {
- return &$volume_is_base_and_used__no_lock($scfg, $storeid, $plugin, $volname);
- });
}
# try to map a filesystem path to a volume identifier
} elsif ($path =~ m!^$isodir/([^/]+$iso_extension_re)$!) {
my $name = $1;
return ('iso', "$sid:iso/$name");
- } elsif ($path =~ m!^$tmpldir/([^/]+\.tar\.gz)$!) {
+ } elsif ($path =~ m!^$tmpldir/([^/]+$vztmpl_extension_re)$!) {
my $name = $1;
return ('vztmpl', "$sid:vztmpl/$name");
} elsif ($path =~ m!^$privatedir/(\d+)$!) {
my $vmid = $1;
return ('rootdir', "$sid:rootdir/$vmid");
- } elsif ($path =~ m!^$backupdir/([^/]+\.(tar|tar\.gz|tar\.lzo|tgz|vma|vma\.gz|vma\.lzo))$!) {
+ } elsif ($path =~ m!^$backupdir/([^/]+\.(?:tgz|(?:(?:tar|vma)(?:\.(?:${\PVE::Storage::Plugin::COMPRESSOR_RE}))?)))$!) {
my $name = $1;
return ('backup', "$sid:backup/$name");
} elsif ($path =~ m!^$snippetsdir/([^/]+)$!) {
}
sub abs_filesystem_path {
- my ($cfg, $volid) = @_;
+ my ($cfg, $volid, $allow_blockdev) = @_;
my $path;
if (parse_volume_id ($volid, 1)) {
activate_volumes($cfg, [ $volid ]);
$path = PVE::Storage::path($cfg, $volid);
} else {
- if (-f $volid) {
+ if (-f $volid || ($allow_blockdev && -b $volid)) {
my $abspath = abs_path($volid);
if ($abspath && $abspath =~ m|^(/.+)$|) {
$path = $1; # untaint any path
}
}
}
-
- die "can't find file '$volid'\n" if !($path && -f $path);
+ die "can't find file '$volid'\n"
+ if !($path && (-f $path || ($allow_blockdev && -b $path)));
return $path;
}
my $tcfg = storage_config($cfg, $target_storeid);
- my $vtype = (parse_volname($cfg, $volid))[0];
-
- die "content type '$vtype' is not available on storage '$target_storeid'\n"
- if !$tcfg->{content}->{$vtype};
-
my $target_volname;
if ($opts->{target_volname}) {
$target_volname = $opts->{target_volname};
my $ssh_base = PVE::SSHInfo::ssh_info_to_command_base($target_sshinfo);
local $ENV{RSYNC_RSH} = PVE::Tools::cmd2string($ssh_base);
- my @cstream = ([ '/usr/bin/cstream', '-t', $ratelimit_bps ])
- if defined($ratelimit_bps);
+ my @cstream;
+ if (defined($ratelimit_bps)) {
+ @cstream = ([ '/usr/bin/cstream', '-t', $ratelimit_bps ]);
+ $logfunc->("using a bandwidth limit of $ratelimit_bps bps for transferring '$volid'") if $logfunc;
+ }
my $migration_snapshot;
if (!defined($snapshot)) {
- if ($scfg->{type} eq 'zfspool') {
+ if ($scfg->{type} eq 'zfspool' || $scfg->{type} eq 'btrfs') {
$migration_snapshot = 1;
$snapshot = '__migration__';
}
my $send = ['pvesm', 'export', $volid, $format, '-', '-with-snapshots', $with_snapshots];
my $recv = [@$ssh, '--', 'pvesm', 'import', $target_volid, $format, $import_fn, '-with-snapshots', $with_snapshots];
if (defined($snapshot)) {
- push @$send, '-snapshot', $snapshot
+ push @$send, '-snapshot', $snapshot;
+ push @$recv, '-snapshot', $snapshot;
}
if ($migration_snapshot) {
push @$recv, '-delete-snapshot', $snapshot;
if (defined($base_snapshot)) {
# Check if the snapshot exists on the remote side:
push @$send, '-base', $base_snapshot;
- push @$recv, '-base', $base_snapshot;
+ push @$recv, '-base', $base_snapshot if $target_apiver >= 9;
}
my $new_volid;
};
volume_snapshot($cfg, $volid, $snapshot) if $migration_snapshot;
+
+ if (defined($snapshot)) {
+ activate_volumes($cfg, [$volid], $snapshot);
+ } else {
+ activate_volumes($cfg, [$volid]);
+ }
+
eval {
if ($insecure) {
- open(my $info, '-|', @$recv)
+ my $input = IO::File->new();
+ my $info = IO::File->new();
+ open3($input, $info, $info, @{$recv})
or die "receive command failed: $!\n";
- my ($ip) = <$info> =~ /^($PVE::Tools::IPRE)$/ or die "no tunnel IP received\n";
- my ($port) = <$info> =~ /^(\d+)$/ or die "no tunnel port received\n";
+ close($input);
+
+ my $try_ip = <$info> // '';
+ my ($ip) = $try_ip =~ /^($PVE::Tools::IPRE)$/ # untaint
+ or die "no tunnel IP received, got '$try_ip'\n";
+
+ my $try_port = <$info> // '';
+ my ($port) = $try_port =~ /^(\d+)$/ # untaint
+ or die "no tunnel port received, got '$try_port'\n";
+
my $socket = IO::Socket::IP->new(PeerHost => $ip, PeerPort => $port, Type => SOCK_STREAM)
or die "failed to connect to tunnel at $ip:$port\n";
# we won't be reading from the socket
shutdown($socket, 0);
- run_command([$send, @cstream], output => '>&'.fileno($socket), errfunc => $logfunc);
+
+ eval { run_command([$send, @cstream], output => '>&'.fileno($socket), errfunc => $logfunc); };
+ my $send_error = $@;
+
# don't close the connection entirely otherwise the receiving end
# might not get all buffered data (and fails with 'connection reset by peer')
shutdown($socket, 1);
die "import failed: $!\n" if $!;
die "import failed: exit code ".($?>>8)."\n";
}
+
+ die $send_error if $send_error;
} else {
run_command([$send, @cstream, $recv], logfunc => $match_volid_and_log);
}
$plugin->cluster_lock_storage($storeid, $scfg->{shared}, undef, sub {
# LVM-thin allows deletion of still referenced base volumes!
die "base volume '$volname' is still in use by linked clones\n"
- if &$volume_is_base_and_used__no_lock($scfg, $storeid, $plugin, $volname);
+ if volume_is_base_and_used($cfg, $volid);
my (undef, undef, undef, undef, undef, $isBase, $format) =
$plugin->parse_volname($volname);
}
sub vdisk_list {
- my ($cfg, $storeid, $vmid, $vollist) = @_;
+ my ($cfg, $storeid, $vmid, $vollist, $ctype) = @_;
my $ids = $cfg->{ids};
storage_check_enabled($cfg, $storeid) if ($storeid);
- my $res = {};
+ my $res = $storeid ? { $storeid => [] } : {};
# prepare/activate/refresh all storages
foreach my $sid (keys %$ids) {
next if $storeid && $storeid ne $sid;
next if !storage_check_enabled($cfg, $sid, undef, 1);
+ my $content = $ids->{$sid}->{content};
+ next if defined($ctype) && !$content->{$ctype};
+ next if !($content->{rootdir} || $content->{images});
push @$storage_list, $sid;
}
}
activate_storage_list($cfg, $storage_list, $cache);
- foreach my $sid (keys %$ids) {
+ for my $sid ($storage_list->@*) {
next if $storeid && $storeid ne $sid;
- next if !storage_check_enabled($cfg, $sid, undef, 1);
my $scfg = $ids->{$sid};
my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
# only call udevsettle if there are events
if ($newseq > $cache->{uevent_seqnum}) {
- my $timeout = 30;
- system ("$UDEVADM settle --timeout=$timeout"); # ignore errors
+ system ("udevadm settle --timeout=30"); # ignore errors
$cache->{uevent_seqnum} = $newseq;
}
sub scan_cifs {
my ($server_in, $user, $password, $domain) = @_;
- my $server;
- if (!($server = resolv_server ($server_in))) {
- die "unable to resolve address for server '${server_in}'\n";
- }
+ my $server = resolv_server($server_in);
+ die "unable to resolve address for server '${server_in}'\n" if !$server;
- # we support only Windows grater than 2012 cifsscan so use smb3
+ # we only support Windows 2012 and newer, so just use smb3
my $cmd = ['/usr/bin/smbclient', '-m', 'smb3', '-d', '0', '-L', $server];
- if (defined($user)) {
- die "password is required" if !defined($password);
- push @$cmd, '-U', "$user\%$password";
- push @$cmd, '-W', $domain if defined($domain);
- } else {
- push @$cmd, '-N';
- }
+ push @$cmd, '-W', $domain if defined($domain);
+
+ push @$cmd, '-N' if !defined($password);
+ local $ENV{USER} = $user if defined($user);
+ local $ENV{PASSWD} = $password if defined($password);
my $res = {};
+ my $err = '';
run_command($cmd,
- outfunc => sub {
- my $line = shift;
- if ($line =~ m/(\S+)\s*Disk\s*(\S*)/) {
- $res->{$1} = $2;
- } elsif ($line =~ m/(NT_STATUS_(\S*))/) {
- $res->{$1} = '';
- }
- },
- errfunc => sub {},
- noerr => 1
+ noerr => 1,
+ errfunc => sub {
+ $err .= "$_[0]\n"
+ },
+ outfunc => sub {
+ my $line = shift;
+ if ($line =~ m/(\S+)\s*Disk\s*(\S*)/) {
+ $res->{$1} = $2;
+ } elsif ($line =~ m/(NT_STATUS_(\S+))/) {
+ my $status = $1;
+ $err .= "unexpected status: $1\n" if uc($1) ne 'SUCCESS';
+ }
+ },
);
+ # only die if we got no share, else it's just some followup check error
+ # (like workgroup querying)
+ raise($err) if $err && !%$res;
return $res;
}
tar => {
gz => ['tar', '-z'],
lzo => ['tar', '--lzop'],
+ zst => ['tar', '--zstd'],
},
vma => {
gz => ['zcat'],
lzo => ['lzop', '-d', '-c'],
+ zst => ['zstd', '-q', '-d', '-c'],
},
};
die "ERROR: archive format not defined\n"
if !defined($decompressor->{$format});
- my $decomp = $decompressor->{$format}->{$comp} if $comp;
+ my $decomp;
+ $decomp = $decompressor->{$format}->{$comp} if $comp;
my $info = {
format => $format,
return $info;
}
+sub protection_file_path {
+ my ($path) = @_;
+
+ return "${path}.protected";
+}
+
sub archive_info {
my ($archive) = shift;
my $info;
my $volid = basename($archive);
- if ($volid =~ /vzdump-(lxc|openvz|qemu)-\d+-(?:\d{4})_(?:\d{2})_(?:\d{2})-(?:\d{2})_(?:\d{2})_(?:\d{2})\.(tgz$|tar|vma)(?:\.(gz|lzo))?$/) {
- $info = decompressor_info($2, $3);
- $info->{type} = $1;
+ if ($volid =~ /^(vzdump-(lxc|openvz|qemu)-.+\.(tgz$|tar|vma)(?:\.(${\PVE::Storage::Plugin::COMPRESSOR_RE}))?)$/) {
+ my $filename = "$1"; # untaint
+ my ($type, $format, $comp) = ($2, $3, $4);
+ my $format_re = defined($comp) ? "$format.$comp" : "$format";
+ $info = decompressor_info($format, $comp);
+ $info->{filename} = $filename;
+ $info->{type} = $type;
+
+ if ($volid =~ /^(vzdump-${type}-([1-9][0-9]{2,8})-(\d{4})_(\d{2})_(\d{2})-(\d{2})_(\d{2})_(\d{2}))\.${format_re}$/) {
+ $info->{logfilename} = "$1.log";
+ $info->{vmid} = int($2);
+ $info->{ctime} = timelocal($8, $7, $6, $5, $4 - 1, $3);
+ $info->{is_std_name} = 1;
+ } else {
+ $info->{is_std_name} = 0;
+ }
} else {
- die "ERROR: couldn't determine format and compression type\n";
+ die "ERROR: couldn't determine archive info from '$archive'\n";
}
return $info;
}
+sub archive_remove {
+ my ($archive_path) = @_;
+
+ die "cannot remove protected archive '$archive_path'\n"
+ if -e protection_file_path($archive_path);
+
+ my $dirname = dirname($archive_path);
+ my $archive_info = eval { archive_info($archive_path) } // {};
+ my $logfn = $archive_info->{logfilename};
+
+ unlink $archive_path or die "removing archive $archive_path failed: $!\n";
+
+ if (defined($logfn)) {
+ my $logpath = "$dirname/$logfn";
+ if (-e $logpath) {
+ unlink $logpath or warn "removing log file $logpath failed: $!\n";
+ }
+ }
+}
+
sub extract_vzdump_config_tar {
my ($archive, $conf_re) = @_;
$raw .= "$output\n";
};
- PVE::Tools::run_command(['tar', '-xpOf', $archive, $file, '--occurrence'], outfunc => $out);
+ run_command(['tar', '-xpOf', $archive, $file, '--occurrence'], outfunc => $out);
return wantarray ? ($raw, $file) : $raw;
}
sub extract_vzdump_config_vma {
my ($archive, $comp) = @_;
- my $cmd;
my $raw = '';
- my $out = sub {
- my $output = shift;
- $raw .= "$output\n";
- };
-
+ my $out = sub { $raw .= "$_[0]\n"; };
my $info = archive_info($archive);
$comp //= $info->{compression};
my $decompressor = $info->{decompressor};
if ($comp) {
- $cmd = [ [@$decompressor, $archive], ["vma", "config", "-"] ];
+ my $cmd = [ [@$decompressor, $archive], ["vma", "config", "-"] ];
- # in some cases, lzop/zcat exits with 1 when its stdout pipe is
- # closed early by vma, detect this and ignore the exit code later
+ # lzop/zcat exits with 1 when the pipe is closed early by vma, detect this and ignore the exit code later
my $broken_pipe;
my $errstring;
my $err = sub {
my $output = shift;
- if ($output =~ m/lzop: Broken pipe: <stdout>/ || $output =~ m/gzip: stdout: Broken pipe/) {
+ if ($output =~ m/lzop: Broken pipe: <stdout>/ || $output =~ m/gzip: stdout: Broken pipe/ || $output =~ m/zstd: error 70 : Write error.*Broken pipe/) {
$broken_pipe = 1;
} elsif (!defined ($errstring) && $output !~ m/^\s*$/) {
$errstring = "Failed to extract config from VMA archive: $output\n";
}
};
- # in other cases, the pipeline will exit with exit code 141
- # because of the broken pipe, handle / ignore this as well
- my $rc;
- eval {
- $rc = PVE::Tools::run_command($cmd, outfunc => $out, errfunc => $err, noerr => 1);
- };
+ my $rc = eval { run_command($cmd, outfunc => $out, errfunc => $err, noerr => 1) };
my $rerr = $@;
- # use exit code if no stderr output and not just broken pipe
- if (!$errstring && !$broken_pipe && $rc != 0 && $rc != 141) {
+ $broken_pipe ||= $rc == 141; # broken pipe from vma POV
+
+ if (!$errstring && !$broken_pipe && $rc != 0) {
die "$rerr\n" if $rerr;
die "config extraction failed with exit code $rc\n";
}
die "$errstring\n" if $errstring;
} else {
- # simple case without compression and weird piping behaviour
- PVE::Tools::run_command(["vma", "config", $archive], outfunc => $out);
+ run_command(["vma", "config", $archive], outfunc => $out);
}
return wantarray ? ($raw, undef) : $raw;
}
}
-sub volume_export {
+sub prune_backups {
+ my ($cfg, $storeid, $keep, $vmid, $type, $dryrun, $logfunc) = @_;
+
+ my $scfg = storage_config($cfg, $storeid);
+ die "storage '$storeid' does not support backups\n" if !$scfg->{content}->{backup};
+
+ if (!defined($keep)) {
+ die "no prune-backups options configured for storage '$storeid'\n"
+ if !defined($scfg->{'prune-backups'});
+ $keep = PVE::JSONSchema::parse_property_string('prune-backups', $scfg->{'prune-backups'});
+ }
+
+ activate_storage($cfg, $storeid);
+
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
+ return $plugin->prune_backups($scfg, $storeid, $keep, $vmid, $type, $dryrun, $logfunc);
+}
+
+my $prune_mark = sub {
+ my ($prune_entries, $keep_count, $id_func) = @_;
+
+ return if !$keep_count;
+
+ my $already_included = {};
+ my $newly_included = {};
+
+ foreach my $prune_entry (@{$prune_entries}) {
+ my $mark = $prune_entry->{mark};
+ my $id = $id_func->($prune_entry->{ctime});
+ $already_included->{$id} = 1 if defined($mark) && $mark eq 'keep';
+ }
+
+ foreach my $prune_entry (@{$prune_entries}) {
+ my $mark = $prune_entry->{mark};
+ my $id = $id_func->($prune_entry->{ctime});
+
+ next if defined($mark) || $already_included->{$id};
+
+ if (!$newly_included->{$id}) {
+ last if scalar(keys %{$newly_included}) >= $keep_count;
+ $newly_included->{$id} = 1;
+ $prune_entry->{mark} = 'keep';
+ } else {
+ $prune_entry->{mark} = 'remove';
+ }
+ }
+};
+
+sub prune_mark_backup_group {
+ my ($backup_group, $keep) = @_;
+
+ my @positive_opts = grep { $_ ne 'keep-all' && $keep->{$_} > 0 } keys $keep->%*;
+
+ if ($keep->{'keep-all'} || scalar(@positive_opts) == 0) {
+ foreach my $prune_entry (@{$backup_group}) {
+ # preserve additional information like 'protected'
+ next if $prune_entry->{mark} && $prune_entry->{mark} ne 'remove';
+ $prune_entry->{mark} = 'keep';
+ }
+ return;
+ }
+
+ my $prune_list = [ sort { $b->{ctime} <=> $a->{ctime} } @{$backup_group} ];
+
+ $prune_mark->($prune_list, $keep->{'keep-last'}, sub {
+ my ($ctime) = @_;
+ return $ctime;
+ });
+ $prune_mark->($prune_list, $keep->{'keep-hourly'}, sub {
+ my ($ctime) = @_;
+ my (undef, undef, $hour, $day, $month, $year) = localtime($ctime);
+ return "$hour/$day/$month/$year";
+ });
+ $prune_mark->($prune_list, $keep->{'keep-daily'}, sub {
+ my ($ctime) = @_;
+ my (undef, undef, undef, $day, $month, $year) = localtime($ctime);
+ return "$day/$month/$year";
+ });
+ $prune_mark->($prune_list, $keep->{'keep-weekly'}, sub {
+ my ($ctime) = @_;
+ my ($sec, $min, $hour, $day, $month, $year) = localtime($ctime);
+ my $iso_week = int(strftime("%V", $sec, $min, $hour, $day, $month, $year));
+ my $iso_week_year = int(strftime("%G", $sec, $min, $hour, $day, $month, $year));
+ return "$iso_week/$iso_week_year";
+ });
+ $prune_mark->($prune_list, $keep->{'keep-monthly'}, sub {
+ my ($ctime) = @_;
+ my (undef, undef, undef, undef, $month, $year) = localtime($ctime);
+ return "$month/$year";
+ });
+ $prune_mark->($prune_list, $keep->{'keep-yearly'}, sub {
+ my ($ctime) = @_;
+ my $year = (localtime($ctime))[5];
+ return "$year";
+ });
+
+ foreach my $prune_entry (@{$prune_list}) {
+ $prune_entry->{mark} //= 'remove';
+ }
+}
+
+sub volume_export : prototype($$$$$$$) {
my ($cfg, $fh, $volid, $format, $snapshot, $base_snapshot, $with_snapshots) = @_;
my ($storeid, $volname) = parse_volume_id($volid, 1);
$snapshot, $base_snapshot, $with_snapshots);
}
-sub volume_import {
- my ($cfg, $fh, $volid, $format, $base_snapshot, $with_snapshots, $allow_rename) = @_;
+sub volume_import : prototype($$$$$$$$) {
+ my ($cfg, $fh, $volid, $format, $snapshot, $base_snapshot, $with_snapshots, $allow_rename) = @_;
my ($storeid, $volname) = parse_volume_id($volid, 1);
die "cannot import into volume '$volid'\n" if !$storeid;
my $scfg = storage_config($cfg, $storeid);
my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
- return $plugin->volume_import($scfg, $storeid, $fh, $volname, $format,
- $base_snapshot, $with_snapshots, $allow_rename) // $volid;
-}
-
-sub volume_export_formats {
+ return $plugin->volume_import(
+ $scfg,
+ $storeid,
+ $fh,
+ $volname,
+ $format,
+ $snapshot,
+ $base_snapshot,
+ $with_snapshots,
+ $allow_rename,
+ ) // $volid;
+}
+
+sub volume_export_formats : prototype($$$$$) {
my ($cfg, $volid, $snapshot, $base_snapshot, $with_snapshots) = @_;
my ($storeid, $volname) = parse_volume_id($volid, 1);
$with_snapshots);
}
-sub volume_import_formats {
- my ($cfg, $volid, $base_snapshot, $with_snapshots) = @_;
+sub volume_import_formats : prototype($$$$$) {
+ my ($cfg, $volid, $snapshot, $base_snapshot, $with_snapshots) = @_;
my ($storeid, $volname) = parse_volume_id($volid, 1);
return if !$storeid;
my $scfg = storage_config($cfg, $storeid);
my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
- return $plugin->volume_import_formats($scfg, $storeid, $volname,
- $base_snapshot, $with_snapshots);
+ return $plugin->volume_import_formats(
+ $scfg,
+ $storeid,
+ $volname,
+ $snapshot,
+ $base_snapshot,
+ $with_snapshots,
+ );
}
sub volume_transfer_formats {
my ($cfg, $src_volid, $dst_volid, $snapshot, $base_snapshot, $with_snapshots) = @_;
my @export_formats = volume_export_formats($cfg, $src_volid, $snapshot, $base_snapshot, $with_snapshots);
- my @import_formats = volume_import_formats($cfg, $dst_volid, $base_snapshot, $with_snapshots);
+ my @import_formats = volume_import_formats($cfg, $dst_volid, $snapshot, $base_snapshot, $with_snapshots);
my %import_hash = map { $_ => 1 } @import_formats;
my @common = grep { $import_hash{$_} } @export_formats;
return @common;
return $res;
}
+sub rename_volume {
+ my ($cfg, $source_volid, $target_vmid, $target_volname) = @_;
+
+ die "no source volid provided\n" if !$source_volid;
+ die "no target VMID or target volname provided\n" if !$target_vmid && !$target_volname;
+
+ my ($storeid, $source_volname) = parse_volume_id($source_volid);
+
+ activate_storage($cfg, $storeid);
+
+ my $scfg = storage_config($cfg, $storeid);
+ my $plugin = PVE::Storage::Plugin->lookup($scfg->{type});
+
+ $target_vmid = ($plugin->parse_volname($source_volname))[3] if !$target_vmid;
+
+ return $plugin->cluster_lock_storage($storeid, $scfg->{shared}, undef, sub {
+ return $plugin->rename_volume($scfg, $storeid, $source_volname, $target_vmid, $target_volname);
+ });
+}
+
# Various io-heavy operations require io/bandwidth limits which can be
# configured on multiple levels: The global defaults in datacenter.cfg, and
# per-storage overrides. When we want to do a restore from storage A to storage
my ($operation, $storage_list, $override) = @_;
# called for each limit (global, per-storage) with the 'default' and the
- # $operation limit and should udpate $override for every limit affecting
+ # $operation limit and should update $override for every limit affecting
# us.
my $use_global_limits = 0;
my $apply_limit = sub {
return undef;
}
+# removes leading/trailing spaces and (back)slashes completely
+# substitutes every non-ASCII-alphanumerical char with '_', except '_.-'
+sub normalize_content_filename {
+ my ($filename) = @_;
+
+ chomp $filename;
+ $filename =~ s/^.*[\/\\]//;
+ $filename =~ s/[^a-zA-Z0-9_.-]/_/g;
+
+ return $filename;
+}
+
1;
projects / pve-storage.git / blobdiff