1#!/usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: PkgDelete.pm,v 1.35 2015/10/07 17:52:38 jmc 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 strict;
20use warnings;
21
22use OpenBSD::AddDelete;
23
24
25package OpenBSD::PkgDelete::Tracker;
26
27sub new
28{
29	my $class = shift;
30	bless {}, $class;
31}
32
33sub sets_todo
34{
35	my ($self, $offset) = @_;
36	return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset,
37		scalar keys %{$self->{total}});
38}
39
40sub handle_set
41{
42	my ($self, $set) = @_;
43	$self->{total}{$set} = 1;
44	if ($set->{finished}) {
45		$self->{done}{$set} = 1;
46	}
47}
48
49sub todo
50{
51	my ($self, @list) = @_;
52	for my $set (@list) {
53		for my $pkgname ($set->older_names) {
54			$self->{todo}{$pkgname} = $set;
55		}
56		$self->handle_set($set);
57	}
58}
59
60
61sub done
62{
63	my ($self, $set) = @_;
64	$set->{finished} = 1;
65	for my $pkgname ($set->older_names) {
66		delete $self->{todo}{$pkgname};
67	}
68	$self->handle_set($set);
69}
70
71sub cant
72{
73	&done;
74}
75sub find
76{
77	my ($self, $pkgname) = @_;
78	return $self->{todo}{$pkgname};
79}
80
81
82
83package OpenBSD::PkgDelete::State;
84our @ISA = qw(OpenBSD::AddDelete::State);
85
86sub new
87{
88	my $class = shift;
89	my $self = $class->SUPER::new(@_);
90	$self->{tracker} = OpenBSD::PkgDelete::Tracker->new;
91	return $self;
92}
93
94sub tracker
95{
96	my $self = shift;
97	return $self->{tracker};
98}
99
100sub handle_options
101{
102	my $state = shift;
103	$state->SUPER::handle_options('X',
104	    '[-acimnqsvXx] [-B pkg-destdir] [-D name[=value]] [pkg-name ...]');
105
106	my $base = $state->opt('B') // $ENV{'PKG_DESTDIR'} // '';
107	if ($base ne '') {
108		$base.='/' unless $base =~ m/\/$/o;
109	}
110	$ENV{'PKG_DESTDIR'} = $base;
111
112	$state->{destdir} = $base;
113	if ($base eq '') {
114	    $state->{destdirname} = '';
115	} else {
116	    $state->{destdirname} = '${PKG_DESTDIR}';
117	}
118	$state->{exclude} = $state->opt('X');
119}
120
121sub stem2location
122{
123	my ($self, $locator, $name, $state) = @_;
124	require OpenBSD::Search;
125	my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name));
126	if (@$l > 1 && !$state->defines('allversions')) {
127		$l = OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l);
128	}
129	return $state->choose_location($name, $l);
130}
131
132sub deleteset
133{
134	my $self = shift;
135	require OpenBSD::UpdateSet;
136
137	return OpenBSD::DeleteSet->new($self);
138}
139
140sub deleteset_from_location
141{
142	my ($self, $location) = @_;
143	return $self->deleteset->add_older(OpenBSD::Handle->from_location($location));
144}
145
146package OpenBSD::DeleteSet;
147sub setup_header
148{
149	my ($set, $state, $handle) = @_;
150	my $header = $state->deptree_header($set);
151	if (defined $handle) {
152		$header .= $handle->pkgname;
153	} else {
154		$header .= $set->print;
155	}
156	if (!$state->progress->set_header($header)) {
157		return unless $state->verbose;
158		$header = "Deleting $header";
159		if (defined $state->{lastheader} &&
160		    $header eq $state->{lastheader}) {
161			return;
162		}
163		$state->{lastheader} = $header;
164		$state->print("#1", $header);
165		$state->print("(pretending) ") if $state->{not};
166		$state->print("\n");
167	}
168}
169
170package OpenBSD::PkgDelete;
171our @ISA = qw(OpenBSD::AddDelete);
172
173use OpenBSD::PackingList;
174use OpenBSD::RequiredBy;
175use OpenBSD::Delete;
176use OpenBSD::PackageInfo;
177use OpenBSD::UpdateSet;
178use OpenBSD::Handle;
179
180
181sub add_location
182{
183	my ($self, $state, $l) = @_;
184	push(@{$state->{setlist}},
185	    $state->deleteset_from_location($l));
186}
187
188sub create_locations
189{
190	my ($state, @l) = @_;
191	my $inst = $state->repo->installed;
192	my $result = [];
193	for my $name (@l) {
194		my $l = $inst->find($name, $state->{arch});
195		if (!defined $l) {
196			$state->errsay("Can't find #1 in installed packages",
197			    $name);
198			$state->{bad}++;
199		} else {
200			push(@$result, $state->deleteset_from_location($l));
201		}
202	}
203	return $result;
204}
205
206sub process_parameters
207{
208	my ($self, $state) = @_;
209
210	my $inst = $state->repo->installed;
211
212	if (@ARGV == 0) {
213		if (!($state->{automatic} || $state->{exclude})) {
214			$state->fatal("No packages to delete");
215		}
216	} else {
217		for my $pkgname (@ARGV) {
218			my $l;
219
220			if (OpenBSD::PackageName::is_stem($pkgname)) {
221				$l = $state->stem2location($inst, $pkgname,
222				    $state);
223			} else {
224				$l = $inst->find($pkgname);
225			}
226			if (!defined $l) {
227				unless ($state->{exclude}) {
228					$state->say("Problem finding #1",
229					    $pkgname);
230					$state->{bad}++;
231				}
232			} else {
233				$self->add_location($state, $l);
234			}
235		}
236	}
237}
238
239sub finish_display
240{
241}
242
243sub really_remove
244{
245	my ($set, $state) = @_;
246	if ($state->{not}) {
247		$state->status->what("Pretending to delete");
248	} else {
249		$state->status->what("Deleting");
250	}
251	$set->setup_header($state);
252	for my $pkgname ($set->older_names) {
253		$set->setup_header($state, $set->{older}{$pkgname});
254		$state->log->set_context('-'.$pkgname);
255		OpenBSD::Delete::delete_package($pkgname, $state);
256	}
257	$state->progress->next($state->ntogo);
258	$state->syslog("Removed #1", $set->print);
259}
260
261sub delete_dependencies
262{
263	my $state = shift;
264
265	if ($state->defines("dependencies")) {
266		return 1;
267	}
268	return $state->confirm("Delete them as well", 0);
269}
270
271sub fix_bad_dependencies
272{
273	my $state = shift;
274
275	if ($state->defines("baddepend")) {
276		return 1;
277	}
278	return $state->confirm("Delete anyway", 0);
279}
280
281sub process_set
282{
283	my ($self, $set, $state) = @_;
284
285	my $todo = {};
286	my $bad = {};
287    	for my $pkgname ($set->older_names) {
288		unless (is_installed($pkgname)) {
289			$state->errsay("#1 was not installed", $pkgname);
290			$set->{finished} = 1;
291			$set->cleanup(OpenBSD::Handle::NOT_FOUND);
292			$state->{bad}++;
293			return ();
294		}
295		my $r = OpenBSD::RequiredBy->new($pkgname);
296		for my $pkg ($r->list) {
297			next if $set->{older}->{$pkg};
298			my $f = $state->tracker->find($pkg);
299			if (defined $f) {
300				$todo->{$pkg} = $f;
301			} else {
302				$bad->{$pkg} = 1;
303			}
304		}
305	}
306	if (keys %$bad > 0) {
307		my $bad2 = {};
308		for my $pkg (keys %$bad) {
309			if (!is_installed($pkg)) {
310				$bad2->{$pkg} = 1;
311			}
312		}
313		if (keys %$bad2 > 0) {
314			$state->errsay("#1 depends on non-existant #2",
315			    $set->print, join(' ', sort keys %$bad2));
316			if (fix_bad_dependencies($state)) {
317				for my $pkg (keys %$bad2) {
318					delete $bad->{$pkg};
319				}
320			}
321		}
322	}
323	if (keys %$bad > 0) {
324		if (!$state->{do_automatic} || $state->verbose) {
325			$state->errsay("can't delete #1 without deleting #2",
326			    $set->print, join(' ', sort keys %$bad));
327		}
328		if (!$state->{do_automatic}) {
329			if (delete_dependencies($state)) {
330			    	my $l = create_locations($state, keys %$bad);
331				$state->tracker->todo(@$l);
332				return (@$l, $set);
333			}
334			$state->{bad}++;
335	    	}
336		$set->cleanup(OpenBSD::Handle::CANT_DELETE);
337		$state->tracker->cant($set);
338		return ();
339	}
340	# XXX this si where we should detect loops
341	if (keys %$todo > 0) {
342		if ($set->{once}) {
343			for my $set2 (values %$todo) {
344				# XXX merge all ?
345				$set->add_older($set2->older);
346				$set2->{merged} = $set;
347				$set2->{finished} = 1;
348			}
349			delete $set->{once};
350			return ($set);
351		}
352		$set->{once} = 1;
353		$state->build_deptree($set, values %$todo);
354		return (values %$todo, $set);
355	}
356	if ($state->{do_automatic}) {
357		for my $pkg  ($set->older) {
358			$pkg->complete_old;
359			if ($pkg->plist->has('manual-installation')) {
360				$state->say("Won't delete manually installed #1",
361				    $set->print) if $state->verbose;
362				$set->cleanup(OpenBSD::Handle::CANT_DELETE);
363				$state->tracker->cant($set);
364				return ();
365			}
366		}
367	}
368	really_remove($set, $state);
369	$set->cleanup;
370	$state->tracker->done($set);
371	return ();
372}
373
374sub main
375{
376	my ($self, $state) = @_;
377
378	if ($state->{exclude}) {
379		my $names = {};
380		for my $l (@{$state->{setlist}}) {
381			for my $n ($l->older_names) {
382				$names->{$n} = 1;
383			}
384		}
385		$state->{setlist} = [];
386		my $inst = $state->repo->installed;
387		for my $l (@{$inst->locations_list}) {
388			$self->add_location($state, $l) if !$names->{$l->name};
389		}
390	}
391	if ($state->{automatic}) {
392		if (!defined $state->{setlist}) {
393			my $inst = $state->repo->installed;
394			for my $l (@{$inst->locations_list}) {
395				$self->add_location($state, $l);
396			}
397		}
398		$state->{do_automatic} = 1;
399		$self->process_setlist($state);
400	} else {
401		$self->process_setlist($state);
402	}
403}
404
405sub new_state
406{
407	my ($self, $cmd) = @_;
408	return OpenBSD::PkgDelete::State->new($cmd);
409}
410
4111;
412