Ensure usage of results disk is below configurable threshold

.circleci/ci-packages.txt

@@ -87,6 +87,7 @@ perl-Exception-Class-1.44
 perl-Export-Attrs-0.1.0
 perl-Exporter-Declare-0.114
 perl-Exporter-Tiny-1.000000
+perl-Filesys-Df
 perl-File-Copy-Recursive-0.38
 perl-File-HomeDir-1.002
 perl-File-Listing-6.04

cpanfile

@@ -38,6 +38,7 @@ requires 'File::Copy::Recursive';
 requires 'File::Map';
 requires 'File::Path';
 requires 'File::Spec';
+requires 'Filesys::Df';
 requires 'FindBin';
 requires 'Getopt::Long';
 requires 'Getopt::Long::Descriptive';

dependencies.yaml

@@ -109,6 +109,7 @@ main_requires:
   perl(DBIx::Class::Storage::Statistics):
   perl(Exporter):
   perl(Fcntl):
+  perl(Filesys::Df):
   perl(File::Basename):
   perl(File::Copy):
   perl(File::Copy::Recursive):

dist/rpm/openQA.spec

@@ -52,7 +52,7 @@
 %define common_requires perl(Archive::Extract) > 0.7 perl(Config::IniFiles) perl(Cpanel::JSON::XS) perl(Cwd) perl(Data::Dump) perl(Data::Dumper) perl(Digest::MD5) perl(Getopt::Long) perl(Minion) >= 10.12 perl(Mojolicious) >= 8.55 perl(Regexp::Common) perl(Storable) perl(Try::Tiny)
 # runtime requirements for the main package that are not required by other sub-packages
 # The following line is generated from dependencies.yaml
-%define main_requires %assetpack_requires git-core perl >= 5.20.0 perl(BSD::Resource) perl(Carp) perl(Carp::Always) perl(CommonMark) perl(Config::Tiny) perl(DBD::Pg) >= 3.7.4 perl(DBI) >= 1.632 perl(DBIx::Class) >= 0.082801 perl(DBIx::Class::DeploymentHandler) perl(DBIx::Class::DynamicDefault) perl(DBIx::Class::OptimisticLocking) perl(DBIx::Class::ResultClass::HashRefInflator) perl(DBIx::Class::Schema::Config) perl(DBIx::Class::Storage::Statistics) perl(Date::Format) perl(DateTime) perl(DateTime::Duration) perl(DateTime::Format::Pg) perl(Exporter) perl(Fcntl) perl(File::Basename) perl(File::Copy) perl(File::Copy::Recursive) perl(File::Path) perl(File::Spec) perl(FindBin) perl(Getopt::Long::Descriptive) perl(IO::Handle) perl(IPC::Run) perl(JSON::Validator) perl(LWP::UserAgent) perl(Module::Load::Conditional) perl(Module::Pluggable) perl(Mojo::Base) perl(Mojo::ByteStream) perl(Mojo::IOLoop) perl(Mojo::JSON) perl(Mojo::Pg) perl(Mojo::RabbitMQ::Client) >= 0.2 perl(Mojo::URL) perl(Mojo::Util) perl(Mojolicious::Commands) perl(Mojolicious::Plugin) perl(Mojolicious::Static) perl(Net::OpenID::Consumer) perl(POSIX) perl(Pod::POM) perl(SQL::Translator) perl(Scalar::Util) perl(Sort::Versions) perl(Text::Diff) perl(Time::HiRes) perl(Time::ParseDate) perl(Time::Piece) perl(Time::Seconds) perl(URI::Escape) perl(YAML::PP) >= 0.026 perl(YAML::XS) perl(aliased) perl(base) perl(constant) perl(diagnostics) perl(strict) perl(warnings)
+%define main_requires %assetpack_requires git-core perl >= 5.20.0 perl(BSD::Resource) perl(Carp) perl(Carp::Always) perl(CommonMark) perl(Config::Tiny) perl(DBD::Pg) >= 3.7.4 perl(DBI) >= 1.632 perl(DBIx::Class) >= 0.082801 perl(DBIx::Class::DeploymentHandler) perl(DBIx::Class::DynamicDefault) perl(DBIx::Class::OptimisticLocking) perl(DBIx::Class::ResultClass::HashRefInflator) perl(DBIx::Class::Schema::Config) perl(DBIx::Class::Storage::Statistics) perl(Date::Format) perl(DateTime) perl(DateTime::Duration) perl(DateTime::Format::Pg) perl(Exporter) perl(Fcntl) perl(File::Basename) perl(File::Copy) perl(File::Copy::Recursive) perl(File::Path) perl(File::Spec) perl(Filesys::Df) perl(FindBin) perl(Getopt::Long::Descriptive) perl(IO::Handle) perl(IPC::Run) perl(JSON::Validator) perl(LWP::UserAgent) perl(Module::Load::Conditional) perl(Module::Pluggable) perl(Mojo::Base) perl(Mojo::ByteStream) perl(Mojo::IOLoop) perl(Mojo::JSON) perl(Mojo::Pg) perl(Mojo::RabbitMQ::Client) >= 0.2 perl(Mojo::URL) perl(Mojo::Util) perl(Mojolicious::Commands) perl(Mojolicious::Plugin) perl(Mojolicious::Static) perl(Net::OpenID::Consumer) perl(POSIX) perl(Pod::POM) perl(SQL::Translator) perl(Scalar::Util) perl(Sort::Versions) perl(Text::Diff) perl(Time::HiRes) perl(Time::ParseDate) perl(Time::Piece) perl(Time::Seconds) perl(URI::Escape) perl(YAML::PP) >= 0.026 perl(YAML::XS) perl(aliased) perl(base) perl(constant) perl(diagnostics) perl(strict) perl(warnings)
 # The following line is generated from dependencies.yaml
 %define client_requires curl git-core jq perl(Getopt::Long::Descriptive) perl(IO::Socket::SSL) >= 2.009 perl(IPC::Run) perl(JSON::Validator) perl(LWP::Protocol::https) perl(LWP::UserAgent) perl(Test::More) perl(YAML::PP) >= 0.020 perl(YAML::XS)
 # The following line is generated from dependencies.yaml

etc/openqa/openqa.ini

@@ -144,6 +144,9 @@ blocklist = job_grab job_done
 # Specify the number of screenshot ID ranges (with a size as configured by screenshot_cleanup_batch_size) to process in a single Minion
 # job (reduce to avoid Minion jobs from running very long and possibly being interrupted, increase to reduce the number of Minion jobs)
 #screenshot_cleanup_batches_per_minion_job = 450
+# Extends the job result cleanup to ensure the partition results are stored on does not become too full
+# (still experimental, relies on df)
+#results_min_free_disk_space_percentage = 0
 
 [job_settings_ui]
 # Specify the keys of job settings which reference a file and should therefore be rendered

lib/OpenQA/Schema/Result/Jobs.pm

@@ -35,6 +35,7 @@ use OpenQA::Utils (
 use OpenQA::App;
 use OpenQA::Jobs::Constants;
 use OpenQA::JobDependencies::Constants;
+use OpenQA::ScreenshotDeletion;
 use File::Basename qw(basename dirname);
 use File::Spec::Functions 'catfile';
 use File::Path ();
@@ -1162,6 +1163,13 @@ sub _delete_returning_size {
     return $size;
 }
 
+sub _delete_returning_size_from_array {
+    my ($array_of_collections) = @_;
+    my $deleted_size = 0;
+    $deleted_size += $_->reduce(sub { $a + _delete_returning_size($b) }, 0) for @$array_of_collections;
+    return $deleted_size;
+}
+
 sub delete_logs {
     my ($self) = @_;
 
@@ -1174,9 +1182,62 @@ sub delete_logs {
         path($result_dir, 'ulogs')->list_tree({hidden => 1}),
         find_video_files($result_dir),
     );
-    my $deleted_size = 0;
-    $deleted_size += $_->reduce(sub { $a + _delete_returning_size($b) }, 0) for @files;
+    my $deleted_size = _delete_returning_size_from_array(\@files);
     $self->update({logs_present => 0, result_size => \"result_size - $deleted_size"});
+    return $deleted_size;
+}
+
+sub delete_videos {
+    my ($self) = @_;
+
+    my $result_dir = $self->result_dir;
+    return 0 unless $result_dir;
+
+    my @files        = (find_video_files($result_dir), Mojo::Collection->new(path($result_dir, 'video_time.vtt')));
+    my $deleted_size = _delete_returning_size_from_array(\@files);
+    $self->update({result_size => \"result_size - $deleted_size"});    # considering logs still present here
+    return $deleted_size;
+}
+
+sub delete_results {
+    my ($self) = @_;
+
+    # delete the entire results directory
+    my $deleted_size = 0;
+    my $result_dir   = $self->result_dir;
+    if ($result_dir && -d $result_dir) {
+        $result_dir = path($result_dir);
+        $deleted_size += _delete_returning_size_from_array([$result_dir->list_tree({hidden => 1})]);
+        $result_dir->remove_tree;
+    }
+
+    # delete all screenshot links and all exclusively used screenshots
+    my $job_id                          = $self->id;
+    my $exclusively_used_screenshot_ids = $self->exclusively_used_screenshot_ids;
+    my $schema                          = $self->result_source->schema;
+    my $screenshots                     = $schema->resultset('Screenshots');
+    my $screenshot_deletion
+      = OpenQA::ScreenshotDeletion->new(dbh => $schema->storage->dbh, deleted_size => \$deleted_size);
+    $self->screenshot_links->delete;
+    $screenshot_deletion->delete_screenshot($_, $screenshots->find($_)->filename) for @$exclusively_used_screenshot_ids;
+    $self->update({logs_present => 0, result_size => 0});
+    return $deleted_size;
+}
+
+sub exclusively_used_screenshot_ids {
+    my ($self) = @_;
+
+    my $job_id = $self->id;
+    my $sth    = $self->result_source->schema->storage->dbh->prepare(
+        <<'END_SQL'
+        select distinct screenshot_id from screenshots
+        join screenshot_links on screenshots.id=screenshot_links.screenshot_id
+        where job_id = ?
+          and not exists(select job_id as screenshot_usage from screenshot_links where screenshot_id = id and job_id != ? limit 1);
+END_SQL
+    );
+    $sth->execute($job_id, $job_id);
+    return [map { $_->[0] } @{$sth->fetchall_arrayref // []}];
 }
 
 sub num_prefix_dir {

lib/OpenQA/ScreenshotDeletion.pm

@@ -0,0 +1,73 @@
+# Copyright (C) 2020 SUSE LLC
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, see <http://www.gnu.org/licenses/>.
+
+package OpenQA::ScreenshotDeletion;
+use Mojo::Base -base;
+
+use File::Basename qw(basename dirname);
+use File::Spec::Functions qw(catfile);
+use OpenQA::Log qw(log_debug);
+use OpenQA::Utils qw(imagesdir);
+
+sub new {
+    my ($class, %args) = @_;
+
+    my $self = $class->SUPER::new;
+    $self->{_deletion_query} = $args{dbh}->prepare('DELETE FROM screenshots WHERE id = ?');
+    $self->{_imagesdir}      = $args{imagesdir} // imagesdir();
+    $self->{_deleted_size}   = $args{deleted_size};
+    return $self;
+}
+
+sub delete_screenshot {
+    my ($self, $screenshot_id, $screenshot_filename) = @_;
+
+    my $screenshot_path = catfile($self->{_imagesdir}, $screenshot_filename);
+    my $thumb_path      = catfile(dirname($screenshot_path), '.thumbs', basename($screenshot_filename));
+
+    # delete screenshot in database first
+    # note: This might fail due to foreign key violation because a new screenshot link might
+    #       have just been created. In this case the screenshot should not be deleted in the
+    #       database or the file system.
+    return undef unless eval { $self->{_deletion_query}->execute($screenshot_id); 1 };
+
+    # keep track of the deleted size
+    my ($deleted_size, $screenshot_size, $thumb_size) = $self->{_deleted_size};
+    if ($deleted_size) {
+        $screenshot_size = -s $screenshot_path;
+        $thumb_size      = -s $thumb_path;
+    }
+
+    unless (unlink($screenshot_path, $thumb_path) == 2) {
+        if (-e $screenshot_path) {
+            log_debug qq{Can't remove screenshot "$screenshot_path"};
+        }
+        elsif ($deleted_size && $screenshot_size) {
+            $$deleted_size += $screenshot_size;
+        }
+        if (-e $thumb_path) {
+            log_debug qq{Can't remove thumbnail "$thumb_path"};
+        }
+        elsif ($deleted_size && $thumb_size) {
+            $$deleted_size += $thumb_size;
+        }
+    }
+    elsif ($deleted_size) {
+        $$deleted_size += $screenshot_size if $screenshot_size;
+        $$deleted_size += $thumb_size      if $thumb_size;
+    }
+}
+
+1;

lib/OpenQA/Setup.pm

@@ -130,6 +130,7 @@ sub read_config {
             untracked_assets_storage_duration         => 14,
             screenshot_cleanup_batch_size             => OpenQA::Task::Job::Limit::DEFAULT_SCREENSHOTS_PER_BATCH,
             screenshot_cleanup_batches_per_minion_job => OpenQA::Task::Job::Limit::DEFAULT_BATCHES_PER_MINION_JOB,
+            results_min_free_disk_space_percentage    => undef,
         },
         job_settings_ui => {
             keys_to_render_as_links => '',