prtsweep.pl: initial commit
This commit is contained in:
parent
b45d8d3ae3
commit
e1c2785537
212
scripts/prtsweep.pl
Executable file
212
scripts/prtsweep.pl
Executable file
@ -0,0 +1,212 @@
|
||||
#!/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
|
||||
#
|
||||
########################################################################
|
||||
|
||||
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 to <jmcquah\@disroot.org>.
|
||||
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 ( $entry eq "." or $entry 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 $postmsg = ($options{rmdir}==1) ? "\n" : "use '-d' to remove empty directories.\n";
|
||||
print "$portpath: no Pkgfile found.$postmsg";
|
||||
return unless $options{rmdir}==1;
|
||||
my $nf = 0;
|
||||
opendir (DIR,$portpath) or die "cannot open $portpath for directory listing\n";
|
||||
foreach (readdir DIR) {
|
||||
next if (($_ eq '.') or ($_ eq '..'));
|
||||
$nf += 1;
|
||||
}
|
||||
closedir (DIR);
|
||||
if ($nf == 0) { rmdir $portpath; }
|
||||
}
|
||||
|
||||
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;
|
||||
foreach my $f (sort(readdir(DIR))) {
|
||||
next if ( $f eq "." or $f eq ".." );
|
||||
$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);
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
if (-f "$port/Pkgfile") {
|
||||
sweep($port);
|
||||
} else {
|
||||
rm_emptydir($port);
|
||||
}
|
||||
}
|
||||
|
||||
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)
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user