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.
# (c) 2022, 2023 John McQuah <jmcquah at disroot dot org>
# based on the bash script by Martin Opel <martin at obbl-net dot de>
#
# ChangeLog available in the prt-utils tarball.
#
########################################################################

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;

######################### main routine ################################
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);
    }
}

######################### subroutines #################################
sub print_usage {
    print <<EOT;
Usage: prtsweep [OPTION]... [PORTDIRS]... 

  -a     automatic mode, only valid when [PORTDIRS] are omitted
  -d     remove directories of dropped ports (signature file not found)
  -n     dry-run, don't actually delete anything
  -p     delete any built packages too
  -q     quiet mode, only print messages when files are removed

Report bugs on libera.chat #crux-devel
EOT
    exit(0);
}

sub parse_args {
    foreach my $arg (@ARGV) {
        if ($arg eq "-a") {
            $options{auto} = 1;
        } elsif ($arg eq "-d") {
            $options{rmdir} = 1;
        } elsif ($arg eq "-n") {
            $options{dryrun} = 1;
        } elsif ($arg eq "-p") {
            $options{pkgtoo} = 1;
        } elsif ($arg eq "-q") {
            $options{quiet} = 1;
        } elsif ($arg eq "--version") {
            print $version."\n";
            exit 0;
        } elsif ((-d "$arg") ||        # false for symlink to a portdir,
               (-f "$arg/.signature") || 
               (-f "$arg/.md5sum")) {  # so further tests are needed
            push (@portdirs, $arg);
        } elsif (-f "$arg") {
            print "WARN: $arg is not a port directory or recognized option, ignoring.\n";
        } 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")
            or (-f "$path/$entry/.signature"));
    }
    closedir(DIR);
    return @list;
}

sub parse_manifest {
    my $sigfile = shift;
    my $sigtype = (split /\//, $sigfile)[-1];
    my @keeplist = ("Pkgfile",".footprint","README","README.md",
        "pre-install","post-install",".32bit",".nostrip");
    push (@keeplist,$sigtype);
    open (FILE, $sigfile) or return @keeplist;
    while (<FILE>) {
        if (($sigtype eq ".signature") and (/^SHA256 \((.+)\) =.*$/)) {
            push (@keeplist, $1);
        } elsif ($sigtype eq ".md5sum") {
            my ($m, $f) = split /\s+/, $_;
            push (@keeplist, $f);
        }
    }
    close (FILE);
    return @keeplist ;
}

sub sweep {
    my $port = shift; my $sigtype = shift;
    while ($port =~ s/\/\//\//g) {}
    $port =~ s/\/$//;
    my @path = split /\//, $port;

    print "=======> $port\n" unless $options{quiet}==1;
    my %wanted = map { $_ => 1 } parse_manifest ("$port/.$sigtype");
    my $builtpkg=$path[-1].'#.*pkg\.tar\.(bz2|gz|lz|xz)$';
    $builtpkg =~ s/\+/\\\+/; # plus sign in filenames interferes with regex search

    opendir (DIR, $port) or return;
    foreach my $f (sort(readdir(DIR))) {
        next if ( $f eq '.' or $f eq '..' );
        if (($wanted{$f}) or
            ($f =~ /$builtpkg/)*($options{pkgtoo}==0)) {
            print "... keeping file $port/$f.\n" unless $options{quiet} == 1;
        } else {
            remove ("$port/$f");
        }
    }
    closedir (DIR);
}

sub remove {
    my $path=shift;
    my $append = ($options{dryrun}==1) ? "(dry run)\n" : "\n";
    if (-d $path) {
        print "+ removing directory $path $append";
        rmtree ($path,0,1) if ($options{dryrun}==0);
    } else {
        print "+ removing file $path $append";
        if ($options{dryrun}==0) { unlink "$path" or return; }
    }
}

sub do_sweep {
    # argument either a real directory (not symlink) or has a manifest;
    # this subroutine determines which condition was satisfied.
    my $port = shift; my $nf = 0;
    if ((! -f "$port/.signature") and (! -f "$port/.md5sum")) {
        opendir (PORTDIR,$port) or return;
        foreach my $f (readdir PORTDIR) {
            next if ($f eq '.' or $f eq '..');
            $nf += 1;
        }
        closedir (PORTDIR);
        print "WARN: no signature or md5sum found in directory $port, skipping.\n";
        rm_emptydir($port,$nf);
    } elsif (-f "$port/.signature") {
        sweep($port,"signature");
    } else {
        sweep($port,"md5sum");
    }
}

sub rm_emptydir {
    my $port = shift; my $nf = shift;
    my $msg = ($options{rmdir}==1) ? "\n":
        "\n  Use -d to remove empty directories.\n";
    my $modal = ($options{dryrun}==0) ? "" : "would be";
    my $post = ($nf == 0) ? "  Empty directory $port $modal deleted.\n" :
        "  Cannot remove $port: directory not empty\n";
    $msg = ($options{rmdir}==1) ? "$msg $post" : $msg ;
    print $msg;
    rmdir ($port) if (($nf == 0) and ($options{dryrun} == 0));
}

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 ;
}