add "box ci-prune" to destroy stale CI boxes

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;

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;