Documentation/scripts/prtsweep.pl

#!/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)
	}
}