1#!/usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: PkgDelete.pm,v 1.51 2023/10/09 07:12:22 espie Exp $
4#
5# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org>
6#
7# Permission to use, copy, modify, and distribute this software for any
8# purpose with or without fee is hereby granted, provided that the above
9# copyright notice and this permission notice appear in all copies.
10#
11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18
19use v5.36;
20
21use OpenBSD::AddDelete;
22
23
24package OpenBSD::PkgDelete::Tracker;
25
26sub new($class)
27{
28	bless {}, $class;
29}
30
31sub sets_todo($self, $offset = 0)
32{
33	return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset,
34		scalar keys %{$self->{total}});
35}
36
37sub handle_set($self, $set)
38{
39	$self->{total}{$set} = 1;
40	if ($set->{finished}) {
41		$self->{done}{$set} = 1;
42	}
43}
44
45sub todo($self, @list)
46{
47	for my $set (@list) {
48		for my $pkgname ($set->older_names) {
49			$self->{todo}{$pkgname} = $set;
50		}
51		$self->handle_set($set);
52	}
53}
54
55
56sub done($self, $set)
57{
58	$set->{finished} = 1;
59	for my $pkgname ($set->older_names) {
60		delete $self->{todo}{$pkgname};
61	}
62	$self->handle_set($set);
63}
64
65sub cant	# forwarder
66{
67	&done;
68}
69
70sub find($self, $pkgname)
71{
72	return $self->{todo}{$pkgname};
73}
74
75
76
77package OpenBSD::PkgDelete::State;
78our @ISA = qw(OpenBSD::AddDelete::State);
79
80sub new($class, @p)
81{
82	my $self = $class->SUPER::new(@p);
83	$self->{tracker} = OpenBSD::PkgDelete::Tracker->new;
84	return $self;
85}
86
87sub tracker($self)
88{
89	return $self->{tracker};
90}
91
92sub handle_options($state)
93{
94	$state->SUPER::handle_options('X',
95	    '[-acimnqsVvXx] [-B pkg-destdir] [-D name[=value]] [pkg-name ...]');
96
97	$state->{exclude} = $state->opt('X');
98}
99
100sub stem2location($self, $locator, $name, $state)
101{
102	require OpenBSD::Search;
103	my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name));
104	if (@$l > 1 && !$state->defines('allversions')) {
105		$l = OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l);
106	}
107	return $state->choose_location($name, $l);
108}
109
110sub deleteset($self)
111{
112	require OpenBSD::UpdateSet;
113
114	return OpenBSD::DeleteSet->new($self);
115}
116
117sub deleteset_from_location($self, $location)
118{
119	return $self->deleteset->add_older(OpenBSD::Handle->from_location($location));
120}
121
122sub solve_dependency($self, $solver, $dep, $package)
123{
124	# simpler dependency solving
125	return $solver->find_dep_in_installed($self, $dep);
126}
127
128package OpenBSD::DeleteSet;
129sub setup_header($set, $state, $handle = undef)
130{
131	my $header = $state->deptree_header($set);
132	if (defined $handle) {
133		$header .= $handle->pkgname;
134	} else {
135		$header .= $set->print;
136	}
137	if (!$state->progress->set_header($header)) {
138		return unless $state->verbose;
139		$header = "Deleting $header";
140		if (defined $state->{lastheader} &&
141		    $header eq $state->{lastheader}) {
142			return;
143		}
144		$state->{lastheader} = $header;
145		$state->print("#1", $header);
146		$state->print("(pretending) ") if $state->{not};
147		$state->print("\n");
148	}
149}
150
151package OpenBSD::PkgDelete;
152our @ISA = qw(OpenBSD::AddDelete);
153
154use OpenBSD::PackingList;
155use OpenBSD::RequiredBy;
156use OpenBSD::Delete;
157use OpenBSD::PackageInfo;
158use OpenBSD::UpdateSet;
159use OpenBSD::Handle;
160
161
162sub add_location($self, $state, $l)
163{
164	push(@{$state->{setlist}},
165	    $state->deleteset_from_location($l));
166}
167
168sub create_locations($state, @l)
169{
170	my $inst = $state->repo->installed;
171	my $result = [];
172	for my $name (@l) {
173		my $l = $inst->find($name);
174		if (!defined $l) {
175			$state->errsay("Can't find #1 in installed packages",
176			    $name);
177			$state->{bad}++;
178		} else {
179			push(@$result, $state->deleteset_from_location($l));
180		}
181	}
182	return $result;
183}
184
185sub process_parameters($self, $state)
186{
187	my $inst = $state->repo->installed;
188
189	if (@ARGV == 0) {
190		if (!($state->{automatic} || $state->{exclude})) {
191			$state->usage("No packages to delete");
192		}
193	} else {
194		for my $pkgname (@ARGV) {
195			my $l;
196
197			if (OpenBSD::PackageName::is_stem($pkgname)) {
198				$l = $state->stem2location($inst, $pkgname,
199				    $state);
200			} else {
201				$l = $inst->find($pkgname);
202			}
203			if (!defined $l) {
204				unless ($state->{exclude}) {
205					$state->say("Problem finding #1",
206					    $pkgname);
207					$state->{bad}++;
208				}
209			} else {
210				$self->add_location($state, $l);
211			}
212		}
213	}
214}
215
216sub finish_display($, $)
217{
218}
219
220sub really_remove($set, $state)
221{
222	if ($state->{not}) {
223		$state->status->what("Pretending to delete");
224	} else {
225		$state->status->what("Deleting");
226	}
227	$set->setup_header($state);
228	for my $pkg ($set->older) {
229		$set->setup_header($state, $pkg);
230		$state->log->set_context('-'.$pkg->pkgname);
231		OpenBSD::Delete::delete_handle($pkg, $state);
232	}
233	$state->progress->next($state->ntogo);
234	$state->syslog("Removed #1", $set->print);
235}
236
237sub delete_dependencies($state)
238{
239	if ($state->defines("dependencies")) {
240		return 1;
241	}
242	return $state->confirm_defaults_to_no("Delete them as well");
243}
244
245sub fix_bad_dependencies($state)
246{
247	if ($state->defines("baddepend")) {
248		return 1;
249	}
250	return $state->confirm_defaults_to_no("Delete anyway");
251}
252
253sub process_set($self, $set, $state)
254{
255	my $todo = {};
256	my $bad = {};
257    	for my $pkgname ($set->older_names) {
258		unless (is_installed($pkgname)) {
259			$state->errsay("#1 was not installed", $pkgname);
260			$set->{finished} = 1;
261			$set->cleanup(OpenBSD::Handle::NOT_FOUND);
262			$state->{bad}++;
263			return ();
264		}
265		my $r = OpenBSD::RequiredBy->new($pkgname);
266		for my $pkg ($r->list) {
267			next if $set->{older}{$pkg};
268			my $f = $state->tracker->find($pkg);
269			if (defined $f) {
270				$todo->{$pkg} = $f;
271			} else {
272				$bad->{$pkg} = 1;
273			}
274		}
275	}
276	if (keys %$bad > 0) {
277		my $bad2 = {};
278		for my $pkg (keys %$bad) {
279			if (!is_installed($pkg)) {
280				$bad2->{$pkg} = 1;
281			}
282		}
283		if (keys %$bad2 > 0) {
284			$state->errsay("#1 depends on non-existent #2",
285			    $set->print, join(' ', sort keys %$bad2));
286			if (fix_bad_dependencies($state)) {
287				for my $pkg (keys %$bad2) {
288					delete $bad->{$pkg};
289				}
290			}
291		}
292	}
293	# that's where I should check for alternates in bad
294	if (keys %$bad > 0) {
295		if (!$state->{do_automatic} || $state->verbose) {
296			$state->errsay("can't delete #1 without deleting #2",
297			    $set->print, join(' ', sort keys %$bad));
298		}
299		if (!$state->{do_automatic}) {
300			if (delete_dependencies($state)) {
301			    	my $l = create_locations($state, keys %$bad);
302				$state->tracker->todo(@$l);
303				return (@$l, $set);
304			}
305			$state->{bad}++;
306	    	}
307		$set->cleanup(OpenBSD::Handle::CANT_DELETE);
308		$state->tracker->cant($set);
309		return ();
310	}
311	# XXX this si where we should detect loops
312	if (keys %$todo > 0) {
313		if ($set->{once}) {
314			for my $set2 (values %$todo) {
315				# XXX merge all ?
316				$set->add_older($set2->older);
317				$set2->{merged} = $set;
318				$set2->{finished} = 1;
319			}
320			delete $set->{once};
321			return ($set);
322		}
323		$set->{once} = 1;
324		$state->build_deptree($set, values %$todo);
325		return (values %$todo, $set);
326	}
327	for my $pkg ($set->older) {
328		$pkg->complete_old;
329		if (!defined $pkg->plist) {
330			$state->say("Corrupt set #1, run pkg_check",
331			    $set->print);
332			$set->cleanup(OpenBSD::Handle::CANT_DELETE);
333			$state->tracker->cant($set);
334			return ();
335		}
336		if ($state->{do_automatic} &&
337		    $pkg->plist->has('manual-installation')) {
338			$state->say("Won't delete manually installed #1",
339			    $set->print) if $state->verbose;
340			$set->cleanup(OpenBSD::Handle::CANT_DELETE);
341			$state->tracker->cant($set);
342			return ();
343		}
344		if (defined $pkg->plist->{tags}) {
345			if (!$set->solver->solve_tags($state)) {
346				$set->cleanup(OpenBSD::Handle::CANT_DELETE);
347				$state->tracker->cant($set);
348				return ();
349			}
350		}
351	}
352	really_remove($set, $state);
353	$set->cleanup;
354	$state->tracker->done($set);
355	return ();
356}
357
358sub main($self, $state)
359{
360	if ($state->{exclude}) {
361		my $names = {};
362		for my $l (@{$state->{setlist}}) {
363			for my $n ($l->older_names) {
364				$names->{$n} = 1;
365			}
366		}
367		$state->{setlist} = [];
368		my $inst = $state->repo->installed;
369		for my $l (@{$inst->locations_list}) {
370			$self->add_location($state, $l) if !$names->{$l->name};
371		}
372	}
373	if ($state->{automatic}) {
374		if (!defined $state->{setlist}) {
375			my $inst = $state->repo->installed;
376			for my $l (@{$inst->locations_list}) {
377				$self->add_location($state, $l);
378			}
379		}
380		$state->{do_automatic} = 1;
381		$self->process_setlist($state);
382	} else {
383		$self->process_setlist($state);
384	}
385}
386
387sub new_state($self, $cmd)
388{
389	return OpenBSD::PkgDelete::State->new($cmd);
390}
391
3921;
393