mirror of
https://git.FreeBSD.org/ports.git
synced 2024-12-21 04:06:46 +00:00
- Update to 20040517
(add parameter '-L': treat exclude file as a list of files that *should* be installed and report deviations from that list; patch sent by Bob Van Valzah <Bob@VanValzah.Com>) PR: ports/66734 Submitted by: maintainer
This commit is contained in:
Kirill Ponomarev
parent
05c10f8e19
commit
f155e79a5d
Notes:
svn2git
2021-03-31 03:12:20 +00:00
svn path=/head/; revision=109340
@ -4,14 +4,11 @@
|
||||
#
|
||||
# $FreeBSD$
|
||||
#
|
||||
# This port is self contained in the src directory.
|
||||
#
|
||||
|
||||
PORTNAME= pkg_cutleaves
|
||||
PORTVERSION= 20040414
|
||||
PORTVERSION= 20040517
|
||||
CATEGORIES= sysutils
|
||||
MASTER_SITES= # none
|
||||
DISTFILES= # none
|
||||
MASTER_SITES= http://www.gegenunendlich.de/projects/${PORTNAME}/
|
||||
|
||||
MAINTAINER= sw@gegenunendlich.de
|
||||
COMMENT= Interactive script for deinstalling 'leaf' packages
|
||||
@ -22,40 +19,33 @@ NO_BUILD= yes
|
||||
USE_PERL5= yes
|
||||
USE_REINPLACE= yes
|
||||
|
||||
SRC= ${.CURDIR}/src
|
||||
WRKSRC= ${WRKDIR}/${PORTNAME}
|
||||
|
||||
MAN1= pkg_cutleaves.1
|
||||
|
||||
PLIST_FILES= sbin/pkg_cutleaves
|
||||
|
||||
do-fetch:
|
||||
@${DO_NADA}
|
||||
|
||||
pre-patch:
|
||||
@${CP} ${SRC}/pkg_cutleaves ${WRKDIR}/pkg_cutleaves
|
||||
@${CP} ${SRC}/pkg_cutleaves.1 ${WRKDIR}/pkg_cutleaves.1
|
||||
|
||||
post-patch:
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/etc/pkg_leaves.exclude,${PREFIX}/etc/pkg_leaves.exclude,' \
|
||||
${WRKDIR}/pkg_cutleaves.1
|
||||
${WRKSRC}/pkg_cutleaves.1
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/etc/pkg_leaves.exclude,${PREFIX}/etc/pkg_leaves.exclude,' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/sbin/pkg_deinstall,${LOCALBASE}/sbin/pkg_deinstall,' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/sbin/pkgdb,${LOCALBASE}/sbin/pkgdb,' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/var/db/pkg,${PKG_DBDIR},' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e 's,/usr/bin/perl,${PERL},' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
|
||||
do-install:
|
||||
${INSTALL_SCRIPT} ${WRKDIR}/pkg_cutleaves ${PREFIX}/sbin/pkg_cutleaves
|
||||
${INSTALL_MAN} ${WRKDIR}/pkg_cutleaves.1 ${MAN1PREFIX}/man/man1
|
||||
${INSTALL_SCRIPT} ${WRKSRC}/pkg_cutleaves ${PREFIX}/sbin/pkg_cutleaves
|
||||
${INSTALL_MAN} ${WRKSRC}/pkg_cutleaves.1 ${MAN1PREFIX}/man/man1
|
||||
|
||||
.include <bsd.port.mk>
|
||||
|
||||
2
ports-mgmt/pkg_cutleaves/distinfo
Normal file
2
ports-mgmt/pkg_cutleaves/distinfo
Normal file
@ -0,0 +1,2 @@
|
||||
MD5 (pkg_cutleaves-20040517.tar.gz) = 24e981428c439f85209578916996d389
|
||||
SIZE (pkg_cutleaves-20040517.tar.gz) = 5091
|
||||
@ -1,270 +0,0 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Copyright (c) 2003 Stefan Walter <sw@gegenunendlich.de>
|
||||
#
|
||||
# All rights reserved.
|
||||
#
|
||||
# Redistribution and use in source and binary forms, with or without
|
||||
# modification, are permitted provided that the following conditions
|
||||
# are met:
|
||||
# 1. Redistributions of source code must retain the above copyright
|
||||
# notice, this list of conditions and the following disclaimer.
|
||||
# 2. Redistributions in binary form must reproduce the above copyright
|
||||
# notice, this list of conditions and the following disclaimer in the
|
||||
# documentation and/or other materials provided with the distribution.
|
||||
#
|
||||
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
|
||||
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
# ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
|
||||
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
# SUCH DAMAGE.
|
||||
#
|
||||
# $FreeBSD$
|
||||
|
||||
# Interactive script for deinstalling "leaf" packages;
|
||||
# requires the portupgrade tools
|
||||
#
|
||||
# Syntax: pkg_cutleaves [-c] [-F] [-l] [-R] [-x]
|
||||
# Options:
|
||||
# -c: Show comments, too; only works with '-l' (ignored otherwise)
|
||||
# -F: Fix package db after each deinstallation run (via 'pkgdb -F')
|
||||
# -l: List leaf packages only, don't ask if they should be deinstalled
|
||||
# -R: Run 'pkg_deinstall -R' instead of plain 'pkg_deinstall'
|
||||
# -x: Honor exclude list in $excludefile
|
||||
|
||||
use strict;
|
||||
|
||||
my $dbdir = "/var/db/pkg";
|
||||
my $excludefile = "/usr/local/etc/pkg_leaves.exclude";
|
||||
my $pkgdeinstall = "/usr/local/sbin/pkg_deinstall";
|
||||
my @pkgdb_args = ("/usr/local/sbin/pkgdb", "-F");
|
||||
my ($opt_comments, $opt_listonly, $opt_excludelist, $opt_recursive, $opt_pkgdb);
|
||||
my $exclpattern;
|
||||
|
||||
#
|
||||
# Read the exclude list if the file exists
|
||||
# Parameter: path of the exclude file
|
||||
#
|
||||
sub get_excl_pattern {
|
||||
my $excl_file = shift;
|
||||
my $excl_pattern;
|
||||
# Does the exclude file exist?
|
||||
if (($excl_file) && (-f $excl_file) && (-T $excl_file)) {
|
||||
# Read the patterns to be excluded
|
||||
my @excludes;
|
||||
open(EXCLFILE, $excl_file)
|
||||
or die "Couldn't open $excl_file!";
|
||||
while(my $exclude = <EXCLFILE>) {
|
||||
chomp($exclude);
|
||||
# Ignore comments and empty lines, add others as regular expressions
|
||||
unless (($exclude =~ m/(^ *#)|(^ *$)/)) {
|
||||
# Escape any '+' that isn't already escaped
|
||||
$exclude =~ s/(?<!\\)(\+|\.)/\\$1/g;
|
||||
$exclude = "^" . $exclude . ".*";
|
||||
push @excludes, $exclude;
|
||||
}
|
||||
}
|
||||
close(EXCLFILE);
|
||||
# Provide a dummy exclusion pattern if @excludes is empty
|
||||
$excl_pattern = scalar(@excludes) ? join("|", @excludes) : " ";
|
||||
} else {
|
||||
# Dummy exclusion pattern -> doesn't exclude anything
|
||||
$excl_pattern = " ";
|
||||
}
|
||||
return $excl_pattern;
|
||||
}
|
||||
|
||||
#
|
||||
# Get a hash (name => comment) of all leaves
|
||||
# Parameters: - path to package database
|
||||
# - pattern of packages to exclude
|
||||
#
|
||||
sub get_leaves {
|
||||
my $db_dir = shift;
|
||||
my $excl_pattern = shift;
|
||||
my %leaves;
|
||||
opendir(DBDIR, $db_dir)
|
||||
or die "Can't open package db directory $db_dir!";
|
||||
while(defined(my $file = readdir(DBDIR))) {
|
||||
my $path = $db_dir . '/' . $file;
|
||||
my $reqlist = $path . '/+REQUIRED_BY';
|
||||
my $commentfile = $path . '/+COMMENT';
|
||||
# Exclude non-directories, "." and ".."
|
||||
if (($file ne ".") && ($file ne "..") && (-d $path) && (!-s $reqlist)) {
|
||||
# Exclude packages matching exclude pattern, if requested
|
||||
unless ($file =~ m/$excl_pattern/) {
|
||||
# Read package's short description/comment
|
||||
my $comment;
|
||||
if ((-s $commentfile) && (open(COMMENT, $commentfile))) {
|
||||
$comment = <COMMENT>;
|
||||
chomp($comment);
|
||||
close(COMMENT);
|
||||
} else {
|
||||
$comment = "No short description";
|
||||
}
|
||||
$leaves{$file} = $comment;
|
||||
}
|
||||
}
|
||||
}
|
||||
closedir(DBDIR);
|
||||
return %leaves;
|
||||
}
|
||||
|
||||
# Examine command line arguments
|
||||
while(@ARGV) {
|
||||
my $arg = shift(@ARGV);
|
||||
if ($arg eq "-c") {
|
||||
$opt_comments = 1;
|
||||
}
|
||||
elsif ($arg eq "-F") {
|
||||
$opt_pkgdb = 1;
|
||||
}
|
||||
elsif ($arg eq "-l") {
|
||||
$opt_listonly = 1;
|
||||
}
|
||||
elsif ($arg eq "-R") {
|
||||
$opt_recursive = 1;
|
||||
}
|
||||
elsif ($arg eq "-x") {
|
||||
$opt_excludelist = 1;
|
||||
} else {
|
||||
warn "Unrecognized command line argument $arg ignored.\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Exclusion requested?
|
||||
if ($opt_excludelist) {
|
||||
# Get exclusion pattern
|
||||
$exclpattern = get_excl_pattern($excludefile);
|
||||
} else {
|
||||
# Spaces don't appear in package names -> this doesn't exclude anything
|
||||
$exclpattern = " ";
|
||||
}
|
||||
|
||||
if ($opt_listonly) {
|
||||
# Just print out the list of leaves, one per line
|
||||
my %leaves = get_leaves($dbdir, $exclpattern);
|
||||
foreach my $leaf (sort keys %leaves) {
|
||||
if ($opt_comments) {
|
||||
print "$leaf - $leaves{$leaf}\n";
|
||||
} else {
|
||||
print "$leaf\n";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
my %leaves;
|
||||
my %leavestokeep;
|
||||
my %leavestocut;
|
||||
my @cutleaves;
|
||||
my ($nleaves, $i, $again);
|
||||
|
||||
# Get list of leaf packages and put them into a hash
|
||||
%leaves = get_leaves($dbdir, $exclpattern);
|
||||
# Any leaves to work with?
|
||||
$nleaves = keys %leaves;
|
||||
if ($nleaves > 0) {
|
||||
$again = "y";
|
||||
} else {
|
||||
# If not, don't go on, there's nothing to do.
|
||||
print "** Didn't find any leaves to work with, exiting.\n";
|
||||
print "** If this is unexpected, check your exclude file, please.\n";
|
||||
$again = "n";
|
||||
}
|
||||
# Loop while the user wants to
|
||||
ROUND: while($again eq "y") {
|
||||
# Always start with an empty list of leaves to cut
|
||||
%leavestocut = ();
|
||||
# Initialize counter for progress status
|
||||
$i = 1;
|
||||
|
||||
LEAVESLOOP: foreach my $leaf (sort keys %leaves) {
|
||||
print "Package $i of $nleaves:\n";
|
||||
print "$leaf - $leaves{$leaf}\n";
|
||||
print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? ";
|
||||
# Get first character of input, without leading whitespace
|
||||
my ($answer) = (lc(<STDIN>) =~ m/(\S)/);
|
||||
if ($answer eq "d") {
|
||||
print "** Marking $leaf for removal.\n\n";
|
||||
$leavestocut{$leaf} = 1;
|
||||
}
|
||||
elsif ($answer eq "f") {
|
||||
print "\n";
|
||||
last LEAVESLOOP;
|
||||
}
|
||||
elsif ($answer eq "a") {
|
||||
print "\n";
|
||||
last ROUND;
|
||||
}
|
||||
else {
|
||||
print "** Keeping $leaf.\n\n";
|
||||
$leavestokeep{$leaf} = 1;
|
||||
}
|
||||
$i++;
|
||||
} # LEAVESLOOP
|
||||
|
||||
# Initialize 'progress meter'
|
||||
my $ncuts = keys %leavestocut;
|
||||
my $noff = 0;
|
||||
# loop through packages marked for removal and pkg_deinstall them
|
||||
foreach my $leaf (sort keys %leavestocut) {
|
||||
$noff++;
|
||||
print "Deleting $leaf (package $noff of $ncuts).\n";
|
||||
my @deinstall_args;
|
||||
if ($opt_recursive) {
|
||||
@deinstall_args = ($pkgdeinstall, '-R', $leaf);
|
||||
} else {
|
||||
@deinstall_args = ($pkgdeinstall, $leaf);
|
||||
}
|
||||
if ((my $status = system(@deinstall_args) >> 8) != 0) {
|
||||
print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n";
|
||||
last ROUND;
|
||||
}
|
||||
push @cutleaves, $leaf;
|
||||
}
|
||||
|
||||
# Run 'pkgdb -F' if requested
|
||||
if ($opt_pkgdb) {
|
||||
print "Running 'pkgdb -F'.\n";
|
||||
if ((my $status = system(@pkgdb_args) >> 8) != 0) {
|
||||
print STDERR "\n\n$0: pkgdb returned $status - exiting, fix this first.\n\n";
|
||||
last ROUND;
|
||||
}
|
||||
}
|
||||
|
||||
# Get new list of leaf packages and put them into a hash
|
||||
%leaves = get_leaves($dbdir, $exclpattern);
|
||||
# Ignore all leaves the user already told us to keep
|
||||
foreach my $leaf (keys %leavestokeep) {
|
||||
if ($leaves{$leaf}) {
|
||||
delete $leaves{$leaf};
|
||||
}
|
||||
}
|
||||
# Any leaves left?
|
||||
$nleaves = keys %leaves;
|
||||
if ($nleaves == 0) {
|
||||
# If not, don't go on, there's nothing left to do.
|
||||
print "** Didn't find any new leaves to work with, exiting.\n";
|
||||
last ROUND;
|
||||
}
|
||||
|
||||
print "Go on with new leaf packages ((y)es/[no])? ";
|
||||
# Get first character of input, without leading whitespace
|
||||
($again) = (lc(<STDIN>) =~ m/(\S)/);
|
||||
print "\n";
|
||||
} # ROUND
|
||||
|
||||
# print list of removed packages, sorted lexically, and their number
|
||||
print "** Deinstalled packages:\n";
|
||||
foreach my $cutleaf (sort @cutleaves) {
|
||||
print "$cutleaf\n";
|
||||
}
|
||||
my $noff = @cutleaves;
|
||||
print "** Number of deinstalled packages: $noff\n";
|
||||
}
|
||||
|
||||
@ -1,48 +0,0 @@
|
||||
.TH PKG_CUTLEAVES 1 "Jul 2003" FreeBSD
|
||||
.SH NAME
|
||||
pkg_cutleaves \- deinstall 'leaf' packages
|
||||
.SH SYNOPSIS
|
||||
.B pkg_cutleaves [-c] [-F] [-l] [-R] [-x]
|
||||
.SH DESCRIPTION
|
||||
.B pkg_cutleaves
|
||||
finds installed 'leaf' packages, i.e. packages that are not referenced
|
||||
by any other installed package, and lets you decide for each one if you
|
||||
want to keep or deinstall it (via pkg_deinstall(1)).
|
||||
Once the packages marked for removal have been flushed/deinstalled,
|
||||
you'll be asked if you want to do another run (to see packages that have
|
||||
become 'leaves' now because you've deinstalled the package(s) that
|
||||
depended on them). In every run you will be shown only packages that you
|
||||
haven't marked for keeping, yet.
|
||||
|
||||
Note that your package registry database should be up to date for this
|
||||
to work properly, so it might be a good idea to run pkgdb(1) before
|
||||
running pkg_cutleaves.
|
||||
.SH OPTIONS
|
||||
.IP -c
|
||||
When listing leaf packages, also print their comments/short
|
||||
descriptions. Will be ignored unless the '-l' parameter is given, too.
|
||||
.IP -F
|
||||
Run 'pkgdb -F' after each deinstallation run, to make sure the package
|
||||
registry database is up to date. (Note: This is mostly for convenience;
|
||||
it shouldn't be necessary to run 'pkgdb -F' after each run, but it
|
||||
doesn't hurt, either.)
|
||||
.IP -l
|
||||
List leaf packages only, one per line, and don't ask for anything to be
|
||||
deinstalled.
|
||||
.IP -R
|
||||
Run 'pkg_deinstall -R' instead of plain 'pkg_deinstall', so packages the
|
||||
removed leaf packages depend(ed) on will be deinstalled, too.
|
||||
.IP -x
|
||||
Exclude packages matching expressions given in the exclude file.
|
||||
.SH FILES
|
||||
.I /usr/local/etc/pkg_leaves.exclude
|
||||
.RS
|
||||
An optional list for excluding packages when the '-x' option is given.
|
||||
If the beginning of a package's name matches any line (except comment or
|
||||
empty lines) in this file, the package will not be listed/offered for
|
||||
removal (e.g., a line saying just 'XFree86' (without the 's) will
|
||||
exclude all packages with names starting with 'XFree86').
|
||||
.SH AUTHOR
|
||||
Stefan Walter <sw@gegenunendlich.de>
|
||||
.SH SEE ALSO
|
||||
pkg_deinstall(1), pkgdb(1), portsclean(1)
|
||||
@ -4,14 +4,11 @@
|
||||
#
|
||||
# $FreeBSD$
|
||||
#
|
||||
# This port is self contained in the src directory.
|
||||
#
|
||||
|
||||
PORTNAME= pkg_cutleaves
|
||||
PORTVERSION= 20040414
|
||||
PORTVERSION= 20040517
|
||||
CATEGORIES= sysutils
|
||||
MASTER_SITES= # none
|
||||
DISTFILES= # none
|
||||
MASTER_SITES= http://www.gegenunendlich.de/projects/${PORTNAME}/
|
||||
|
||||
MAINTAINER= sw@gegenunendlich.de
|
||||
COMMENT= Interactive script for deinstalling 'leaf' packages
|
||||
@ -22,40 +19,33 @@ NO_BUILD= yes
|
||||
USE_PERL5= yes
|
||||
USE_REINPLACE= yes
|
||||
|
||||
SRC= ${.CURDIR}/src
|
||||
WRKSRC= ${WRKDIR}/${PORTNAME}
|
||||
|
||||
MAN1= pkg_cutleaves.1
|
||||
|
||||
PLIST_FILES= sbin/pkg_cutleaves
|
||||
|
||||
do-fetch:
|
||||
@${DO_NADA}
|
||||
|
||||
pre-patch:
|
||||
@${CP} ${SRC}/pkg_cutleaves ${WRKDIR}/pkg_cutleaves
|
||||
@${CP} ${SRC}/pkg_cutleaves.1 ${WRKDIR}/pkg_cutleaves.1
|
||||
|
||||
post-patch:
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/etc/pkg_leaves.exclude,${PREFIX}/etc/pkg_leaves.exclude,' \
|
||||
${WRKDIR}/pkg_cutleaves.1
|
||||
${WRKSRC}/pkg_cutleaves.1
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/etc/pkg_leaves.exclude,${PREFIX}/etc/pkg_leaves.exclude,' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/sbin/pkg_deinstall,${LOCALBASE}/sbin/pkg_deinstall,' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/usr/local/sbin/pkgdb,${LOCALBASE}/sbin/pkgdb,' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e \
|
||||
's,/var/db/pkg,${PKG_DBDIR},' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
@${REINPLACE_CMD} -e 's,/usr/bin/perl,${PERL},' \
|
||||
${WRKDIR}/pkg_cutleaves
|
||||
${WRKSRC}/pkg_cutleaves
|
||||
|
||||
do-install:
|
||||
${INSTALL_SCRIPT} ${WRKDIR}/pkg_cutleaves ${PREFIX}/sbin/pkg_cutleaves
|
||||
${INSTALL_MAN} ${WRKDIR}/pkg_cutleaves.1 ${MAN1PREFIX}/man/man1
|
||||
${INSTALL_SCRIPT} ${WRKSRC}/pkg_cutleaves ${PREFIX}/sbin/pkg_cutleaves
|
||||
${INSTALL_MAN} ${WRKSRC}/pkg_cutleaves.1 ${MAN1PREFIX}/man/man1
|
||||
|
||||
.include <bsd.port.mk>
|
||||
|
||||
2
sysutils/pkg_cutleaves/distinfo
Normal file
2
sysutils/pkg_cutleaves/distinfo
Normal file
@ -0,0 +1,2 @@
|
||||
MD5 (pkg_cutleaves-20040517.tar.gz) = 24e981428c439f85209578916996d389
|
||||
SIZE (pkg_cutleaves-20040517.tar.gz) = 5091
|
||||
@ -1,270 +0,0 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Copyright (c) 2003 Stefan Walter <sw@gegenunendlich.de>
|
||||
#
|
||||
# All rights reserved.
|
||||
#
|
||||
# Redistribution and use in source and binary forms, with or without
|
||||
# modification, are permitted provided that the following conditions
|
||||
# are met:
|
||||
# 1. Redistributions of source code must retain the above copyright
|
||||
# notice, this list of conditions and the following disclaimer.
|
||||
# 2. Redistributions in binary form must reproduce the above copyright
|
||||
# notice, this list of conditions and the following disclaimer in the
|
||||
# documentation and/or other materials provided with the distribution.
|
||||
#
|
||||
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
|
||||
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
# ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
|
||||
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
# SUCH DAMAGE.
|
||||
#
|
||||
# $FreeBSD$
|
||||
|
||||
# Interactive script for deinstalling "leaf" packages;
|
||||
# requires the portupgrade tools
|
||||
#
|
||||
# Syntax: pkg_cutleaves [-c] [-F] [-l] [-R] [-x]
|
||||
# Options:
|
||||
# -c: Show comments, too; only works with '-l' (ignored otherwise)
|
||||
# -F: Fix package db after each deinstallation run (via 'pkgdb -F')
|
||||
# -l: List leaf packages only, don't ask if they should be deinstalled
|
||||
# -R: Run 'pkg_deinstall -R' instead of plain 'pkg_deinstall'
|
||||
# -x: Honor exclude list in $excludefile
|
||||
|
||||
use strict;
|
||||
|
||||
my $dbdir = "/var/db/pkg";
|
||||
my $excludefile = "/usr/local/etc/pkg_leaves.exclude";
|
||||
my $pkgdeinstall = "/usr/local/sbin/pkg_deinstall";
|
||||
my @pkgdb_args = ("/usr/local/sbin/pkgdb", "-F");
|
||||
my ($opt_comments, $opt_listonly, $opt_excludelist, $opt_recursive, $opt_pkgdb);
|
||||
my $exclpattern;
|
||||
|
||||
#
|
||||
# Read the exclude list if the file exists
|
||||
# Parameter: path of the exclude file
|
||||
#
|
||||
sub get_excl_pattern {
|
||||
my $excl_file = shift;
|
||||
my $excl_pattern;
|
||||
# Does the exclude file exist?
|
||||
if (($excl_file) && (-f $excl_file) && (-T $excl_file)) {
|
||||
# Read the patterns to be excluded
|
||||
my @excludes;
|
||||
open(EXCLFILE, $excl_file)
|
||||
or die "Couldn't open $excl_file!";
|
||||
while(my $exclude = <EXCLFILE>) {
|
||||
chomp($exclude);
|
||||
# Ignore comments and empty lines, add others as regular expressions
|
||||
unless (($exclude =~ m/(^ *#)|(^ *$)/)) {
|
||||
# Escape any '+' that isn't already escaped
|
||||
$exclude =~ s/(?<!\\)(\+|\.)/\\$1/g;
|
||||
$exclude = "^" . $exclude . ".*";
|
||||
push @excludes, $exclude;
|
||||
}
|
||||
}
|
||||
close(EXCLFILE);
|
||||
# Provide a dummy exclusion pattern if @excludes is empty
|
||||
$excl_pattern = scalar(@excludes) ? join("|", @excludes) : " ";
|
||||
} else {
|
||||
# Dummy exclusion pattern -> doesn't exclude anything
|
||||
$excl_pattern = " ";
|
||||
}
|
||||
return $excl_pattern;
|
||||
}
|
||||
|
||||
#
|
||||
# Get a hash (name => comment) of all leaves
|
||||
# Parameters: - path to package database
|
||||
# - pattern of packages to exclude
|
||||
#
|
||||
sub get_leaves {
|
||||
my $db_dir = shift;
|
||||
my $excl_pattern = shift;
|
||||
my %leaves;
|
||||
opendir(DBDIR, $db_dir)
|
||||
or die "Can't open package db directory $db_dir!";
|
||||
while(defined(my $file = readdir(DBDIR))) {
|
||||
my $path = $db_dir . '/' . $file;
|
||||
my $reqlist = $path . '/+REQUIRED_BY';
|
||||
my $commentfile = $path . '/+COMMENT';
|
||||
# Exclude non-directories, "." and ".."
|
||||
if (($file ne ".") && ($file ne "..") && (-d $path) && (!-s $reqlist)) {
|
||||
# Exclude packages matching exclude pattern, if requested
|
||||
unless ($file =~ m/$excl_pattern/) {
|
||||
# Read package's short description/comment
|
||||
my $comment;
|
||||
if ((-s $commentfile) && (open(COMMENT, $commentfile))) {
|
||||
$comment = <COMMENT>;
|
||||
chomp($comment);
|
||||
close(COMMENT);
|
||||
} else {
|
||||
$comment = "No short description";
|
||||
}
|
||||
$leaves{$file} = $comment;
|
||||
}
|
||||
}
|
||||
}
|
||||
closedir(DBDIR);
|
||||
return %leaves;
|
||||
}
|
||||
|
||||
# Examine command line arguments
|
||||
while(@ARGV) {
|
||||
my $arg = shift(@ARGV);
|
||||
if ($arg eq "-c") {
|
||||
$opt_comments = 1;
|
||||
}
|
||||
elsif ($arg eq "-F") {
|
||||
$opt_pkgdb = 1;
|
||||
}
|
||||
elsif ($arg eq "-l") {
|
||||
$opt_listonly = 1;
|
||||
}
|
||||
elsif ($arg eq "-R") {
|
||||
$opt_recursive = 1;
|
||||
}
|
||||
elsif ($arg eq "-x") {
|
||||
$opt_excludelist = 1;
|
||||
} else {
|
||||
warn "Unrecognized command line argument $arg ignored.\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Exclusion requested?
|
||||
if ($opt_excludelist) {
|
||||
# Get exclusion pattern
|
||||
$exclpattern = get_excl_pattern($excludefile);
|
||||
} else {
|
||||
# Spaces don't appear in package names -> this doesn't exclude anything
|
||||
$exclpattern = " ";
|
||||
}
|
||||
|
||||
if ($opt_listonly) {
|
||||
# Just print out the list of leaves, one per line
|
||||
my %leaves = get_leaves($dbdir, $exclpattern);
|
||||
foreach my $leaf (sort keys %leaves) {
|
||||
if ($opt_comments) {
|
||||
print "$leaf - $leaves{$leaf}\n";
|
||||
} else {
|
||||
print "$leaf\n";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
my %leaves;
|
||||
my %leavestokeep;
|
||||
my %leavestocut;
|
||||
my @cutleaves;
|
||||
my ($nleaves, $i, $again);
|
||||
|
||||
# Get list of leaf packages and put them into a hash
|
||||
%leaves = get_leaves($dbdir, $exclpattern);
|
||||
# Any leaves to work with?
|
||||
$nleaves = keys %leaves;
|
||||
if ($nleaves > 0) {
|
||||
$again = "y";
|
||||
} else {
|
||||
# If not, don't go on, there's nothing to do.
|
||||
print "** Didn't find any leaves to work with, exiting.\n";
|
||||
print "** If this is unexpected, check your exclude file, please.\n";
|
||||
$again = "n";
|
||||
}
|
||||
# Loop while the user wants to
|
||||
ROUND: while($again eq "y") {
|
||||
# Always start with an empty list of leaves to cut
|
||||
%leavestocut = ();
|
||||
# Initialize counter for progress status
|
||||
$i = 1;
|
||||
|
||||
LEAVESLOOP: foreach my $leaf (sort keys %leaves) {
|
||||
print "Package $i of $nleaves:\n";
|
||||
print "$leaf - $leaves{$leaf}\n";
|
||||
print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? ";
|
||||
# Get first character of input, without leading whitespace
|
||||
my ($answer) = (lc(<STDIN>) =~ m/(\S)/);
|
||||
if ($answer eq "d") {
|
||||
print "** Marking $leaf for removal.\n\n";
|
||||
$leavestocut{$leaf} = 1;
|
||||
}
|
||||
elsif ($answer eq "f") {
|
||||
print "\n";
|
||||
last LEAVESLOOP;
|
||||
}
|
||||
elsif ($answer eq "a") {
|
||||
print "\n";
|
||||
last ROUND;
|
||||
}
|
||||
else {
|
||||
print "** Keeping $leaf.\n\n";
|
||||
$leavestokeep{$leaf} = 1;
|
||||
}
|
||||
$i++;
|
||||
} # LEAVESLOOP
|
||||
|
||||
# Initialize 'progress meter'
|
||||
my $ncuts = keys %leavestocut;
|
||||
my $noff = 0;
|
||||
# loop through packages marked for removal and pkg_deinstall them
|
||||
foreach my $leaf (sort keys %leavestocut) {
|
||||
$noff++;
|
||||
print "Deleting $leaf (package $noff of $ncuts).\n";
|
||||
my @deinstall_args;
|
||||
if ($opt_recursive) {
|
||||
@deinstall_args = ($pkgdeinstall, '-R', $leaf);
|
||||
} else {
|
||||
@deinstall_args = ($pkgdeinstall, $leaf);
|
||||
}
|
||||
if ((my $status = system(@deinstall_args) >> 8) != 0) {
|
||||
print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n";
|
||||
last ROUND;
|
||||
}
|
||||
push @cutleaves, $leaf;
|
||||
}
|
||||
|
||||
# Run 'pkgdb -F' if requested
|
||||
if ($opt_pkgdb) {
|
||||
print "Running 'pkgdb -F'.\n";
|
||||
if ((my $status = system(@pkgdb_args) >> 8) != 0) {
|
||||
print STDERR "\n\n$0: pkgdb returned $status - exiting, fix this first.\n\n";
|
||||
last ROUND;
|
||||
}
|
||||
}
|
||||
|
||||
# Get new list of leaf packages and put them into a hash
|
||||
%leaves = get_leaves($dbdir, $exclpattern);
|
||||
# Ignore all leaves the user already told us to keep
|
||||
foreach my $leaf (keys %leavestokeep) {
|
||||
if ($leaves{$leaf}) {
|
||||
delete $leaves{$leaf};
|
||||
}
|
||||
}
|
||||
# Any leaves left?
|
||||
$nleaves = keys %leaves;
|
||||
if ($nleaves == 0) {
|
||||
# If not, don't go on, there's nothing left to do.
|
||||
print "** Didn't find any new leaves to work with, exiting.\n";
|
||||
last ROUND;
|
||||
}
|
||||
|
||||
print "Go on with new leaf packages ((y)es/[no])? ";
|
||||
# Get first character of input, without leading whitespace
|
||||
($again) = (lc(<STDIN>) =~ m/(\S)/);
|
||||
print "\n";
|
||||
} # ROUND
|
||||
|
||||
# print list of removed packages, sorted lexically, and their number
|
||||
print "** Deinstalled packages:\n";
|
||||
foreach my $cutleaf (sort @cutleaves) {
|
||||
print "$cutleaf\n";
|
||||
}
|
||||
my $noff = @cutleaves;
|
||||
print "** Number of deinstalled packages: $noff\n";
|
||||
}
|
||||
|
||||
@ -1,48 +0,0 @@
|
||||
.TH PKG_CUTLEAVES 1 "Jul 2003" FreeBSD
|
||||
.SH NAME
|
||||
pkg_cutleaves \- deinstall 'leaf' packages
|
||||
.SH SYNOPSIS
|
||||
.B pkg_cutleaves [-c] [-F] [-l] [-R] [-x]
|
||||
.SH DESCRIPTION
|
||||
.B pkg_cutleaves
|
||||
finds installed 'leaf' packages, i.e. packages that are not referenced
|
||||
by any other installed package, and lets you decide for each one if you
|
||||
want to keep or deinstall it (via pkg_deinstall(1)).
|
||||
Once the packages marked for removal have been flushed/deinstalled,
|
||||
you'll be asked if you want to do another run (to see packages that have
|
||||
become 'leaves' now because you've deinstalled the package(s) that
|
||||
depended on them). In every run you will be shown only packages that you
|
||||
haven't marked for keeping, yet.
|
||||
|
||||
Note that your package registry database should be up to date for this
|
||||
to work properly, so it might be a good idea to run pkgdb(1) before
|
||||
running pkg_cutleaves.
|
||||
.SH OPTIONS
|
||||
.IP -c
|
||||
When listing leaf packages, also print their comments/short
|
||||
descriptions. Will be ignored unless the '-l' parameter is given, too.
|
||||
.IP -F
|
||||
Run 'pkgdb -F' after each deinstallation run, to make sure the package
|
||||
registry database is up to date. (Note: This is mostly for convenience;
|
||||
it shouldn't be necessary to run 'pkgdb -F' after each run, but it
|
||||
doesn't hurt, either.)
|
||||
.IP -l
|
||||
List leaf packages only, one per line, and don't ask for anything to be
|
||||
deinstalled.
|
||||
.IP -R
|
||||
Run 'pkg_deinstall -R' instead of plain 'pkg_deinstall', so packages the
|
||||
removed leaf packages depend(ed) on will be deinstalled, too.
|
||||
.IP -x
|
||||
Exclude packages matching expressions given in the exclude file.
|
||||
.SH FILES
|
||||
.I /usr/local/etc/pkg_leaves.exclude
|
||||
.RS
|
||||
An optional list for excluding packages when the '-x' option is given.
|
||||
If the beginning of a package's name matches any line (except comment or
|
||||
empty lines) in this file, the package will not be listed/offered for
|
||||
removal (e.g., a line saying just 'XFree86' (without the 's) will
|
||||
exclude all packages with names starting with 'XFree86').
|
||||
.SH AUTHOR
|
||||
Stefan Walter <sw@gegenunendlich.de>
|
||||
.SH SEE ALSO
|
||||
pkg_deinstall(1), pkgdb(1), portsclean(1)
|
||||
Loading…
Reference in New Issue
Block a user