X-Git-Url: https://git.proxmox.com/?a=blobdiff_plain;f=PVE%2FStorage.pm;h=71d6ad78db1255286c64d48549f10894011b9094;hb=ac5c1af57cffb79ba18c6141b96131e5790c4b2d;hp=bdafdc12dc0ca1c141fdb41ffa110688ec9d3683;hpb=a97d3ee49f21a61d3df10d196140c95dde45ec27;p=pve-storage.git diff --git a/PVE/Storage.pm b/PVE/Storage.pm index bdafdc1..71d6ad7 100755 --- a/PVE/Storage.pm +++ b/PVE/Storage.pm @@ -8,15 +8,17 @@ use POSIX; 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; @@ -35,15 +37,15 @@ use PVE::Storage::ISCSIDirectPlugin; 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 => 9; # 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 => 0; # load standard plugins PVE::Storage::DirPlugin->register(); @@ -58,8 +60,8 @@ PVE::Storage::ISCSIDirectPlugin->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' ) { @@ -73,10 +75,8 @@ 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" @@ -84,11 +84,11 @@ if ( -d '/usr/share/perl5/PVE/Storage/Custom' ) { 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; }; @@ -101,10 +101,10 @@ if ( -d '/usr/share/perl5/PVE/Storage/Custom' ) { # 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 { @@ -127,6 +127,28 @@ sub lock_storage_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) = @_; @@ -136,6 +158,8 @@ sub storage_config { die "storage '$storeid' does not exist\n" if (!$noerr && !$scfg); + $convert_maxfiles_to_prune_backups->($scfg); + return $scfg; } @@ -170,7 +194,7 @@ sub storage_check_enabled { # 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) = @_; @@ -191,6 +215,26 @@ sub file_size_info { return PVE::Storage::Plugin::file_size_info($filename, $timeout); } +sub get_volume_notes { + my ($cfg, $volid, $timeout) = @_; + + 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_notes($scfg, $storeid, $volname, $timeout); +} + +sub update_volume_notes { + my ($cfg, $volid, $notes, $timeout) = @_; + + my ($storeid, $volname) = parse_volume_id($volid); + my $scfg = storage_config($cfg, $storeid); + my $plugin = PVE::Storage::Plugin->lookup($scfg->{type}); + + $plugin->update_volume_notes($scfg, $storeid, $volname, $notes, $timeout); +} + sub volume_size_info { my ($cfg, $volid, $timeout) = @_; @@ -285,6 +329,33 @@ sub volume_snapshot_delete { } } +# 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 +# copy - full clone is possible +# replicate - replication is possible +# snapshot - taking a snapshot is possible +# sparseinit - volume is sparsely initialized +# template - conversion to base image 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: +# valid_target_formats - list of formats for the target of a copy/clone +# operation that the caller could work with. The +# format of $volid is always considered valid and if +# no list is specified, all formats are considered valid. sub volume_has_feature { my ($cfg, $feature, $volid, $snap, $running, $opts) = @_; @@ -425,8 +496,15 @@ sub check_volume_access { 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); @@ -449,21 +527,6 @@ my $volume_is_base_and_used__no_lock = sub { } } 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 @@ -497,6 +560,7 @@ sub path_to_volume_id { my $tmpldir = $plugin->get_subdir($scfg, 'vztmpl'); my $backupdir = $plugin->get_subdir($scfg, 'backup'); my $privatedir = $plugin->get_subdir($scfg, 'rootdir'); + my $snippetsdir = $plugin->get_subdir($scfg, 'snippets'); if ($path =~ m!^$imagedir/(\d+)/([^/\s]+)$!) { my $vmid = $1; @@ -513,15 +577,18 @@ sub path_to_volume_id { } 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 ('iso', "$sid:backup/$name"); + return ('backup', "$sid:backup/$name"); + } elsif ($path =~ m!^$snippetsdir/([^/]+)$!) { + my $name = $1; + return ('snippets', "$sid:snippets/$name"); } } @@ -542,26 +609,45 @@ sub path { } 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 $volname_for_storage = sub { + my ($cfg, $volid, $target_storeid) = @_; + + my (undef, $name, $vmid, undef, undef, undef, $format) = parse_volname($cfg, $volid); + my $target_scfg = storage_config($cfg, $target_storeid); + + my (undef, $valid_formats) = PVE::Storage::Plugin::default_format($target_scfg); + my $format_is_valid = grep { $_ eq $format } @$valid_formats; + die "unsupported format '$format' for storage type $target_scfg->{type}\n" if !$format_is_valid; + + (my $name_without_extension = $name) =~ s/\.$format$//; + + if ($target_scfg->{path}) { + return "$vmid/$name_without_extension.$format"; + } else { + return "$name_without_extension"; + } +}; + sub storage_migrate { my ($cfg, $volid, $target_sshinfo, $target_storeid, $opts, $logfunc) = @_; @@ -573,7 +659,6 @@ sub storage_migrate { my $allow_rename = $opts->{allow_rename} ? 1 : 0; my ($storeid, $volname) = parse_volume_id($volid); - my $target_volname = $opts->{target_volname} || $volname; my $scfg = storage_config($cfg, $storeid); @@ -582,10 +667,14 @@ sub storage_migrate { 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}; + } elsif ($scfg->{type} eq $tcfg->{type}) { + $target_volname = $volname; + } else { + $target_volname = $volname_for_storage->($cfg, $volid, $target_storeid); + } my $target_volid = "${target_storeid}:${target_volname}"; @@ -595,12 +684,15 @@ sub storage_migrate { 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__'; } @@ -624,7 +716,8 @@ sub storage_migrate { 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; @@ -634,7 +727,7 @@ sub storage_migrate { 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; @@ -651,17 +744,37 @@ sub storage_migrate { }; 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); @@ -677,6 +790,8 @@ sub storage_migrate { 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); } @@ -802,7 +917,7 @@ sub vdisk_free { $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); @@ -818,13 +933,13 @@ sub vdisk_free { } 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 @@ -840,6 +955,9 @@ sub vdisk_list { 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; } } @@ -848,9 +966,8 @@ sub vdisk_list { 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}); @@ -955,8 +1072,7 @@ sub activate_storage { # 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; } @@ -1149,41 +1265,44 @@ sub scan_nfs { 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; } sub scan_zfs { - my $cmd = ['zfs', 'list', '-t', 'filesystem', '-H', '-o', 'name,avail,used']; + my $cmd = ['zfs', 'list', '-t', 'filesystem', '-Hp', '-o', 'name,avail,used']; my $res = []; run_command($cmd, outfunc => sub { @@ -1191,8 +1310,8 @@ sub scan_zfs { if ($line =~m/^(\S+)\s+(\S+)\s+(\S+)$/) { my ($pool, $size_str, $used_str) = ($1, $2, $3); - my $size = PVE::Storage::ZFSPoolPlugin::zfs_parse_size($size_str); - my $used = PVE::Storage::ZFSPoolPlugin::zfs_parse_size($used_str); + my $size = $size_str + 0; + my $used = $used_str + 0; # ignore subvolumes generated by our ZFSPoolPlugin return if $pool =~ m!/subvol-\d+-[^/]+$!; return if $pool =~ m!/basevol-\d+-[^/]+$!; @@ -1309,6 +1428,86 @@ sub foreach_volid { } } +sub decompressor_info { + my ($format, $comp) = @_; + + if ($format eq 'tgz' && !defined($comp)) { + ($format, $comp) = ('tar', 'gz'); + } + + my $decompressor = { + 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; + $decomp = $decompressor->{$format}->{$comp} if $comp; + + my $info = { + format => $format, + compression => $comp, + decompressor => $decomp, + }; + + return $info; +} + +sub archive_info { + my ($archive) = shift; + my $info; + + my $volid = basename($archive); + 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 archive info from '$archive'\n"; + } + + return $info; +} + +sub archive_remove { + my ($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) = @_; @@ -1338,7 +1537,7 @@ sub extract_vzdump_config_tar { $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; } @@ -1346,55 +1545,40 @@ sub extract_vzdump_config_tar { 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) { - my $uncomp; - if ($comp eq 'gz') { - $uncomp = ["zcat", $archive]; - } elsif ($comp eq 'lzo') { - $uncomp = ["lzop", "-d", "-c", $archive]; - } else { - die "unknown compression method '$comp'\n"; - } - $cmd = [$uncomp, ["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: / || $output =~ m/gzip: stdout: Broken pipe/) { + if ($output =~ m/lzop: Broken pipe: / || $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; @@ -1413,20 +1597,14 @@ sub extract_vzdump_config { } my $archive = abs_filesystem_path($cfg, $volid); + my $info = archive_info($archive); + my $format = $info->{format}; + my $comp = $info->{compression}; + my $type = $info->{type}; - if ($volid =~ /vzdump-(lxc|openvz)-\d+-(\d{4})_(\d{2})_(\d{2})-(\d{2})_(\d{2})_(\d{2})\.(tgz|(tar(\.(gz|lzo))?))$/) { + if ($type eq 'lxc' || $type eq 'openvz') { return extract_vzdump_config_tar($archive, qr!^(\./etc/vzdump/(pct|vps)\.conf)$!); - } elsif ($volid =~ /vzdump-qemu-\d+-(\d{4})_(\d{2})_(\d{2})-(\d{2})_(\d{2})_(\d{2})\.(tgz|((tar|vma)(\.(gz|lzo))?))$/) { - my $format; - my $comp; - if ($7 eq 'tgz') { - $format = 'tar'; - $comp = 'gz'; - } else { - $format = $9; - $comp = $11 if defined($11); - } - + } elsif ($type eq 'qemu') { if ($format eq 'tar') { return extract_vzdump_config_tar($archive, qr!\(\./qemu-server\.conf\)!); } else { @@ -1437,7 +1615,106 @@ sub extract_vzdump_config { } } -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}) { + $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); @@ -1448,18 +1725,27 @@ sub volume_export { $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); @@ -1471,21 +1757,27 @@ sub volume_export_formats { $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; @@ -1573,7 +1865,7 @@ sub get_bandwidth_limit { 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 { @@ -1652,4 +1944,16 @@ sub assert_sid_unused { 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;