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.