1a409537dSespie#!/usr/bin/perl
2a409537dSespie# ex:ts=8 sw=4:
3*52fcbadbSespie# $OpenBSD: PkgDelete.pm,v 1.38 2017/03/13 11:36:23 espie Exp $
4a409537dSespie#
5a409537dSespie# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org>
6a409537dSespie#
7a409537dSespie# Permission to use, copy, modify, and distribute this software for any
8a409537dSespie# purpose with or without fee is hereby granted, provided that the above
9a409537dSespie# copyright notice and this permission notice appear in all copies.
10a409537dSespie#
11a409537dSespie# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12a409537dSespie# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13a409537dSespie# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14a409537dSespie# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15a409537dSespie# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16a409537dSespie# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17a409537dSespie# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18a409537dSespie
19a409537dSespieuse strict;
20a409537dSespieuse warnings;
21a409537dSespie
22a409537dSespieuse OpenBSD::AddDelete;
23a409537dSespie
24295c9761Sespie
25681090d4Sespiepackage OpenBSD::PkgDelete::Tracker;
26681090d4Sespie
27681090d4Sespiesub new
28681090d4Sespie{
29681090d4Sespie	my $class = shift;
30681090d4Sespie	bless {}, $class;
31681090d4Sespie}
32681090d4Sespie
33681090d4Sespiesub sets_todo
34681090d4Sespie{
35681090d4Sespie	my ($self, $offset) = @_;
36681090d4Sespie	return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset,
37681090d4Sespie		scalar keys %{$self->{total}});
38681090d4Sespie}
39681090d4Sespie
40681090d4Sespiesub handle_set
41681090d4Sespie{
42681090d4Sespie	my ($self, $set) = @_;
43681090d4Sespie	$self->{total}{$set} = 1;
44681090d4Sespie	if ($set->{finished}) {
45681090d4Sespie		$self->{done}{$set} = 1;
46681090d4Sespie	}
47681090d4Sespie}
48681090d4Sespie
49681090d4Sespiesub todo
50681090d4Sespie{
5146412527Sespie	my ($self, @list) = @_;
5246412527Sespie	for my $set (@list) {
53681090d4Sespie		for my $pkgname ($set->older_names) {
54681090d4Sespie			$self->{todo}{$pkgname} = $set;
55681090d4Sespie		}
56681090d4Sespie		$self->handle_set($set);
57681090d4Sespie	}
58681090d4Sespie}
59681090d4Sespie
60681090d4Sespie
61681090d4Sespiesub done
62681090d4Sespie{
63681090d4Sespie	my ($self, $set) = @_;
64681090d4Sespie	$set->{finished} = 1;
65681090d4Sespie	for my $pkgname ($set->older_names) {
66681090d4Sespie		delete $self->{todo}{$pkgname};
67681090d4Sespie	}
68681090d4Sespie	$self->handle_set($set);
69681090d4Sespie}
70681090d4Sespie
7146412527Sespiesub cant
7246412527Sespie{
7346412527Sespie	&done;
7446412527Sespie}
75681090d4Sespiesub find
76681090d4Sespie{
77681090d4Sespie	my ($self, $pkgname) = @_;
78681090d4Sespie	return $self->{todo}{$pkgname};
79681090d4Sespie}
80681090d4Sespie
81681090d4Sespie
82681090d4Sespie
83a409537dSespiepackage OpenBSD::PkgDelete::State;
84a409537dSespieour @ISA = qw(OpenBSD::AddDelete::State);
85a409537dSespie
86681090d4Sespiesub new
87681090d4Sespie{
88681090d4Sespie	my $class = shift;
89681090d4Sespie	my $self = $class->SUPER::new(@_);
90681090d4Sespie	$self->{tracker} = OpenBSD::PkgDelete::Tracker->new;
91681090d4Sespie	return $self;
92681090d4Sespie}
93681090d4Sespie
94681090d4Sespiesub tracker
95681090d4Sespie{
96681090d4Sespie	my $self = shift;
97681090d4Sespie	return $self->{tracker};
98681090d4Sespie}
99681090d4Sespie
1008a660df1Sespiesub handle_options
1018a660df1Sespie{
1028a660df1Sespie	my $state = shift;
103bd849d19Sespie	$state->SUPER::handle_options('X',
104*52fcbadbSespie	    '[-acimnqsVvXx] [-B pkg-destdir] [-D name[=value]] [pkg-name ...]');
1058a660df1Sespie
1068a660df1Sespie	my $base = $state->opt('B') // $ENV{'PKG_DESTDIR'} // '';
1078a660df1Sespie	if ($base ne '') {
1088a660df1Sespie		$base.='/' unless $base =~ m/\/$/o;
1098a660df1Sespie	}
1108a660df1Sespie	$ENV{'PKG_DESTDIR'} = $base;
1118a660df1Sespie
1128a660df1Sespie	$state->{destdir} = $base;
1138a660df1Sespie	if ($base eq '') {
1148a660df1Sespie	    $state->{destdirname} = '';
1158a660df1Sespie	} else {
1168a660df1Sespie	    $state->{destdirname} = '${PKG_DESTDIR}';
1178a660df1Sespie	}
118bd849d19Sespie	$state->{exclude} = $state->opt('X');
1198a660df1Sespie}
1208a660df1Sespie
121681090d4Sespiesub stem2location
122681090d4Sespie{
123681090d4Sespie	my ($self, $locator, $name, $state) = @_;
124681090d4Sespie	require OpenBSD::Search;
125681090d4Sespie	my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name));
126681090d4Sespie	if (@$l > 1 && !$state->defines('allversions')) {
127681090d4Sespie		$l = OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l);
128681090d4Sespie	}
129681090d4Sespie	return $state->choose_location($name, $l);
130a409537dSespie}
131a409537dSespie
132303a35c3Sespiesub deleteset
133303a35c3Sespie{
134303a35c3Sespie	my $self = shift;
135303a35c3Sespie	require OpenBSD::UpdateSet;
136303a35c3Sespie
137303a35c3Sespie	return OpenBSD::DeleteSet->new($self);
138303a35c3Sespie}
139303a35c3Sespie
140303a35c3Sespiesub deleteset_from_location
141303a35c3Sespie{
142303a35c3Sespie	my ($self, $location) = @_;
143303a35c3Sespie	return $self->deleteset->add_older(OpenBSD::Handle->from_location($location));
144303a35c3Sespie}
145303a35c3Sespie
146d2f781d7Sespiepackage OpenBSD::DeleteSet;
147d2f781d7Sespiesub setup_header
148d2f781d7Sespie{
149d2f781d7Sespie	my ($set, $state, $handle) = @_;
150d2f781d7Sespie	my $header = $state->deptree_header($set);
151d2f781d7Sespie	if (defined $handle) {
152d2f781d7Sespie		$header .= $handle->pkgname;
153d2f781d7Sespie	} else {
154d2f781d7Sespie		$header .= $set->print;
155d2f781d7Sespie	}
156d2f781d7Sespie	if (!$state->progress->set_header($header)) {
157d2f781d7Sespie		return unless $state->verbose;
158d2f781d7Sespie		$header = "Deleting $header";
159d2f781d7Sespie		if (defined $state->{lastheader} &&
160d2f781d7Sespie		    $header eq $state->{lastheader}) {
161d2f781d7Sespie			return;
162d2f781d7Sespie		}
163d2f781d7Sespie		$state->{lastheader} = $header;
164d2f781d7Sespie		$state->print("#1", $header);
165d2f781d7Sespie		$state->print("(pretending) ") if $state->{not};
166d2f781d7Sespie		$state->print("\n");
167d2f781d7Sespie	}
168d2f781d7Sespie}
169d2f781d7Sespie
170a409537dSespiepackage OpenBSD::PkgDelete;
171a409537dSespieour @ISA = qw(OpenBSD::AddDelete);
172a409537dSespie
173a409537dSespieuse OpenBSD::PackingList;
174a409537dSespieuse OpenBSD::RequiredBy;
175a409537dSespieuse OpenBSD::Delete;
176a409537dSespieuse OpenBSD::PackageInfo;
177a409537dSespieuse OpenBSD::UpdateSet;
178681090d4Sespieuse OpenBSD::Handle;
179a409537dSespie
180a409537dSespie
181681090d4Sespiesub add_location
182681090d4Sespie{
183681090d4Sespie	my ($self, $state, $l) = @_;
184681090d4Sespie	push(@{$state->{setlist}},
185303a35c3Sespie	    $state->deleteset_from_location($l));
186681090d4Sespie}
187681090d4Sespie
188681090d4Sespiesub create_locations
189681090d4Sespie{
190681090d4Sespie	my ($state, @l) = @_;
191681090d4Sespie	my $inst = $state->repo->installed;
192681090d4Sespie	my $result = [];
193681090d4Sespie	for my $name (@l) {
194681090d4Sespie		my $l = $inst->find($name, $state->{arch});
195681090d4Sespie		if (!defined $l) {
196681090d4Sespie			$state->errsay("Can't find #1 in installed packages",
197681090d4Sespie			    $name);
198681090d4Sespie			$state->{bad}++;
199681090d4Sespie		} else {
200303a35c3Sespie			push(@$result, $state->deleteset_from_location($l));
201681090d4Sespie		}
202681090d4Sespie	}
203681090d4Sespie	return $result;
204681090d4Sespie}
205681090d4Sespie
206a409537dSespiesub process_parameters
207a409537dSespie{
208a409537dSespie	my ($self, $state) = @_;
2097096cf21Sespie
210681090d4Sespie	my $inst = $state->repo->installed;
2117096cf21Sespie
212fef35309Sespie	if (@ARGV == 0) {
21353a284c3Sespie		if (!($state->{automatic} || $state->{exclude})) {
214fef35309Sespie			$state->fatal("No packages to delete");
215a409537dSespie		}
216a409537dSespie	} else {
217681090d4Sespie		for my $pkgname (@ARGV) {
218681090d4Sespie			my $l;
219681090d4Sespie
220681090d4Sespie			if (OpenBSD::PackageName::is_stem($pkgname)) {
221fef35309Sespie				$l = $state->stem2location($inst, $pkgname,
222fef35309Sespie				    $state);
223681090d4Sespie			} else {
224db099e94Sespie				$l = $inst->find($pkgname);
225681090d4Sespie			}
226681090d4Sespie			if (!defined $l) {
227295c9761Sespie				unless ($state->{exclude}) {
22845d818e9Sespie					$state->say("Problem finding #1",
22945d818e9Sespie					    $pkgname);
230a409537dSespie					$state->{bad}++;
231295c9761Sespie				}
232681090d4Sespie			} else {
233681090d4Sespie				$self->add_location($state, $l);
234a409537dSespie			}
235a409537dSespie		}
236681090d4Sespie	}
237a409537dSespie}
238a409537dSespie
239a409537dSespiesub finish_display
240a409537dSespie{
241a409537dSespie}
242a409537dSespie
243681090d4Sespiesub really_remove
244681090d4Sespie{
245681090d4Sespie	my ($set, $state) = @_;
246681090d4Sespie	if ($state->{not}) {
247681090d4Sespie		$state->status->what("Pretending to delete");
248681090d4Sespie	} else {
249681090d4Sespie		$state->status->what("Deleting");
250681090d4Sespie	}
251d2f781d7Sespie	$set->setup_header($state);
252681090d4Sespie	for my $pkgname ($set->older_names) {
253d2f781d7Sespie		$set->setup_header($state, $set->{older}{$pkgname});
254681090d4Sespie		$state->log->set_context('-'.$pkgname);
255681090d4Sespie		OpenBSD::Delete::delete_package($pkgname, $state);
256681090d4Sespie	}
257681090d4Sespie	$state->progress->next($state->ntogo);
258de512720Sespie	$state->syslog("Removed #1", $set->print);
259681090d4Sespie}
260681090d4Sespie
261f1ddee08Sespiesub delete_dependencies
262f1ddee08Sespie{
263f1ddee08Sespie	my $state = shift;
264f1ddee08Sespie
265f1ddee08Sespie	if ($state->defines("dependencies")) {
266f1ddee08Sespie		return 1;
267f1ddee08Sespie	}
268f1ddee08Sespie	return $state->confirm("Delete them as well", 0);
269f1ddee08Sespie}
270f1ddee08Sespie
271f1ddee08Sespiesub fix_bad_dependencies
272f1ddee08Sespie{
273f1ddee08Sespie	my $state = shift;
274f1ddee08Sespie
275f1ddee08Sespie	if ($state->defines("baddepend")) {
276f1ddee08Sespie		return 1;
277f1ddee08Sespie	}
27877dbc129Ssthen	return $state->confirm("Delete anyway", 0);
279f1ddee08Sespie}
280f1ddee08Sespie
28146412527Sespiesub process_set
282681090d4Sespie{
28346412527Sespie	my ($self, $set, $state) = @_;
284681090d4Sespie
285681090d4Sespie	my $todo = {};
286681090d4Sespie	my $bad = {};
287681090d4Sespie    	for my $pkgname ($set->older_names) {
288681090d4Sespie		unless (is_installed($pkgname)) {
289681090d4Sespie			$state->errsay("#1 was not installed", $pkgname);
290681090d4Sespie			$set->{finished} = 1;
291681090d4Sespie			$set->cleanup(OpenBSD::Handle::NOT_FOUND);
292681090d4Sespie			$state->{bad}++;
293681090d4Sespie			return ();
294681090d4Sespie		}
295681090d4Sespie		my $r = OpenBSD::RequiredBy->new($pkgname);
296681090d4Sespie		for my $pkg ($r->list) {
297681090d4Sespie			next if $set->{older}->{$pkg};
298681090d4Sespie			my $f = $state->tracker->find($pkg);
299681090d4Sespie			if (defined $f) {
300681090d4Sespie				$todo->{$pkg} = $f;
301681090d4Sespie			} else {
302681090d4Sespie				$bad->{$pkg} = 1;
303681090d4Sespie			}
304681090d4Sespie		}
305681090d4Sespie	}
306681090d4Sespie	if (keys %$bad > 0) {
307f1ddee08Sespie		my $bad2 = {};
308f1ddee08Sespie		for my $pkg (keys %$bad) {
309f1ddee08Sespie			if (!is_installed($pkg)) {
310f1ddee08Sespie				$bad2->{$pkg} = 1;
311f1ddee08Sespie			}
312f1ddee08Sespie		}
313f1ddee08Sespie		if (keys %$bad2 > 0) {
314f1ddee08Sespie			$state->errsay("#1 depends on non-existant #2",
315303a35c3Sespie			    $set->print, join(' ', sort keys %$bad2));
316f1ddee08Sespie			if (fix_bad_dependencies($state)) {
317f1ddee08Sespie				for my $pkg (keys %$bad2) {
318f1ddee08Sespie					delete $bad->{$pkg};
319f1ddee08Sespie				}
320f1ddee08Sespie			}
321f1ddee08Sespie		}
322f1ddee08Sespie	}
323f1ddee08Sespie	if (keys %$bad > 0) {
324fef35309Sespie		if (!$state->{do_automatic} || $state->verbose) {
325681090d4Sespie			$state->errsay("can't delete #1 without deleting #2",
326303a35c3Sespie			    $set->print, join(' ', sort keys %$bad));
32730df58edSespie		}
328fef35309Sespie		if (!$state->{do_automatic}) {
329f1ddee08Sespie			if (delete_dependencies($state)) {
330681090d4Sespie			    	my $l = create_locations($state, keys %$bad);
331716bc83bSespie				$state->tracker->todo(@$l);
332681090d4Sespie				return (@$l, $set);
333681090d4Sespie			}
334681090d4Sespie			$state->{bad}++;
335681090d4Sespie	    	}
336681090d4Sespie		$set->cleanup(OpenBSD::Handle::CANT_DELETE);
33746412527Sespie		$state->tracker->cant($set);
338681090d4Sespie		return ();
339681090d4Sespie	}
340681090d4Sespie	# XXX this si where we should detect loops
341681090d4Sespie	if (keys %$todo > 0) {
342681090d4Sespie		if ($set->{once}) {
343681090d4Sespie			for my $set2 (values %$todo) {
344681090d4Sespie				# XXX merge all ?
345681090d4Sespie				$set->add_older($set2->older);
346681090d4Sespie				$set2->{merged} = $set;
347681090d4Sespie				$set2->{finished} = 1;
348681090d4Sespie			}
349681090d4Sespie			delete $set->{once};
350681090d4Sespie			return ($set);
351681090d4Sespie		}
352681090d4Sespie		$set->{once} = 1;
353d2f781d7Sespie		$state->build_deptree($set, values %$todo);
354681090d4Sespie		return (values %$todo, $set);
355681090d4Sespie	}
356fef35309Sespie	if ($state->{do_automatic}) {
357681090d4Sespie		for my $pkg  ($set->older) {
358681090d4Sespie			$pkg->complete_old;
359ab0cb692Sespie			if (!defined $pkg->plist) {
360ab0cb692Sespie				$state->say("Corrupt set #1, run pkg_check",
361ab0cb692Sespie				    $set->print);
362ab0cb692Sespie				$set->cleanup(OpenBSD::Handle::CANT_DELETE);
363ab0cb692Sespie				$state->tracker->cant($set);
364ab0cb692Sespie				return ();
365ab0cb692Sespie			}
366681090d4Sespie			if ($pkg->plist->has('manual-installation')) {
36730df58edSespie				$state->say("Won't delete manually installed #1",
368303a35c3Sespie				    $set->print) if $state->verbose;
369681090d4Sespie				$set->cleanup(OpenBSD::Handle::CANT_DELETE);
37046412527Sespie				$state->tracker->cant($set);
371681090d4Sespie				return ();
372681090d4Sespie			}
373681090d4Sespie		}
374681090d4Sespie	}
375681090d4Sespie	really_remove($set, $state);
37646412527Sespie	$set->cleanup;
37746412527Sespie	$state->tracker->done($set);
378681090d4Sespie	return ();
379681090d4Sespie}
380681090d4Sespie
381a409537dSespiesub main
382a409537dSespie{
383a409537dSespie	my ($self, $state) = @_;
384a409537dSespie
385bd849d19Sespie	if ($state->{exclude}) {
386bd849d19Sespie		my $names = {};
387bd849d19Sespie		for my $l (@{$state->{setlist}}) {
388bd849d19Sespie			for my $n ($l->older_names) {
389bd849d19Sespie				$names->{$n} = 1;
390bd849d19Sespie			}
391bd849d19Sespie		}
392bd849d19Sespie		$state->{setlist} = [];
393bd849d19Sespie		my $inst = $state->repo->installed;
394bd849d19Sespie		for my $l (@{$inst->locations_list}) {
395bd849d19Sespie			$self->add_location($state, $l) if !$names->{$l->name};
396bd849d19Sespie		}
397bd849d19Sespie	}
398fef35309Sespie	if ($state->{automatic}) {
399c487fac2Sespie		if (!defined $state->{setlist}) {
400fef35309Sespie			my $inst = $state->repo->installed;
401fef35309Sespie			for my $l (@{$inst->locations_list}) {
402fef35309Sespie				$self->add_location($state, $l);
403fef35309Sespie			}
4044809484aSespie		}
405fef35309Sespie		$state->{do_automatic} = 1;
406fef35309Sespie		$self->process_setlist($state);
4074809484aSespie	} else {
4084809484aSespie		$self->process_setlist($state);
409fef35309Sespie	}
410a409537dSespie}
411a409537dSespie
412a409537dSespiesub new_state
413a409537dSespie{
4147e83eca3Sespie	my ($self, $cmd) = @_;
4157e83eca3Sespie	return OpenBSD::PkgDelete::State->new($cmd);
416a409537dSespie}
417a409537dSespie
418a409537dSespie1;
419