1a409537dSespie#!/usr/bin/perl 2a409537dSespie# ex:ts=8 sw=4: 3*f1ddee08Sespie# $OpenBSD: PkgDelete.pm,v 1.13 2011/07/12 10:51:28 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 24681090d4Sespiepackage OpenBSD::PkgDelete::Tracker; 25681090d4Sespie 26681090d4Sespiesub new 27681090d4Sespie{ 28681090d4Sespie my $class = shift; 29681090d4Sespie bless {}, $class; 30681090d4Sespie} 31681090d4Sespie 32681090d4Sespiesub sets_todo 33681090d4Sespie{ 34681090d4Sespie my ($self, $offset) = @_; 35681090d4Sespie return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset, 36681090d4Sespie scalar keys %{$self->{total}}); 37681090d4Sespie} 38681090d4Sespie 39681090d4Sespiesub handle_set 40681090d4Sespie{ 41681090d4Sespie my ($self, $set) = @_; 42681090d4Sespie $self->{total}{$set} = 1; 43681090d4Sespie if ($set->{finished}) { 44681090d4Sespie $self->{done}{$set} = 1; 45681090d4Sespie } 46681090d4Sespie} 47681090d4Sespie 48681090d4Sespiesub todo 49681090d4Sespie{ 50681090d4Sespie my ($self, $list) = @_; 51681090d4Sespie for my $set (@$list) { 52681090d4Sespie for my $pkgname ($set->older_names) { 53681090d4Sespie $self->{todo}{$pkgname} = $set; 54681090d4Sespie } 55681090d4Sespie $self->handle_set($set); 56681090d4Sespie } 57681090d4Sespie} 58681090d4Sespie 59681090d4Sespie 60681090d4Sespiesub done 61681090d4Sespie{ 62681090d4Sespie my ($self, $set) = @_; 63681090d4Sespie $set->{finished} = 1; 64681090d4Sespie for my $pkgname ($set->older_names) { 65681090d4Sespie delete $self->{todo}{$pkgname}; 66681090d4Sespie } 67681090d4Sespie $self->handle_set($set); 68681090d4Sespie} 69681090d4Sespie 70681090d4Sespiesub find 71681090d4Sespie{ 72681090d4Sespie my ($self, $pkgname) = @_; 73681090d4Sespie return $self->{todo}{$pkgname}; 74681090d4Sespie} 75681090d4Sespie 76681090d4Sespie 77681090d4Sespie 78a409537dSespiepackage OpenBSD::PkgDelete::State; 79a409537dSespieour @ISA = qw(OpenBSD::AddDelete::State); 80a409537dSespie 81681090d4Sespiesub new 82681090d4Sespie{ 83681090d4Sespie my $class = shift; 84681090d4Sespie my $self = $class->SUPER::new(@_); 85681090d4Sespie $self->{tracker} = OpenBSD::PkgDelete::Tracker->new; 86681090d4Sespie return $self; 87681090d4Sespie} 88681090d4Sespie 89681090d4Sespiesub tracker 90681090d4Sespie{ 91681090d4Sespie my $self = shift; 92681090d4Sespie return $self->{tracker}; 93681090d4Sespie} 94681090d4Sespie 958a660df1Sespiesub handle_options 968a660df1Sespie{ 978a660df1Sespie my $state = shift; 988a660df1Sespie $state->SUPER::handle_options('', 99681090d4Sespie '[-acIinqsvx] [-B pkg-destdir] [-D name[=value]] pkg-name [...]'); 1008a660df1Sespie 1018a660df1Sespie my $base = $state->opt('B') // $ENV{'PKG_DESTDIR'} // ''; 1028a660df1Sespie if ($base ne '') { 1038a660df1Sespie $base.='/' unless $base =~ m/\/$/o; 1048a660df1Sespie } 1058a660df1Sespie $ENV{'PKG_DESTDIR'} = $base; 1068a660df1Sespie 1078a660df1Sespie $state->{destdir} = $base; 1088a660df1Sespie if ($base eq '') { 1098a660df1Sespie $state->{destdirname} = ''; 1108a660df1Sespie } else { 1118a660df1Sespie $state->{destdirname} = '${PKG_DESTDIR}'; 1128a660df1Sespie } 1138a660df1Sespie} 1148a660df1Sespie 115a409537dSespiesub todo 116a409537dSespie{ 11700f714c9Sespie my ($state, $offset) = @_; 118681090d4Sespie return $state->tracker->sets_todo($offset); 119681090d4Sespie} 120681090d4Sespie 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 132a409537dSespiepackage OpenBSD::PkgDelete; 133a409537dSespieour @ISA = qw(OpenBSD::AddDelete); 134a409537dSespie 135a409537dSespieuse OpenBSD::PackingList; 136a409537dSespieuse OpenBSD::RequiredBy; 137a409537dSespieuse OpenBSD::Delete; 138a409537dSespieuse OpenBSD::PackageInfo; 139a409537dSespieuse OpenBSD::UpdateSet; 140681090d4Sespieuse OpenBSD::Handle; 141a409537dSespie 142a409537dSespie 143681090d4Sespiesub add_location 144681090d4Sespie{ 145681090d4Sespie my ($self, $state, $l) = @_; 146681090d4Sespie push(@{$state->{setlist}}, 147681090d4Sespie $state->updateset->add_older(OpenBSD::Handle->from_location($l))); 148681090d4Sespie} 149681090d4Sespie 150681090d4Sespiesub create_locations 151681090d4Sespie{ 152681090d4Sespie my ($state, @l) = @_; 153681090d4Sespie my $inst = $state->repo->installed; 154681090d4Sespie my $result = []; 155681090d4Sespie for my $name (@l) { 156681090d4Sespie my $l = $inst->find($name, $state->{arch}); 157681090d4Sespie if (!defined $l) { 158681090d4Sespie $state->errsay("Can't find #1 in installed packages", 159681090d4Sespie $name); 160681090d4Sespie $state->{bad}++; 161681090d4Sespie } else { 162681090d4Sespie push(@$result, $state->updateset->add_older(OpenBSD::Handle->from_location($l))); 163681090d4Sespie } 164681090d4Sespie } 165681090d4Sespie return $result; 166681090d4Sespie} 167681090d4Sespie 168a409537dSespiesub process_parameters 169a409537dSespie{ 170a409537dSespie my ($self, $state) = @_; 1717096cf21Sespie 172681090d4Sespie my $inst = $state->repo->installed; 1737096cf21Sespie 174681090d4Sespie if (@ARGV == 0 && $state->{automatic}) { 175681090d4Sespie for my $l (@{$inst->locations_list}) { 176681090d4Sespie $self->add_location($state, $l); 177a409537dSespie } 178a409537dSespie } else { 179681090d4Sespie for my $pkgname (@ARGV) { 180681090d4Sespie my $l; 181681090d4Sespie 182681090d4Sespie if (OpenBSD::PackageName::is_stem($pkgname)) { 183681090d4Sespie $l = $state->stem2location($inst, $pkgname, $state); 184681090d4Sespie } else { 185681090d4Sespie $l = $inst->find($pkgname, $state->{arch}); 186681090d4Sespie } 187681090d4Sespie if (!defined $l) { 188681090d4Sespie $state->say("Problem finding #1", $pkgname); 189a409537dSespie $state->{bad}++; 190681090d4Sespie } else { 191681090d4Sespie $self->add_location($state, $l); 192a409537dSespie } 193a409537dSespie } 194681090d4Sespie } 195a409537dSespie} 196a409537dSespie 197a409537dSespiesub finish_display 198a409537dSespie{ 199a409537dSespie} 200a409537dSespie 201681090d4Sespiesub really_remove 202681090d4Sespie{ 203681090d4Sespie my ($set, $state) = @_; 204681090d4Sespie if ($state->{not}) { 205681090d4Sespie $state->status->what("Pretending to delete"); 206681090d4Sespie } else { 207681090d4Sespie $state->status->what("Deleting"); 208681090d4Sespie } 209681090d4Sespie if (!$state->progress->set_header($set->delete_print)) { 210681090d4Sespie $state->say($state->{not} ? 211681090d4Sespie "Pretending to delete #1" : 212681090d4Sespie "Deleting #1", 213681090d4Sespie $set->delete_print) if $state->verbose; 214681090d4Sespie } 215681090d4Sespie for my $pkgname ($set->older_names) { 216681090d4Sespie $state->log->set_context('-'.$pkgname); 217681090d4Sespie OpenBSD::Delete::delete_package($pkgname, $state); 218681090d4Sespie } 219681090d4Sespie $set->cleanup; 220681090d4Sespie $state->tracker->done($set); 221681090d4Sespie $state->progress->next($state->ntogo); 222681090d4Sespie} 223681090d4Sespie 224*f1ddee08Sespiesub delete_dependencies 225*f1ddee08Sespie{ 226*f1ddee08Sespie my $state = shift; 227*f1ddee08Sespie 228*f1ddee08Sespie if ($state->defines("dependencies")) { 229*f1ddee08Sespie return 1; 230*f1ddee08Sespie } 231*f1ddee08Sespie if ($state->{interactive}) { 232*f1ddee08Sespie return $state->confirm("Delete them as well", 0); 233*f1ddee08Sespie } 234*f1ddee08Sespie return 0; 235*f1ddee08Sespie} 236*f1ddee08Sespie 237*f1ddee08Sespiesub fix_bad_dependencies 238*f1ddee08Sespie{ 239*f1ddee08Sespie my $state = shift; 240*f1ddee08Sespie 241*f1ddee08Sespie if ($state->defines("baddepend")) { 242*f1ddee08Sespie return 1; 243*f1ddee08Sespie } 244*f1ddee08Sespie if ($state->{interactive}) { 245*f1ddee08Sespie return $state->confirm("Delete anyways", 0); 246*f1ddee08Sespie } 247*f1ddee08Sespie return 0; 248*f1ddee08Sespie} 249*f1ddee08Sespie 250681090d4Sespiesub remove_set 251681090d4Sespie{ 252681090d4Sespie my ($set, $state) = @_; 253681090d4Sespie 254681090d4Sespie my $todo = {}; 255681090d4Sespie my $bad = {}; 256681090d4Sespie $set = $set->real_set; 257681090d4Sespie if ($set->{finished}) { 258681090d4Sespie return (); 259681090d4Sespie } 260681090d4Sespie for my $pkgname ($set->older_names) { 261681090d4Sespie unless (is_installed($pkgname)) { 262681090d4Sespie $state->errsay("#1 was not installed", $pkgname); 263681090d4Sespie $set->{finished} = 1; 264681090d4Sespie $set->cleanup(OpenBSD::Handle::NOT_FOUND); 265681090d4Sespie $state->{bad}++; 266681090d4Sespie return (); 267681090d4Sespie } 268681090d4Sespie my $r = OpenBSD::RequiredBy->new($pkgname); 269681090d4Sespie for my $pkg ($r->list) { 270681090d4Sespie next if $set->{older}->{$pkg}; 271681090d4Sespie my $f = $state->tracker->find($pkg); 272681090d4Sespie if (defined $f) { 273681090d4Sespie $todo->{$pkg} = $f; 274681090d4Sespie } else { 275681090d4Sespie $bad->{$pkg} = 1; 276681090d4Sespie } 277681090d4Sespie } 278681090d4Sespie } 279681090d4Sespie if (keys %$bad > 0) { 280*f1ddee08Sespie my $bad2 = {}; 281*f1ddee08Sespie for my $pkg (keys %$bad) { 282*f1ddee08Sespie if (!is_installed($pkg)) { 283*f1ddee08Sespie $bad2->{$pkg} = 1; 284*f1ddee08Sespie } 285*f1ddee08Sespie } 286*f1ddee08Sespie if (keys %$bad2 > 0) { 287*f1ddee08Sespie $state->errsay("#1 depends on non-existant #2", 288*f1ddee08Sespie $set->delete_print, join(' ', sort keys %$bad2)); 289*f1ddee08Sespie if (fix_bad_dependencies($state)) { 290*f1ddee08Sespie for my $pkg (keys %$bad2) { 291*f1ddee08Sespie delete $bad->{$pkg}; 292*f1ddee08Sespie } 293*f1ddee08Sespie } 294*f1ddee08Sespie } 295*f1ddee08Sespie } 296*f1ddee08Sespie if (keys %$bad > 0) { 297681090d4Sespie if (!$state->{automatic}) { 298681090d4Sespie $state->errsay("can't delete #1 without deleting #2", 299*f1ddee08Sespie $set->delete_print, join(' ', sort keys %$bad)); 300*f1ddee08Sespie if (delete_dependencies($state)) { 301681090d4Sespie my $l = create_locations($state, keys %$bad); 302681090d4Sespie $state->tracker->todo($l); 303681090d4Sespie return (@$l, $set); 304681090d4Sespie } 305681090d4Sespie $state->{bad}++; 306681090d4Sespie } 307681090d4Sespie $set->cleanup(OpenBSD::Handle::CANT_DELETE); 308681090d4Sespie $state->tracker->done($set); 309681090d4Sespie return (); 310681090d4Sespie } 311681090d4Sespie # XXX this si where we should detect loops 312681090d4Sespie if (keys %$todo > 0) { 313681090d4Sespie if ($set->{once}) { 314681090d4Sespie for my $set2 (values %$todo) { 315681090d4Sespie # XXX merge all ? 316681090d4Sespie $set->add_older($set2->older); 317681090d4Sespie $set2->{merged} = $set; 318681090d4Sespie $set2->{finished} = 1; 319681090d4Sespie } 320681090d4Sespie delete $set->{once}; 321681090d4Sespie return ($set); 322681090d4Sespie } 323681090d4Sespie $set->{once} = 1; 324681090d4Sespie return (values %$todo, $set); 325681090d4Sespie } 326681090d4Sespie if ($state->{automatic}) { 327681090d4Sespie for my $pkg ($set->older) { 328681090d4Sespie $pkg->complete_old; 329681090d4Sespie if ($pkg->plist->has('manual-installation')) { 330681090d4Sespie $set->cleanup(OpenBSD::Handle::CANT_DELETE); 331681090d4Sespie $state->tracker->done($set); 332681090d4Sespie return (); 333681090d4Sespie } 334681090d4Sespie } 335681090d4Sespie } 336681090d4Sespie really_remove($set, $state); 337681090d4Sespie return (); 338681090d4Sespie} 339681090d4Sespie 340a409537dSespiesub main 341a409537dSespie{ 342a409537dSespie my ($self, $state) = @_; 343a409537dSespie 3447096cf21Sespie my %done; 3457096cf21Sespie my $removed; 3467096cf21Sespie 347681090d4Sespie $state->tracker->todo($state->{setlist}); 348a409537dSespie # and finally, handle the removal 349681090d4Sespie while (my $set = shift @{$state->{setlist}}) { 350681090d4Sespie $state->status->what->set($set); 351681090d4Sespie unshift(@{$state->{setlist}}, remove_set($set, $state)); 352a409537dSespie } 353a409537dSespie} 354a409537dSespie 355a409537dSespiesub new_state 356a409537dSespie{ 3577e83eca3Sespie my ($self, $cmd) = @_; 3587e83eca3Sespie return OpenBSD::PkgDelete::State->new($cmd); 359a409537dSespie} 360a409537dSespie 361a409537dSespie1; 362