path: root/usr.sbin/pkg_add/pkg_delete

#!/usr/bin/perl
# ex:ts=8 sw=4:
# $OpenBSD: pkg_delete,v 1.23 2004/02/25 21:56:12 espie Exp $
#
# Copyright (c) 2003 Marc Espie.
# 
# 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 OPENBSD PROJECT 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 OPENBSD
# PROJECT 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.

use strict;
use warnings;
use Getopt::Std;
use OpenBSD::PackingList;
use OpenBSD::PackageInfo;
use OpenBSD::RequiredBy;
use OpenBSD::Logger;
use OpenBSD::Vstat;

our %forced = ();

package OpenBSD::PackingElement;
sub delete
{
}

sub record_dirrm
{
}

sub log_pkgname
{
	my ($self, $state) = @_;
	if (defined $state->{pkgname_tolog}) {
		OpenBSD::Logger::log
		    "# package ", $state->{pkgname_tolog}, "\n";
	$state->{pkgname_tolog} = undef;
	}
}

package OpenBSD::PackingElement::DirRm;
use OpenBSD::PackageInfo;

sub record_dirrm
{
	my ($self, $pkgname, $db) = @_;
	my $k = $self->fullname();
	$db->{$k} = [] unless defined $db->{$k};
	push(@{$db->{$k}}, $pkgname);
}

sub find_alldirrms
{
	my $db = {};
	my @list = installed_packages();
	for my $e (@list) {
		my $plist = OpenBSD::PackingList->fromfile(installed_info($e).CONTENTS, \&OpenBSD::PackingList::DirrmOnly) or next;
		for my $item (@{$plist->{items}}) {
			$item->record_dirrm($e, $db);
		}
	}
	return $db;
}

sub delete
{
	my ($self, $state) = @_;
	my $name = $self->fullname();
	my $realname = $state->{destdir}.$name;

	if ($state->{verbose} or $state->{not}) {
		print "dirrm: $name\n";
	}
	unless (defined $state->{dirrms}) {
		$state->{dirrms} = find_alldirrms();
	}
	return if $state->{not};
	my $entry = $state->{dirrms}->{$name};
	unless (defined $entry) {
		print "Error: dirrm $name was not recorded\n";
		return;
	}
	if (@$entry == 0) {
		print "Error: no dirrm $name left\n";
	}
	elsif (@$entry == 1) {
		if ($entry->[0] eq $state->{pkgname}) {
			if (!rmdir $realname) {
			    print "Error deleting directory $realname\n";
			    $self->log_pkgname($state);
			    OpenBSD::Logger::log "rmdir $state->{destdirname}$name\n";
			}
			$state->{dirrms}->{$name} = undef;
		} else {
			print "Error: dirrm $name recorded as ", 
			    $entry->[0], "\n";
		}
	}
	elsif (@$entry > 1) {
		print "Dirrm $name defined in multiple packages: ",
			join(",", @$entry), "\n" if $state->{verbose};
	    	@$entry = grep { $_ ne $state->{pkgname} }  @$entry;
	}
}

package OpenBSD::PackingElement::Unexec;
sub delete
{
	my ($self, $state) = @_;
	my $cmd = $self->{expanded};
	if ($state->{verbose} or $state->{not}) {
		print "unexec: $cmd\n";
	}
	return if $state->{not};
	system('/bin/sh', '-c', $cmd);
}

package OpenBSD::PackingElement::File;
use OpenBSD::md5;
sub delete
{
	my ($self, $state) = @_;
	my $name = $self->fullname();
	my $realname = $state->{destdir}.$name;
	if (-l $realname) {
		if ($state->{verbose} or $state->{not}) {
			print "deleting symlink: $realname\n";
		}
	} else {
		unless ($self->{nochecksum} or $state->{quick}) {
			if (!defined $self->{md5}) {
				print "Problem: $name does not have an md5 checksum\n";
				print "NOT deleting: $realname\n";
				$self->log_pkgname($state);
				OpenBSD::Logger::log "rm $state->{destdirname}$name\n";
				return;
			}
			if (! -f $realname) {
				print "File $realname does not exist\n";
				return;
			}
			my $md5 = OpenBSD::md5::fromfile($realname);
			if ($md5 ne $self->{md5}) {
				print "Problem: md5 doesn't match for $name\n";
				print "NOT deleting: $realname\n";
				$self->log_pkgname($state);
				OpenBSD::Logger::log "rm $state->{destdirname}$name #MD5\n";
				return;
			}
		}
		if ($state->{verbose} or $state->{not}) {
			print "deleting: $realname\n";
		}
	}
	return if $state->{not};
	if (!unlink $realname) {
		print "Problem deleting $realname\n";
		$self->log_pkgname($state);
		OpenBSD::Logger::log "rm $state->{destdirname}$name\n";
	}
}

package OpenBSD::PackingElement::Extra;
sub delete
{
	my ($self, $state) = @_;
	return unless $state->{extra};
	my $name = $self->fullname();
	my $realname = $state->{destdir}.$name;
	if ($self->{name} =~ m|/$|) {
		if ($state->{verbose} or $state->{not}) {
			print "deleting extra directory: $realname\n";
		}
		return if $state->{not};
		return unless -e $realname;
		rmdir($realname) or 
		    print "problem deleting extra directory $realname\n";
	} else {
		if ($state->{verbose} or $state->{not}) {
			print "deleting extra file: $realname\n";
		}
		return if $state->{not};
		return unless -e $realname;
		unlink($realname) or 
		    print "problem deleting extra file $realname\n";
	}
}

package OpenBSD::PackingElement::ExtraUnexec;
sub delete
{
	my ($self, $state) = @_;
	return unless $state->{extra};

	my $cmd = $self->{expanded};
	if ($state->{verbose} or $state->{not}) {
		print "unexec: $cmd\n";
	}
	return if $state->{not};
	system($cmd);
}

package OpenBSD::PackingElement::FREQUIRE;
use OpenBSD::PackageInfo;
sub delete
{
	my ($self, $state) = @_;

	my $dir = $state->{dir};
	my $opt_v = $state->{verbose};
	my $opt_n = $state->{not};
	my $pkgname = $state->{pkgname};

	print "Require script: $dir",REQUIRE," $pkgname DEINSTALL\n" if $opt_v or $opt_n;
	unless ($opt_n) {
		chmod 0755, $dir.REQUIRE;
		system($dir.REQUIRE, $pkgname, "DEINSTALL") == 0 or 
		    die "Require script borked";
	}
}

package OpenBSD::PackingElement::FDEINSTALL;
use OpenBSD::PackageInfo;
sub delete
{
	my ($self, $state) = @_;

	my $dir = $state->{dir};
	my $opt_v = $state->{verbose};
	my $opt_n = $state->{not};
	my $pkgname = $state->{pkgname};
	print "Deinstall script: $dir",DEINSTALL ," $pkgname DEINSTALL\n" if $opt_v or $opt_n;
	unless ($opt_n) {
		chmod 0755, $dir.DEINSTALL;
		system($dir.DEINSTALL, $pkgname, "DEINSTALL") == 0 or 
		    die "deinstall script borked";
	}
}

package main;

our ($opt_v, $opt_D, $opt_d, $opt_n, $opt_f, $opt_q, $opt_p, $opt_c, $opt_L, $opt_B);

sub remove_packing_info
{
	my $dir = shift;

	for my $fname (info_names()) {
		unlink($dir.$fname);
	}
	rmdir($dir) or die "Can't finish removing directory $dir: $!";
}

sub delete_package
{
	my ($pkgname, $state) = @_;
	$state->{pkgname} = $pkgname;
	my $dir = installed_info($pkgname);
	$state->{dir} = $dir;
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS) or 
	    die "Bad package";
	if (!defined $plist->pkgname()) {
		die "Package $pkgname has no name";
	}
	if ($plist->pkgname() ne $pkgname) {
		die "Package $pkgname real name does not match";
	}

	my $problems = 0;
	for my $item (@{$plist->{items}}) {
		next unless $item->IsFile();
		my $fname = $item->fullname();
		my $s = OpenBSD::Vstat::remove($fname, $item->{size});
		next unless defined $s;
		if ($s->{ro}) {
			print "Error: ", $s->{mnt}, " is read-only ($fname)\n";
			$problems++;
		}
	}
	die if $problems;

	$ENV{'PKG_PREFIX'} = $plist->pkgbase();
	if ($plist->has(REQUIRE)) {
		$plist->get(REQUIRE)->delete($state);
	}
	if ($plist->has(DEINSTALL)) {
		$plist->get(DEINSTALL)->delete($state);
	} 
	for my $item (@{$plist->{items}}) {
		$item->delete($state);
	}
	# guard against duplicate pkgdep
	my $removed = {};
	for my $item (@{$plist->{pkgdep}}) {
		my $name = $item->{name};
		next if defined $removed->{$name};
		print "remove dependency in $name\n" if $opt_v or $opt_n;
		local $@;
		eval { OpenBSD::RequiredBy->new($name)->delete($pkgname) unless $opt_n; };
		if ($@) {
			print STDERR "$@\n";
		}
		$removed->{$name} = 1;
	}
	remove_packing_info($dir) unless $opt_n;
}

getopts('vcDdnf:qpS:L:B:');
$opt_B = $ENV{'PKG_DESTDIR'} unless defined $opt_B;
$opt_B = '' unless defined $opt_B;
if ($opt_B ne '') {
	$opt_B.='/' unless $opt_B =~ m/\/$/;
}
$ENV{'PKG_DESTDIR'} = $opt_B;

$opt_L = '/usr/local' unless defined $opt_L;

if (defined $opt_p) {
	die "Option p is obsolete";
}
if (defined $opt_d) {
	die "Option d is obsolete";
}

if ($opt_f) {
	%forced = map {($_, 1)} split(/,/, $opt_f);
}

if ($< && !$forced{nonroot}) {
	die "$0 must be run as root";
}

my %done;
my $removed;

my $state = {};
$state->{not} = $opt_n;
$state->{quick} = $opt_q;
$state->{verbose} = $opt_v;
$state->{extra} = $opt_c;
$ENV{'PKG_DELETE_EXTRA'} = $state->{extra} ? "Yes" : "No";

# First, resolve pkg names

my @realnames;
my $bad;

for my $pkgname (@ARGV) {
    $pkgname =~ s/\.tgz$//;
    if (is_installed($pkgname)) {
	push(@realnames, installed_name($pkgname));
    } else {
	if (OpenBSD::PackageName::is_stem($pkgname)) {
	    my @l = OpenBSD::PackageName::findstem($pkgname, 
		installed_packages());
	    if (@l == 0) {
		print "Can't resolve $pkgname to an installed package name\n";
		$bad = 1 unless $forced{uninstalled};
	    } elsif (@l == 1) {
		push(@realnames, $l[0]);
	    } elsif (@l != 0) {
		print "Ambiguous: $pkgname could be ", join(' ', @l),"\n";
		if ($forced{ambiguous}) {
		    print "(removing them all)\n";
		    push(@realnames, @l);
		} else {
		    $bad = 1;
		}
	    }
	}
    }
}

# Then check that dependencies are okay
my (%toremove, %extra_rm);
my @todo;
for my $pkgname (@realnames) {
	$toremove{$pkgname} = 1;
}

push(@todo, @realnames);

OpenBSD::Logger::log_as("pkg_delete");

while (my $pkgname = pop @todo) {
	my $deps = OpenBSD::RequiredBy->new($pkgname)->list();
	if (@$deps > 0) {
		for my $dep (@$deps) {
			next if defined $toremove{$dep};
			next if defined $extra_rm{$dep};
			$extra_rm{$dep}=$pkgname;
			push(@todo, $dep);
		}
	}
}

if (keys(%extra_rm) != 0) {
	print "Can't remove ", join(' ', @ARGV), " without also removing:\n",
	    join(' ', keys(%extra_rm)), "\n";
	if ($forced{dependencies}) {
		print "(removing them as well)\n";
		push(@realnames, keys(%extra_rm));
	} else {
		$bad = 1;
	}
}

if ($bad) {
	exit(1);
}

$state->{destdir} = $opt_B;
if ($opt_B eq '') {
    $state->{destdirname} = '';
} else {
    OpenBSD::Logger::annotate("PKG_DESTDIR=\"$opt_B\"; export PKG_DESTDIR\n");
    $state->{destdirname} = '${PKG_DESTDIR}';
}

# and finally, handle the removal
{ do {
	$removed = 0;
	for my $pkgname (@realnames) {
		next if $done{$pkgname};
		unless (is_installed($pkgname)) {
			print "$pkgname was not installed\n";
			$done{$pkgname} = 1;
			$removed++;
			next;
		}
		my $deps = OpenBSD::RequiredBy->new($pkgname)->list();
		next if @$deps > 0;
		print $opt_n ? "Pretending to delete " : "Deleting ", 
		    "$pkgname\n";
		$state->{pkgname_tolog} = $pkgname;
		delete_package($pkgname, $state);
		delete_installed($pkgname);
		$done{$pkgname} = 1;
		$removed++;
	}
	# we're not actually doing anything, so we can't expect this loop 
	# to ever finish
	last if $opt_n;
} while ($removed); }

my $logname = OpenBSD::Logger::logname();
if (defined $logname) {
	print "Problems logged as $logname\n";
}