]> git.proxmox.com Git - pve-storage.git/blobdiff - PVE/Storage.pm
Add prune_backups to storage API
[pve-storage.git] / PVE / Storage.pm
index c3813944feaefcb86f37526257c0417b16d27501..6951e428d5f3d265e4c93b4ad11afb04f9a8a436 100755 (executable)
@@ -12,11 +12,12 @@ 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;
@@ -39,11 +40,11 @@ use PVE::Storage::DRBDPlugin;
 use PVE::Storage::PBSPlugin;
 
 # Storage API version. Icrement it on changes in storage API interface.
-use constant APIVER => 5;
+use constant APIVER => 6;
 # 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 => 5;
 
 # load standard plugins
 PVE::Storage::DirPlugin->register();
@@ -285,6 +286,21 @@ sub volume_snapshot_delete {
     }
 }
 
+# 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) = @_;
 
@@ -497,6 +513,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;
@@ -519,9 +536,12 @@ sub path_to_volume_id {
        } 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");
        }
     }
 
@@ -600,11 +620,6 @@ 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};
@@ -867,6 +882,8 @@ 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 !($content->{rootdir} || $content->{images});
            push @$storage_list, $sid;
        }
     }
@@ -1176,34 +1193,37 @@ 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;
 }
@@ -1336,6 +1356,85 @@ 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 = $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) = @_;
 
@@ -1365,7 +1464,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;
 }
@@ -1373,55 +1472,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: <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;
@@ -1440,20 +1524,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 {
@@ -1464,6 +1542,93 @@ sub extract_vzdump_config {
     }
 }
 
+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'});
+    }
+
+    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});
+
+       next if $already_included->{$id};
+
+       if (defined($mark)) {
+           $already_included->{$id} = 1 if $mark eq 'keep';
+           next;
+       }
+
+       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 $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 - 1, $year - 1900));
+       my $iso_week_year = int(strftime("%G", $sec, $min, $hour, $day, $month - 1, $year - 1900));
+       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 {
     my ($cfg, $fh, $volid, $format, $snapshot, $base_snapshot, $with_snapshots) = @_;