diff --git a/lib/Dobby/Boxmate/App/Command/ciprune.pm b/lib/Dobby/Boxmate/App/Command/ciprune.pm new file mode 100644 index 0000000..770fccb --- /dev/null +++ b/lib/Dobby/Boxmate/App/Command/ciprune.pm @@ -0,0 +1,115 @@ +package Dobby::Boxmate::App::Command::ciprune; +use Dobby::Boxmate::App -command; + +# ABSTRACT: destroy CI boxes that have outlived their usefulness + +use v5.36.0; +use utf8; + +use Dobby::GitLabUtil '-all'; + +sub command_names { + return qw(ci-prune ciprune); +} + +sub abstract { 'destroy leftover CI boxes' } + +sub usage_desc { '%c ci-prune %o' } + +sub opt_spec { + return ( + [ 'max-age=i', 'destroy CI boxes older than this many hours', { default => 6 } ], + [ 'dry-run|n', "don't destroy anything, just report what would be destroyed" ], + ); +} + +sub validate_args ($self, $opt, $args) { + @$args == 0 || $self->usage->die; + + $opt->max_age > 0 + || $self->usage->die({ pre_text => "--max-age must be a positive number of hours.\n\n" }); +} + +# Args: +# - droplets: an arrayref of droplet data +# - now : time in epoch sec +# - max_age : seconds past which a box is disposable +# Returns a list: +# - [ all ci boxes ] +# - [ ci boxes > max age ] +sub sort_boxes_to_prune ($self, $arg) { + require DateTime::Format::RFC3339; + + my $parser = DateTime::Format::RFC3339->new; + my $now = $arg->{now}; + + my @ci_boxes = sort {; $b->{age} <=> $a->{age} } + map {; { + droplet => $_, + age => $now - $parser->parse_datetime($_->{created_at})->epoch, + } } + grep {; $_->{name} =~ m{\Aci-run-} } + $arg->{droplets}->@*; + + my @doomed = grep {; $_->{age} > $arg->{max_age} } @ci_boxes; + + return (\@ci_boxes, \@doomed); +} + +sub execute ($self, $opt, $args) { + require Time::Duration; + + my $boxman = $self->boxman; + my $max_age = $opt->max_age * 3600; + + my @droplets = $boxman->dobby->get_all_droplets->get; + + my ($ci_boxes, $doomed) = $self->sort_boxes_to_prune({ + droplets => \@droplets, + now => time, + max_age => $max_age, + }); + + say sprintf 'Found %s CI box%s, %s of them older than %s.', + 0+@$ci_boxes, (@$ci_boxes == 1 ? q{} : 'es'), + 0+@$doomed, + Time::Duration::duration($max_age); + + my @failures; + + for my $box (@$doomed) { + my $droplet = $box->{droplet}; + + my $desc = sprintf '%s (age %s)', + $droplet->{name}, + Time::Duration::concise(Time::Duration::duration($box->{age}, 2)); + + if ($opt->dry_run) { + say "🔹 Would destroy $desc"; + next; + } + + my $ident = "pruning-$droplet->{id}"; + start_section($ident, "Destroying $desc"); + + # one indestructible box shouldn't keep us from pruning the rest of them + my $ok = eval { $boxman->destroy_droplet($droplet, { force => 1 })->get; 1 }; + + unless ($ok) { + my $error = $@ || "unknown error"; + $error =~ s{\s+\Z}{}; + + push @failures, $droplet->{name}; + say "Couldn't destroy $droplet->{name}: $error"; + } + + end_section($ident); + } + + if (@failures) { + die sprintf "Failed to destroy %s box%s: %s\n", + 0+@failures, (@failures == 1 ? q{} : 'es'), (join q{, }, @failures); + } +} + +1; diff --git a/t/ci-prune.t b/t/ci-prune.t new file mode 100644 index 0000000..35ecc84 --- /dev/null +++ b/t/ci-prune.t @@ -0,0 +1,89 @@ +use v5.36.0; +use utf8; + +use Dobby::Boxmate::App::Command::ciprune; + +use Test::More; +use Test::Deep ':v1'; + +my $CMD = 'Dobby::Boxmate::App::Command::ciprune'; + +my $NOW = 1767225600; # 2026-01-01T00:00:00Z + +# Droplets are named for their age in hours, so the expectations below read as +# "these are the boxes this many hours old". +my sub droplet ($name, $hours_old) { + my @t = gmtime($NOW - $hours_old * 3600); + + return { + id => $hours_old, + name => $name, + created_at => sprintf('%04u-%02u-%02uT%02u:%02u:%02uZ', + $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0]), + }; +} + +my @DROPLETS = ( + droplet('ci-run-1000.jane.fm.example.com', 1), + droplet('ci-run-1001.jane.fm.example.com', 6), + droplet('ci-run-1002.jane.fm.example.com', 7), + droplet('ci-run-1003.jane.fm.example.com', 48), + droplet('jane.fm.example.com', 48), + droplet('not-ci-run-1004.fm.example.com', 48), + droplet('ci-run.fm.example.com', 48), +); + +my sub sort_boxes ($max_age_hours) { + return $CMD->sort_boxes_to_prune({ + droplets => \@DROPLETS, + now => $NOW, + max_age => $max_age_hours * 3600, + }); +} + +sub prunable_ok ($max_age_hours, $expect, $desc) { + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my (undef, $doomed) = sort_boxes($max_age_hours); + + cmp_deeply( + [ map {; $_->{droplet}{name} } @$doomed ], + $expect, + $desc, + ); +} + +prunable_ok(6, [ + 'ci-run-1003.jane.fm.example.com', + 'ci-run-1002.jane.fm.example.com', +], 'six hours: only the CI boxes older than six hours, oldest first'); + +prunable_ok(24, [ + 'ci-run-1003.jane.fm.example.com', +], 'one day: only the two-day-old CI box'); + +prunable_ok(72, [], 'three days: nothing is old enough to prune'); + +prunable_ok(0, [ + 'ci-run-1003.jane.fm.example.com', + 'ci-run-1002.jane.fm.example.com', + 'ci-run-1001.jane.fm.example.com', + 'ci-run-1000.jane.fm.example.com', +], 'no minimum age: every CI box, and only the CI boxes'); + +subtest 'the CI boxes we find, doomed or not' => sub { + my ($ci_boxes) = sort_boxes(6); + + cmp_deeply( + [ map {; [ $_->{droplet}{name}, $_->{age} ] } @$ci_boxes ], + [ + [ 'ci-run-1003.jane.fm.example.com', 48*3600 ], + [ 'ci-run-1002.jane.fm.example.com', 7*3600 ], + [ 'ci-run-1001.jane.fm.example.com', 6*3600 ], + [ 'ci-run-1000.jane.fm.example.com', 1*3600 ], + ], + 'we find every CI box, oldest first, with its age in seconds', + ); +}; + +done_testing;