Documentation/scripts/prtsweep.pl

212 lines
5.2 KiB
Perl
Executable File

#!/usr/bin/perl -w
########################################################################
#
# prtsweep
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# This is a script for removing rubbish from a CRUX port tree.
# Distributed under the terms of the GPL license.
#
# Partial Changelog:
# 1.2.1 - First rewrite in perl
# 1.2 - Added support for renamed sources
# 1.1.3 - Replace .md5sum with .signature in the KEEP_FILES list
#
########################################################################
use strict;
use Cwd qw(cwd getcwd);
use File::Path;
our $version = "1.2.1";
our %options = ( auto => 0, dryrun => 0, rmdir => 0, pkgtoo => 0, quiet => 0 );
our @portdirs;
our $argports;
sub print_usage {
print <<EOT;
Usage: prtsweep [OPTION]... [PORTDIRS]...
-a automatic mode, only valid when [PORTDIRS] are omitted
-d remove directories of dropped ports (no Pkgfile present)
-n dry-run, don't actually delete anything
-p delete any built packages too
-q quiet mode
Report bugs on libera.chat #crux-devel
EOT
exit(0);
}
sub parse_args {
foreach my $arg (@ARGV) {
if ($arg =~ /^-a$/) {
$options{auto} = 1;
} elsif ($arg =~ /^-d$/) {
$options{rmdir} = 1;
} elsif ($arg =~ /^-n$/) {
$options{dryrun} = 1;
} elsif ($arg =~ /^-p$/) {
$options{pkgtoo} = 1;
} elsif ($arg =~ /^-q$/) {
$options{quiet} = 1;
} elsif ($arg =~ /^--version$/) {
print $version."\n";
exit 0;
} elsif (-d "$arg") {
push (@portdirs, $arg);
} else {
print_usage();
}
}
$argports = @portdirs;
}
sub list_subdirs {
my $path = shift;
my @list;
while ($path =~ s/\/\//\//g) {}
$path =~ s/\/$//;
opendir(DIR, $path) or return;
foreach my $entry(sort(readdir(DIR))) {
next if ( substr($entry,0,1) eq "." );
push (@list, "$path/$entry") if -d "$path/$entry"
}
closedir(DIR);
return @list;
}
sub parse_signature {
my @signed = ("Pkgfile",".footprint",".signature","README","README.md",
"pre-install","post-install",".32bit",".nostrip");
my $sigfile = shift;
open (FILE, $sigfile) or return ;
while (<FILE>) {
if (/^SHA256 \(.+\) =.*$/) {
$_ =~ s/^SHA256 \((.+)\) =.*$/$1/;
push (@signed, $_)
}
}
close (FILE);
return @signed ;
}
sub rm_emptydir {
my $portpath = shift;
my $okremove = shift;
rmdir $portpath if ($okremove == 1);
}
sub sweep {
my $port = shift;
while ($port =~ s/\/\//\//g) {}
$port =~ s/\/$//;
my @path = split /\//, $port;
my $builtpkg;
print "=======> $port\n" unless $options{quiet}==1;
my @wanted = parse_signature ("$port/.signature");
$builtpkg=($options{pkgtoo} != 1) ? $path[-1].'#.*pkg\.tar.*' :
'ReallyLongStringThatWouldNeverMatchAnyBuiltPackage';
$builtpkg =~ s/\+/\\\+/;
opendir (DIR, $port) or return;
my $nf = 0;
foreach my $f (sort(readdir(DIR))) {
next if ( $f eq "." or $f eq ".." );
$nf += 1;
$f =~ s/\+/\\\+/; # plus sign in filenames interferes with regex search
if ((grep /$f/, @wanted) >= 1 or ($f =~ /$builtpkg/)) {
print "... keeping file $port/$f.\n" unless $options{quiet} == 1;
} else {
my $ft=remove_notify("$port/$f");
remove_forreal("$port/$f", $ft) if $options{dryrun} == 0;
}
}
closedir (DIR);
return (1-$options{dryrun})*($options{rmdir}-$nf);
}
sub remove_notify {
my $path=shift;
my $type = (-d $path) ? "directory" : "file";
my $append = ($options{dryrun}==1) ? "(dry run)\n" : "\n";
print "+ removing $type $path $append";
return $type;
}
sub remove_forreal {
my $path = shift;
my $type = shift;
if ($type eq "file") {
unlink "$path" or return;
} else {
rmtree ($path,0,1);
}
}
sub do_sweep {
my $port=shift;
if (! -f "$port/.signature") {
print "Warning: no signature found.\n";
print "Merciless destruction will be unleashed on $port.\n";
print "Press Ctrl+C within 3 seconds to abort.\n";
sleep 3;
}
my $premsg = ($options{rmdir}==1) ? " directory will be removed if empty.":
" use -d to remove empty directories.";
$premsg = (-f "$port/Pkgfile") ? "": "$port: no Pkgfile found, $premsg";
print $premsg if $premsg ne "";
my $okremove = sweep($port);
my $postmsg = (($premsg ne "")*($okremove != 1)) ?
"could not remove $port: directory not empty\n": "";
print $postmsg if $postmsg ne "";
rm_emptydir ($port, $okremove);
}
sub getportdirs {
my $collection;
my @basedirs;
my $portetc = "/etc/ports/";
opendir (PORTS_DEFS,$portetc) or die "cannot open $portetc for reading";
foreach (readdir PORTS_DEFS) {
next if ($_ eq '.' or $_ eq '..');
if (/.*(rsync|httpup)$/) {
open SYNC, $portetc.$_ or die "cannot open $portetc.$_";
while (<SYNC>) {
$collection=$2 if /^(destination|ROOT_DIR)=(.+)$/;
}
close SYNC;
push (@basedirs , $collection);
} elsif (/.*git$/) {
open SYNC, $portetc.$_ or die "cannot open $portetc.$_";
while (<SYNC>) {
$collection="/usr/ports/$1" if /^NAME=(.+)$/;
}
close SYNC;
push (@basedirs , $collection);
} else {}
}
closedir PORTS_DEFS;
return @basedirs ;
}
# main
parse_args();
print_usage() if ((2*$argports-1)*(1-2*$options{auto}) < 0);
if ($options{auto} == 1) {
my @basedirs = getportdirs();
foreach my $collection (@basedirs) {
print "====> Sweeping port collection $collection\n";
foreach my $port (list_subdirs($collection)) {
do_sweep($port)
}
}
} else {
foreach my $port (@portdirs) {
do_sweep($port)
}
}