7c6ddf8796
bnc#854348 OBS-URL: https://build.opensuse.org/package/show/Base:System/dracut?expand=0&rev=84
375 lines
9.0 KiB
Perl
375 lines
9.0 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Getopt::Long;
|
|
|
|
sub usage {
|
|
print "Usage: $0 [--test]\n";
|
|
print "Reads list of kernels to keep from /etc/zypp/zypp.conf:multiversion.kernels\n";
|
|
print "kernels can be given as <version>, latest(-N), running, oldest(+N).\n";
|
|
}
|
|
|
|
# arch/flavor => version-release => [ subpackages ]
|
|
my %kernels;
|
|
my %kmps;
|
|
|
|
my @keep_spec;
|
|
my ($want_running, $running_version, $running_flavor);
|
|
|
|
# do not actually delete anything
|
|
my $test_only;
|
|
|
|
# undocumented debugging options
|
|
my ($fake_config, $fake_rpm_qa, $fake_uname_r, $fake_uname_m);
|
|
|
|
sub get_config_line {
|
|
my $file = "/etc/zypp/zypp.conf";
|
|
|
|
if ($fake_config) {
|
|
return $fake_config;
|
|
}
|
|
if (!-e $file) {
|
|
print STDERR "$0: /etc/zypp/zypp.conf does not exist, exiting.\n";
|
|
exit 0;
|
|
}
|
|
open(my $fh, '<', $file) or die "$0: $file: $!\n";
|
|
while (<$fh>) {
|
|
chomp;
|
|
next unless /^\s*multiversion\.kernels\b/;
|
|
s/^[^=]*=\s*//;
|
|
close($fh);
|
|
return $_;
|
|
}
|
|
close($fh);
|
|
return "";
|
|
}
|
|
|
|
sub load_config {
|
|
my @kernels;
|
|
|
|
@kernels = split(/,\s*/, get_config_line());
|
|
for my $kernel (@kernels) {
|
|
if ($kernel =~ /^\s*(latest|oldest|running)(\s*[-+]\s*\d+)?\s*$/) {
|
|
my $new = { whence => $1, offset => $2 || 0 };
|
|
$new->{offset} =~ s/\s*//g;
|
|
if ($new->{whence} eq "running") {
|
|
$want_running = 1;
|
|
}
|
|
push (@keep_spec, $new);
|
|
} elsif ($kernel =~ /^\d+\.\d+/) {
|
|
my $new = { version => $kernel };
|
|
push (@keep_spec, $new);
|
|
} elsif ($kernel =~ /^\s*$/) {
|
|
next;
|
|
} else {
|
|
print STDERR "$0: Ignoring unknow kernel specification in\n";
|
|
print STDERR "/etc/zypp/zypp.conf:multiversion.kernels: $kernel\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub add_package {
|
|
my ($name, $vr, $arch) = @_;
|
|
my ($flavor, $table);
|
|
|
|
#print STDERR "add_package: $name $vr $arch\n";
|
|
if ($name eq "kernel-firmware" || $name eq "kernel-coverage") {
|
|
return;
|
|
}
|
|
if ($name =~ /^kernel-/) {
|
|
($flavor = $name) =~ s/^kernel-//;
|
|
$table = \%kernels;
|
|
} elsif ($name =~ /-kmp-/) {
|
|
($flavor = $name) =~ s/.*-kmp-//;
|
|
$table = \%kmps;
|
|
}
|
|
# Put all subpackages into the same group, except for
|
|
# kernel-source-{vanilla,rt}, which are packages on their own
|
|
if ($flavor !~ /^source/) {
|
|
$flavor =~ s/-.*//; # XXX: No dashes in flavor names
|
|
}
|
|
# kernel-devel is a subpackage of kernel-source
|
|
$flavor =~ s/^devel/source/;
|
|
$table->{"$arch/$flavor"} ||= {};
|
|
$table->{"$arch/$flavor"}{$vr} ||= [];
|
|
push(@{$table->{"$arch/$flavor"}{$vr}}, "$name-$vr.$arch");
|
|
}
|
|
|
|
sub load_packages {
|
|
my $pipe;
|
|
|
|
if ($fake_rpm_qa) {
|
|
open($pipe, '<', $fake_rpm_qa) or die "$fake_rpm_qa: $!\n";
|
|
} else {
|
|
open($pipe, '-|', 'rpm', '-qa', '--qf',
|
|
'%{n} %{v}-%{r} %{arch}\n', 'kernel-*', '*-kmp-*')
|
|
or die "rpm: $!\n";
|
|
}
|
|
while (<$pipe>) {
|
|
chomp;
|
|
my ($name, $vr, $arch) = split;
|
|
add_package($name, $vr, $arch);
|
|
}
|
|
close($pipe)
|
|
}
|
|
|
|
sub sort_versions {
|
|
my @versions = @_;
|
|
|
|
pipe (my $read, my $write);
|
|
my $pid = fork();
|
|
if (!defined($pid)) {
|
|
die "Cannot fork: $!\n";
|
|
} elsif ($pid == 0) {
|
|
# child
|
|
close($read);
|
|
open STDOUT, '>&', $write;
|
|
open(my $fh, '|-', "/usr/lib/rpm/rpmsort") or die "/usr/lib/rpm/rpmsort: $!\n";
|
|
print $fh join("\n", @versions), "\n";
|
|
close($fh);
|
|
die "rpmsort failed ($?)\n" if $? != 0;
|
|
|
|
exit 0;
|
|
}
|
|
# parent
|
|
close($write);
|
|
@versions = <$read>;
|
|
chomp @versions;
|
|
close($read);
|
|
waitpid($pid, 0);
|
|
die "rpmsort failed ($?)\n" if $? != 0;
|
|
|
|
return @versions;
|
|
}
|
|
|
|
# return true if VER1 == VER2 or VER1 == (VER2 minus rebuild counter)
|
|
sub version_match {
|
|
my ($ver1, $ver2) = @_;
|
|
|
|
return 1 if $ver1 eq $ver2;
|
|
|
|
# copied from kernel-source/rpm/kernel-spec-macros
|
|
$ver2 =~ s/\.[0-9]+($|\.[^.]*[^.0-9][^.]*$)/$1/;
|
|
return $ver1 eq $ver2;
|
|
}
|
|
|
|
sub list_old_versions {
|
|
my ($flavor) = @_;
|
|
|
|
my $is_source = $flavor =~ /\/(source|syms)/;
|
|
my $kernels = $kernels{$flavor};
|
|
my @versions = sort_versions(keys(%$kernels));
|
|
my %idx = (
|
|
oldest => 0,
|
|
latest => scalar(@versions) - 1,
|
|
);
|
|
if ($want_running && ($running_flavor eq $flavor || $is_source)) {
|
|
for (my $i = scalar(@versions) - 1; $i >= 0; $i--) {
|
|
if (version_match($running_version, $versions[$i])) {
|
|
$idx{running} = $i;
|
|
last;
|
|
}
|
|
}
|
|
if (!exists($idx{running}) && !$is_source) {
|
|
print STDERR "$0: Running kernel $running_version-$running_flavor not installed.\n";
|
|
print "NOT removing any packages for flavor $flavor.\n";
|
|
return;
|
|
}
|
|
}
|
|
my %delete = map { $_ => 1 } @versions;
|
|
for my $keep (@keep_spec) {
|
|
if ($keep->{version}) {
|
|
for my $ver (@versions) {
|
|
if (version_match($keep->{version}, $ver)) {
|
|
$delete{$ver} = 0;
|
|
}
|
|
}
|
|
} elsif ($keep->{whence}) {
|
|
next unless exists($idx{$keep->{whence}});
|
|
my $idx = $idx{$keep->{whence}};
|
|
$idx += $keep->{offset};
|
|
next unless $idx >= 0 && $idx < scalar(@versions);
|
|
$delete{$versions[$idx]} = 0;
|
|
} else {
|
|
die "??";
|
|
}
|
|
}
|
|
return grep { $delete{$_} } @versions;
|
|
}
|
|
|
|
sub package_exists {
|
|
my ($version, $archs, $flavors) = @_;
|
|
|
|
for my $arch (@$archs) {
|
|
for my $flavor (@$flavors) {
|
|
my $config = "$arch/$flavor";
|
|
if (exists($kernels{$config})
|
|
&& exists($kernels{$config}->{$version})) {
|
|
return 1;
|
|
}
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub list_old_packages {
|
|
my (@packages, @archs, @flavors);
|
|
my (@syms_flavors, @binary_flavors, @source_configs);
|
|
|
|
# there are some inter-dependencies among the kernel packages,
|
|
# so we have to be careful
|
|
my %t = map { s:/.*::; $_ => 1 } keys(%kernels);
|
|
@archs = sort(keys(%t));
|
|
%t = map { s:.*/::; $_ => 1 } keys(%kernels);
|
|
@flavors = sort(keys(%t));
|
|
@syms_flavors = grep { /^syms/ } @flavors;
|
|
@binary_flavors = grep { !/^(source|syms)/ } @flavors;
|
|
@source_configs = grep { /\/source/ } sort(keys(%kernels));
|
|
|
|
for my $arch (@archs) {
|
|
for my $flavor (@syms_flavors) {
|
|
my $config = "$arch/$flavor";
|
|
next unless exists($kernels{$config});
|
|
my @versions = list_old_versions($config);
|
|
for my $ver (@versions) {
|
|
push(@packages, @{$kernels{$config}->{$ver}});
|
|
delete($kernels{$config}->{$ver});
|
|
}
|
|
}
|
|
for my $flavor (@binary_flavors) {
|
|
my $config = "$arch/$flavor";
|
|
next unless exists($kernels{$config});
|
|
my @versions = list_old_versions($config);
|
|
for my $ver (@versions) {
|
|
my @pacs = @{$kernels{$config}->{$ver}};
|
|
my $remove_all = 1;
|
|
# do not remove kernel-$flavor-devel-$ver
|
|
# if kernel-syms-$ver still exists
|
|
if (grep { /-devel$/ } @pacs) {
|
|
my $syms = "syms";
|
|
if ($flavor =~ /^rt/) {
|
|
$syms = "syms-rt";
|
|
}
|
|
if (exists($kernels{$syms}->{$ver})) {
|
|
$remove_all = 0;
|
|
@pacs = grep { !/-devel$/ }
|
|
@pacs;
|
|
}
|
|
}
|
|
push(@packages, @pacs);
|
|
if ($remove_all) {
|
|
delete($kernels{$config}->{$ver});
|
|
}
|
|
}
|
|
}
|
|
}
|
|
for my $config (@source_configs) {
|
|
my @versions = list_old_versions($config);
|
|
for my $ver (@versions) {
|
|
# Remove kernel-{devel,source} only if no other package
|
|
# of the same version exists
|
|
next if package_exists($ver, \@archs, \@binary_flavors);
|
|
push(@packages, @{$kernels{$config}->{$ver}});
|
|
}
|
|
}
|
|
return @packages;
|
|
}
|
|
|
|
sub remove_packages {
|
|
my @packages = @_;
|
|
|
|
while (1) {
|
|
pipe(my $read, my $write);
|
|
my $pid = fork();
|
|
if (!defined($pid)) {
|
|
die "Cannot fork: $!\n";
|
|
} elsif($pid == 0) {
|
|
# child
|
|
close($read);
|
|
open STDOUT, '>&', $write;
|
|
open STDERR, '>&', $write;
|
|
$ENV{LC_ALL} = "C";
|
|
my @cmd = qw(rpm -e);
|
|
push(@cmd, "--test") if $test_only;
|
|
exec(@cmd, @packages) or die "rpm: $!\n";
|
|
}
|
|
# parent
|
|
close($write);
|
|
my @out = <$read>;
|
|
chomp @out;
|
|
close($read);
|
|
waitpid($pid, 0);
|
|
if ($? == 0) {
|
|
print "Removed:\n ", join("\n ", @packages), "\n";
|
|
return 1;
|
|
}
|
|
my ($retry, @problems);
|
|
my %old_packages = map { $_ => 1 } @packages;
|
|
my %new_packages;
|
|
for (@out) {
|
|
if (/ is needed by \(installed\) (.*-kmp-.*)/ &&
|
|
!$old_packages{$1}) {
|
|
push(@packages, $1) unless $new_packages{$1};
|
|
$new_packages{$1} = 1;
|
|
$retry = 1;
|
|
} else {
|
|
push(@problems, $_);
|
|
}
|
|
}
|
|
if (!$retry) {
|
|
print STDERR join("\n", @problems), "\n";
|
|
print STDERR "$0: giving up.\n";
|
|
return 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
if (!GetOptions(
|
|
"h|help" => sub { usage(); exit; },
|
|
"--test" => \$test_only,
|
|
"--fake-config=s" => \$fake_config,
|
|
"--fake-rpm-qa=s" => \$fake_rpm_qa,
|
|
"--fake-uname-r=s" => \$fake_uname_r,
|
|
"--fake-uname-m=s" => \$fake_uname_m)) {
|
|
usage();
|
|
exit 1;
|
|
}
|
|
load_config();
|
|
if (!@keep_spec) {
|
|
print STDERR "$0: multiversion.kernels not configured in /etc/zypp/zypp.conf, exiting.\n";
|
|
exit 0;
|
|
}
|
|
|
|
load_packages();
|
|
if ($want_running) {
|
|
$running_version = $fake_uname_r ? $fake_uname_r : `uname -r`;
|
|
chomp($running_version);
|
|
($running_flavor = $running_version) =~ s/.*-//;
|
|
$running_version =~ s/-[^-]*$//;
|
|
(my $release = $running_version) =~ s/.*-//;
|
|
$running_version =~ s/-[^-]*$//;
|
|
|
|
# copied from kernel-source/rpm/mkspec
|
|
$running_version =~ s/\.0-rc/.rc/;
|
|
$running_version =~ s/-rc\d+//;
|
|
$running_version =~ s/-/./g;
|
|
|
|
$running_version .= "-$release";
|
|
|
|
my $arch = $fake_uname_m ? $fake_uname_m : `uname -m`;
|
|
chomp($arch);
|
|
$arch =~ s/^i.86$/i586/;
|
|
$running_flavor = "$arch/$running_flavor";
|
|
}
|
|
my @remove = list_old_packages();
|
|
if (!@remove) {
|
|
print STDERR "$0: Nothing to do.\n";
|
|
exit 0;
|
|
}
|
|
if (remove_packages(@remove)) {
|
|
exit 0;
|
|
}
|
|
exit 1;
|