#!/usr/bin/perl
#
# dbx-clean-kernels - clean out broken kernel packages
#
# Copyright 2018-2020 Dropbox, Inc. - All rights reserved.
# Copyright 2026 CZ Software - All rights reserved.
# Author: Bill MacAllister <whm@dropbox.com>

use Carp;
use Getopt::Long;
use IPC::Run qw( run timeout );
use Pod::Usage;
use strict;

my $opt_debug;
my $opt_help;
my $opt_manual;
my $opt_major;
my $opt_minor;
my $opt_prefix = 'linux-image';
my $opt_state  = 'rc';
my $opt_sub;
my $opt_update;

##############################################################################
# Subroutines
##############################################################################

# ----------------------------------------------------------------------
# debugging output

sub dbg {
    (my $txt) = @_;
    msg("DEBUG: $txt\n");
}

# ----------------------------------------------------------------------
# output information

sub msg {
    (my $tmp) = @_;
    print {*STDOUT} $tmp
      or croak("Problem writing to STDOUT\n");
    return;
}

# ----------------------------------------------------------------------
# Run a shell command line

sub run_cmd {
    my ($timeout, @cmd) = @_;

    my $in;
    my $out;
    my $err;
    my $cmd_line = 'Executing: ' . join(' ', @cmd);
    msg("$cmd_line\n");
    eval { run(\@cmd, \$in, \$out, \$err, timeout($timeout)); };
    if ($@) {
        if ($err) {
            $err .= "\n";
        }
        $err .= "ERROR executing:$cmd_line\n";
        $err .= $@;
        croak "$err\n";
    }
    if ($opt_debug) {
        if ($out) {
            msg("$out\n");
        }
        if ($err) {
            msg("INFO: $err\n");
        }
    }
    return $out;
}

# ----------------------------------------------------------------------
# Purge a kernel version

sub purge_kernel {
    (my $k) = @_;

    if ($opt_update) {
        my @cmd = ();
        push @cmd, 'apt', 'purge';
        push @cmd, "-o Dpkg::Options::='--force-confold'";
        push @cmd, "-o Dpkg::Options::='--force-confdef'";
        push @cmd, '-y';
        push @cmd, $k;
        my $out = run_cmd(180, @cmd);
        msg($out);
    } else {
        msg("Proposing to purge $k\n");
    }
    return;
}

##############################################################################
# Main Routine
##############################################################################

GetOptions(
    'debug'    => \$opt_debug,
    'help'     => \$opt_help,
    'major=i'  => \$opt_major,
    'manual'   => \$opt_manual,
    'minor=i'  => \$opt_minor,
    'prefix=s' => \$opt_prefix,
    'state=s'  => \$opt_state,
    'sub=i'    => \$opt_sub,
    'update'   => \$opt_update
);

# -- help the poor souls out
pod2usage(-verbose => 2) if $opt_manual;
pod2usage(-verbose => 0) if $opt_help || ($ARGV[0] && $ARGV[0] eq 'help');

my $this_kernel = `uname -r`;
my $this_major;
my $this_minor;
my $this_sub;
if ($this_kernel =~ /^(\d+) [.] (\d+) [.] (\d+)/xms) {
    $this_major = $1;
    $this_minor = $2;
    $this_sub   = $3;
} else {
    msg("ERROR: cannot determine current kernel version from $this_kernel\n");
    exit 1;
}

if ($opt_debug) {
    dbg("opt_prefix: $opt_prefix");
    dbg("opt_state:  $opt_state");
    dbg("this_major: $this_major");
    dbg("this_minor: $this_minor");
    dbg("this_sub:   $this_sub");
}

my %pkg_list       = ();
my %state_list     = ();
my @pkg            = `dpkg -l`;
my $major_max      = 0;
my $major_previous = 0;
my $minor_max      = 0;
my $minor_previous = 0;
my $sub_max        = 0;
my $sub_previous   = 0;

for my $k (@pkg) {
    # Pick by package state
    if ($opt_state && $k =~ /^$opt_state \s+ ($opt_prefix\S+)/xms) {
        my $this_version = $1;
        $state_list{$this_version} = 1;
        next;
    }

    # Pick by package version
    if ($k =~ /^\S+ \s+ ($opt_prefix\S+)/xms) {
        my $this_version = $1;
        if ($this_version =~ /^(\d+) [.] (\d+) [.] (\d+)/xms) {
            my $major = $1;
            my $minor = $2;
            my $sub   = $3;
            if ($major > $major_max) {
                $major_previous = $major_max;
                $major_max      = $major;
            }
            if ($minor > $minor_max) {
                $minor_previous = $minor_max;
                $minor_max      = $minor;
            }
            if ($sub > $sub_max) {
                $sub_previous = $sub_max;
                $sub_max      = $sub;
            }

            # Skip the current version
            if (   $major eq $this_major
                && $minor == $this_minor
                && $sub == $this_sub)
            {
                if ($opt_debug) {
                    msg("DEBUG: skipping current version $this_version\n");
                }
                next;
            }

            # Skip newer versions
            if ($opt_major && $major > $opt_major) {
                if ($opt_debug) {
                    msg("DEBUG: skipping newer versions $this_version\n");
                }
                next;
            }
            if (   $opt_major
                && $major == $opt_major
                && $opt_minor
                && $minor > $opt_minor)
            {
                if ($opt_debug) {
                    msg("DEBUG: skipping newer versions $this_version\n");
                }
                next;
            }
            if (   $opt_major
                && $major == $opt_major
                && $opt_minor
                && $minor > $opt_minor
                && $opt_sub
                && $sub > $opt_sub)
            {
                if ($opt_debug) {
                    msg("DEBUG: skipping newer versions $this_version\n");
                }
                next;
            }

            # Purge this package
            $pkg_list{$this_version} = 1;
        }
    }
}

for my $k (sort keys %state_list) {
    if ($opt_update) {
        msg("Purging $k in state:$opt_state\n");
        purge_kernel($k);
    } else {
        msg("Proposing to purge $k in state:$opt_state\n");
    }
}

for my $k (sort keys %pkg_list) {
    if ($pkg_list{$k} == $minor_max || $pkg_list{$k} == $minor_previous) {
        if ($opt_debug) {
            msg("DEBUG: skipping recent kernel versions $k\n");
        }
        next;
    }
    if ($opt_update) {
        msg("Purging $k\n");
        purge_kernel($k);
    } else {
        msg("Proposing to purge $k\n");
    }
}

exit;

__END__

##############################################################################
# Documentation
##############################################################################

=head1 NAME

dbx-clean-kernels - purge broken kernel packages

=head1 SYNOPSIS

dbx-clean-kernels [--prefix=<string>] [--state=<string>] [--limit=i]
[--version=s] [--update] [--debug] [--help] [--manual]

=head1 DESCRIPTION

This script examines the state of all packages that start the --prefix
string and any packages in --state state are purged.  The script will
also scan linux-image pages and purge versions older than --limit.

=head1 OPTIONS

=over 4

=item --prefix=<string>

Select packages with this prefix.  The default is 'linux-image'.

=item --state=<string>

Select packages with in this state.  The default is 'rc'.

=item --major=i

Select kernel packages that have a major version older than i.
Package names are assumed to be prefixed with linux-image-(\d+).

=item --minor=i

Select kernel packages that have a minor version older than i.
Package names are assumed to be prefixed with linux-image-<major>-(\d+).
The minor version is scanned only if the --major limit is specified.

=item --sub=i

Select kernel packages that have a sub-minor version older than i.
Package names are assumed to be prefixed with
linux-image-<major>-<minoe>-(\d+).  The sub version is scanned only
if the --major and --minor limits are specified.

=item --update

Actually purge selected packages.  The default action is to display
a list of selected packages.

=item --debug

Display debugging output.

=item --help

A short help message.

=item --manual

The complete documentation.

=back

=head1 EXAMPLES

To just check that if there are any kernels to be removed simply
execute the script without any command line arguments.

        $ cz-clean-kernels
        Proposing to purge linux-image-6.1.0-16-amd64
        Proposing to purge linux-image-6.1.0-18-amd64
        Proposing to purge linux-image-6.1.0-23-amd64
        Proposing to purge linux-image-6.1.0-25-amd64
        Proposing to purge linux-image-6.1.0-27-amd64
        Proposing to purge linux-image-6.1.0-31-amd64
        Proposing to purge linux-image-6.1.0-38-amd64
        Proposing to purge linux-image-6.1.0-39-amd64

To delete the unused or broken kernels add the --update switch.

        $ cz-clean-kernels --state=rc --update
        Purging linux-image-6.1.0-16-amd64
        Executing: apt purge -o Dpkg::Options::='--force-confold' -o Dpkg::Options::='--force-confdef' -y linux-image-6.1.0-16-amd64
        Reading package lists...
        Building dependency tree...
        Reading state information...
        The following packages were automatically installed and are no longer required:
          linux-headers-6.1.0-41-amd64 linux-headers-6.1.0-41-common
          linux-image-6.1.0-41-amd64
        Use 'apt autoremove' to remove them.
        The following packages will be REMOVED:
          linux-image-6.1.0-16-amd64*
        0 upgraded, 0 newly installed, 1 to remove and 5 not upgraded.
        After this operation, 0 B of additional disk space will be used.
        (Reading database ... 168802 files and directories currently installed.)
        Purging configuration files for linux-image-6.1.0-16-amd64 (6.1.67-1) ...
        Purging linux-image-6.1.0-18-amd64
        ... lots more output ...

=head1 AUTHOR

Bill MacAllister <bill@ca-zephyr.org>

=head1 COPYRIGHT

Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:

The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

=head1 AUTHORS

Bill MacAllister <whm@dropbox.com>

=cut
