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