Perl: veraltetete Distfiles von gentoo Linux automatisiert löschen

---

Gentoo Linux verwendet bekanntermaßen den sogenannten Portage zur Verwaltung der Software auf dem System.
Wenn mittels `emerge‘ ein Paket installiert wird, zieht der Portage die Quelldateien der Software aus dem Netz und speichert diese standardmäßig in /usr/portage/distfiles/.

Je nach Konfiguration in /etc/portage/make.conf belässt der Portage die Quelldateien auf dem Dateisystem, um bei Änderungen der USE-Flags und der daraus erforderlichen Recompilierung des Pakets die Dateien nicht erneut herunterladen zu müssen.
Aktualisiert man nun die Paketinformationen mit `emerge –sync‘, werden veraltete ebuilds entfernt.
In diesen ebuilds (bzw. dessen Manifest-Dateien) ist hinterlegt, welches Quellpaket in welcher Version verwendet werden soll.
Ist also ein veraltetes ebuild während der Aktualisierung des Portages gelöscht worden, werden auch die entsprechenden Quelldateien unter /usr/portage/distfiles/ überflüssig, da diese über das Portagesystem nicht mehr verwendet werden können.

Dadurch geht natürlich im Laufe der Zeit Festplattenspeicher verloren.
Daher habe ich ein kleines Perl-Script geschrieben, das an Hand der Manifest-Dateien feststellt, welche Quelldateien aktuell überhaupt verwendet werden (können) und nach einem Abgleich mit /usr/portage/distfiles/ eine Liste mit Quelldateien erstellt, die nicht mehr benötigt werden.
Die Dateien in der Liste werden dann gelöscht.

So sieht die Ausgabe des Scripts (`clean_dists.pl‘) nach Ausführung aus:

---

Der Code des Scripts ist hier ersichtlich:

#!env perl

########################################################################
# Konfiguration

my $distfiles_verzeichnis = "/usr/portage/distfiles";
my $portage_verzeichnis = "/usr/portage";

my @ignorieren = ( "licenses", "metadata", "distfiles", "eclass", "header.txt", "profiles", "scripts",
    "skel.ChangeLog", "skel.ebuild", "skel.metadata.xml" );

########################################################################

use strict;
use warnings;
use diagnostics;

use File::Find;
local $| = 1; # flush stdout every print();

no warnings 'File::Find';

########################################################################

my $anzahl_kategorien = 0;
my $anzahl_moeglicher_packete = 0;
my $anzahl_distfiles = 0;
my $geloescht = 0;

my @alle_distfiles = ("");
my @alle_gespeicherten_packete = (); 
my @alle_packete_zu_loeschen = (); 
my @packete_nicht_geloescht = (); 

my $vorher_belegt = 0;
my $nachher_belegt = 0;

my(%mask, @ergebnisse);

########################################################################

sub in_array {
    (my $array, my $suchbegriff) = @_; 

    foreach my $wert (@$array) {
        return 1 if $wert eq $suchbegriff;
    }   
    return 0;
}

sub check_portage_dir {
    (my $verzeichnis) = @_; 

    if (in_array(\@ignorieren, $verzeichnis) == 0) {
        if (-d "$portage_verzeichnis/$verzeichnis") {
            chdir("$portage_verzeichnis/$verzeichnis") || return 1;

            print " ... $verzeichnis";
            $anzahl_kategorien++;

            return 1;
        }   
    }   

    return 0;
}

sub check_manifest_data {
    (my $lines) = @_; 
    
    foreach my $line (@$lines) {
        my $len = length($line);

        if ($len > 0) {
            my @distfile_line = split(" ", $line);

            if (scalar(@distfile_line) > 2) {
                if ($distfile_line[0] eq "DIST") {
                    my $distfile = $distfile_line[1];

                    if ($alle_distfiles[$#alle_distfiles] ne $distfile) {
                        push(@alle_distfiles, "$distfile");
                        $anzahl_moeglicher_packete++;
    }   }   }   }   }
}

sub open_manifests {
    foreach my $manifest (glob("*/Manifest")) {
        my @lines;
        my $len = 0;
        open(INFO, "$manifest");
        @lines = <INFO>;
        close(INFO);

        check_manifest_data(\@lines);
    }
}

sub get_distdir_usage {
    my $size = 0;
    find(sub { $size += -s if -f $_ }, "$distfiles_verzeichnis");
    $size = $size/1024/1024;

    return int($size + $size / abs($size*2));
}

########################################################################

print "\nDieses Script loescht alte Pakete, die ueber den Portage nicht mehr installiert werden koennen.\n";
print "\n\033[1;33mErstelle eine Liste aller installierbaren Pakete... das kann etwas laenger dauern.\033[0m\n\n";

chdir("$portage_verzeichnis") || die("Konnte nicht in das Verzeichnis `$portage_verzeichnis' wechseln.");

foreach my $verzeichnis (glob("*")) {
    if (check_portage_dir($verzeichnis) == 1) {
        open_manifests();
    }
}

print "\n\nAnzahl Kategorien: $anzahl_kategorien\nAnzahl moeglicher Pakete: $anzahl_moeglicher_packete\n";
sleep 2;

chdir("$distfiles_verzeichnis") || die("Konnte nicht in das Verzeichnis `$distfiles_verzeichnis' wechseln.");

print "\n\033[1;33mAktuell belegt `$distfiles_verzeichnis' ".($vorher_belegt = get_distdir_usage())." MB.\033[0m\n";
print "\n\033[1;33mSuche nach Paketen, die nicht mehr verwendet werden koennen...\033[0m";

foreach my $dateiname (glob("*")) {
    if (-f "$dateiname") {
        push(@alle_gespeicherten_packete, "$dateiname");
        $anzahl_distfiles++;
    }
}

# in_array() ist in fuer diesen Fall viel zu langsam, daher:
$ergebnisse[$_] = [] foreach (0 .. 3);
foreach my $e (@alle_distfiles) { $mask{$e} |= 1 }
foreach my $e (@alle_gespeicherten_packete) { $mask{$e} |= 2 }

foreach my $e (keys %mask) {
    push(@{$ergebnisse[0]}, $e);
    push(@{$ergebnisse[$mask{$e}]}, $e);
}

print " fertig.\n";
print "\033[1;33mVon insgesamt $anzahl_distfiles Dateien werden ".(@{$ergebnisse[2]})." geloescht.\033[0m\n";
print "\033[1;31mFortfahren?\033[0m ";
my $weiter = <>;

foreach my $dateiname (@{$ergebnisse[2]}) {
    if (unlink($dateiname)) {
        $geloescht++;
    } else {
        push(@packete_nicht_geloescht, "$dateiname");
    }
}

print "\033[1;33m$geloescht Dateien wurden entfernt.\033[0m\n";
print "\n\033[1;33mNun belegt `$distfiles_verzeichnis' ".($nachher_belegt = get_distdir_usage())." MB.\033[0m\n";
print "\033[1;33mEs wurden somit ".($vorher_belegt - $nachher_belegt)." MB freigegeben.\n";

if (scalar(@packete_nicht_geloescht) > 0) {
    print "\033[1;31mFolgende zum Loeschen markierte Dateien konnten nicht geloescht werden:\033[0m\n";

    foreach my $dateiname (@packete_nicht_geloescht) {
        print "\t".$dateiname."\n";
    }
}

---

Sollte der Portage oder die Distfiles nicht in den Standardverzeichnissen liegen, müssen die Zeilen 6 und 7 angepasst werden.

Ausgeführt wurde das Script mit Perl v5.16.3.

---