1# ex:ts=8 sw=4: 2# $OpenBSD: Update.pm,v 1.167 2019/12/29 10:40:16 espie Exp $ 3# 4# Copyright (c) 2004-2014 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16 17use strict; 18use warnings; 19 20package OpenBSD::Handle; 21sub update 22{ 23 my ($self, $updater, $set, $state) = @_; 24 25 return $updater->process_handle($set, $self, $state); 26} 27 28package OpenBSD::hint; 29sub update 30{ 31 my ($self, $updater, $set, $state) = @_; 32 33 return $updater->process_hint($set, $self, $state); 34} 35 36package OpenBSD::hint2; 37sub update 38{ 39 my ($self, $updater, $set, $state) = @_; 40 41 return $updater->process_hint2($set, $self, $state); 42} 43 44package OpenBSD::Update; 45use OpenBSD::PackageInfo; 46use OpenBSD::PackageName; 47use OpenBSD::Error; 48use OpenBSD::UpdateSet; 49 50sub new 51{ 52 my $class = shift; 53 return bless {}, $class; 54} 55 56sub add_handle 57{ 58 my ($self, $set, $old, $n) = @_; 59 $old->{update_found} = $n; 60 $set->add_newer($n); 61} 62 63sub add_location 64{ 65 my ($self, $set, $handle, $location) = @_; 66 67 $self->add_handle($set, $handle, 68 OpenBSD::Handle->from_location($location)); 69} 70 71sub look_for_debug 72{ 73 my ($self, $set, $oldname, $newname, $state) = @_; 74 75 # hurdles to pass before adding debug packages 76 return unless $state->{debug_packages}; 77 78 return if $state->tracker->is_to_update("debug-".$oldname); 79 my $dbg = "debug-".$newname; 80 my $l = $set->match_locations(OpenBSD::Search::Exact->new($dbg)); 81 # TODO if @$l == 0, I should look for other packages with similar names 82 # just so I can warn for out-of-date/shearing in the mirrors. 83 return if @$l != 1; 84 $set->add_newer(OpenBSD::Handle->from_location($l->[0])); 85} 86 87sub found_update 88{ 89 my ($self, $set, $old, $location, $state) = @_; 90 91 $self->add_location($set, $old, $location); 92 $self->look_for_debug($set, $old->pkgname, $location->name, $state); 93} 94 95sub progress_message 96{ 97 my ($self, $state, @r) = @_; 98 my $msg = $state->f(@r); 99 $msg .= $state->ntogo_string; 100 $state->progress->message($msg); 101 $state->say($msg) if $state->verbose >= 2; 102} 103 104sub process_handle 105{ 106 my ($self, $set, $h, $state) = @_; 107 my $pkgname = $h->pkgname; 108 109 if ($pkgname =~ m/^\.libs\d*\-/o) { 110 return 0; 111 } 112 113 if (!$set->{quirks}) { 114 my $base = 0; 115 $state->run_quirks( 116 sub { 117 my $quirks = shift; 118 $base = $quirks->is_base_system($h, $state); 119 }); 120 if ($base) { 121 $h->{update_found} = OpenBSD::Handle->system; 122 $set->{updates}++; 123 return 1; 124 } 125 } 126 127 my $plist = OpenBSD::PackingList->from_installation($pkgname, 128 \&OpenBSD::PackingList::UpdateInfoOnly); 129 if (!defined $plist) { 130 $state->fatal("can't locate #1", $pkgname); 131 } 132 133 if ($plist->has('firmware') && !$state->defines('FW_UPDATE')) { 134 $set->move_kept($h); 135 return 0; 136 } 137 138# if (defined $plist->{url}) { 139# my $repo; 140# ($repo, undef) = $state->repo->path_parse($plist->{url}->name); 141# $set->add_repositories($repo); 142# } 143 my @search = (); 144 145 my $sname = $pkgname; 146 while ($sname =~ s/^partial\-//o) { 147 } 148 push(@search, OpenBSD::Search::Stem->split($sname)); 149 150 if (!$set->{quirks}) { 151 $state->run_quirks( 152 sub { 153 my $quirks = shift; 154 $quirks->tweak_search(\@search, $h, $state); 155 }); 156 } 157 my $oldfound = 0; 158 my @skipped_locs = (); 159 160 # XXX this is nasty: maybe we added an old set to update 161 # because of conflicts, in which case the pkgpath + 162 # conflict should be enough to "match". 163 for my $n ($set->newer) { 164 if (($state->{hard_replace} || 165 $n->location->update_info->match_pkgpath($plist)) && 166 $n->conflict_list->conflicts_with($sname)) { 167 $self->add_handle($set, $h, $n); 168 return 1; 169 } 170 } 171 # XXX all that code conveniently forgets about old versions, while 172 # marking them as "normal". 173 # there should be some error path when we consistenly fail to find 174 # an equal-or-newer version in our repository, so that pkg_add has 175 # consistent exit codes. 176 if (!$state->defines('downgrade')) { 177 push(@search, OpenBSD::Search::FilterLocation->more_recent_than($sname, \$oldfound)); 178 } 179 push(@search, OpenBSD::Search::FilterLocation->new( 180 sub { 181 my $l = shift; 182 if (@$l == 0) { 183 return $l; 184 } 185 my @l2 = (); 186 for my $loc (@$l) { 187 if (!$loc) { 188 next; 189 } 190 my $p2 = $loc->update_info; 191 if (!$p2) { 192 next; 193 } 194 if ($p2->has('arch')) { 195 unless ($p2->{arch}->check($state->{arch})) { 196 $loc->forget; 197 next; 198 } 199 } 200 if (!$plist->match_pkgpath($p2)) { 201 push(@skipped_locs, $loc); 202 next 203 } 204 my $r = $plist->signature->compare($p2->signature, $state); 205 if (defined $r && $r > 0 && !$state->defines('downgrade')) { 206 $oldfound = 1; 207 $loc->forget; 208 next; 209 } 210 push(@l2, $loc); 211 } 212 return \@l2; 213 })); 214 215 if (!$state->defines('allversions')) { 216 push(@search, OpenBSD::Search::FilterLocation->keep_most_recent); 217 } 218 219 my $l = $set->match_locations(@search); 220 221 for my $loc (@skipped_locs) { 222 if (@$l == 0 && $state->verbose) { 223 $self->say_skipped_packages($state, $plist, 224 $loc->update_info); 225 } 226 $loc->forget; 227 } 228 229 if (@$l == 0) { 230 if ($oldfound) { 231 $set->move_kept($h); 232 $self->progress_message($state, 233 "No need to update #1", $pkgname); 234 $self->look_for_debug($set, $pkgname, $pkgname, $state); 235 return 0; 236 } 237 return undef; 238 } 239 $state->say("Update candidates: #1 -> #2#3", $pkgname, 240 join(' ', map {$_->name} @$l), $state->ntogo_string) 241 if $state->verbose; 242 243 my $r = $state->choose_location($pkgname, $l); 244 if (defined $r) { 245 $self->found_update($set, $h, $r, $state); 246 return 1; 247 } else { 248 $state->{issues} = 1; 249 return undef; 250 } 251} 252 253sub say_skipped_packages 254{ 255 my ($self, $state, $o, $n) = @_; 256 257 my $o_name = $o->pkgname; 258 my @o_ps = map { @{$o->pkgpath->{$_}} } keys %{$o->pkgpath}; 259 my $o_pp = join(" ", map {$_->fullpkgpath} @o_ps); 260 261 my $n_name = $n->pkgname; 262 my @n_ps = map { @{$n->pkgpath->{$_}} } keys %{$n->pkgpath}; 263 my $n_pp= join(" ", map {$_->fullpkgpath} @n_ps); 264 265 my $t = "Skipping #1 (update candidate for #2)"; 266 $t .= "\n\t#2 pkgpaths: #4\n\t#1 pkgpaths: #3"; 267 268 $state->say($t, $n_name, $o_name, $n_pp, $o_pp); 269} 270 271sub find_nearest 272{ 273 my ($base, $locs) = @_; 274 275 my $pkgname = OpenBSD::PackageName->from_string($base); 276 return undef if !defined $pkgname->{version}; 277 my @sorted = sort {$a->pkgname->{version}->compare($b->pkgname->{version}) } @$locs; 278 if ($sorted[0]->pkgname->{version}->compare($pkgname->{version}) > 0) { 279 return $sorted[0]; 280 } 281 if ($sorted[-1]->pkgname->{version}->compare($pkgname->{version}) < 0) { 282 return $sorted[-1]; 283 } 284 return undef; 285} 286 287sub process_hint 288{ 289 my ($self, $set, $hint, $state) = @_; 290 291 my $l; 292 my $hint_name = $hint->pkgname; 293 my $k = OpenBSD::Search::FilterLocation->keep_most_recent; 294 # first try to find us exactly 295 296 $self->progress_message($state, "Looking for #1", $hint_name); 297 $l = $set->match_locations(OpenBSD::Search::Exact->new($hint_name), $k); 298 if (@$l == 0) { 299 my $t = $hint_name; 300 $t =~ s/\-\d([^-]*)\-?/--/; 301 my @search = (OpenBSD::Search::Stem->new($t)); 302 $state->run_quirks( 303 sub { 304 my $quirks = shift; 305 $quirks->tweak_search(\@search, $hint, $state); 306 }); 307 $l = $set->match_locations(@search, $k); 308 } 309 if (@$l > 1) { 310 my $r = find_nearest($hint_name, $l); 311 if (defined $r) { 312 $self->found_update($set, $hint, $r, $state); 313 return 1; 314 } 315 } 316 my $r = $state->choose_location($hint_name, $l); 317 if (defined $r) { 318 $self->found_update($set, $hint, $r, $state); 319 OpenBSD::Add::tag_user_packages($set); 320 return 1; 321 } else { 322 return 0; 323 } 324} 325 326my $cache = {}; 327 328sub process_hint2 329{ 330 my ($self, $set, $hint, $state) = @_; 331 my $pkgname = $hint->pkgname; 332 my $pkg2; 333 if ($pkgname =~ m/[\/\:]/o) { 334 my $repo; 335 ($repo, $pkg2) = $state->repo->path_parse($pkgname); 336 $set->add_repositories($repo); 337 } else { 338 $pkg2 = $pkgname; 339 } 340 if (OpenBSD::PackageName::is_stem($pkg2)) { 341 my $l = $state->updater->stem2location($set, $pkg2, $state, 342 $set->{quirks}); 343 if (defined $l) { 344 $self->add_location($set, $hint, $l); 345 $self->look_for_debug($set, $l->name, $l->name, $state); 346 } else { 347 return undef; 348 } 349 } else { 350 if (!defined $cache->{$pkgname}) { 351 $self->add_handle($set, $hint, OpenBSD::Handle->create_new($pkgname)); 352 $cache->{$pkgname} = 1; 353 $pkg2 =~ s/\.tgz$//; 354 $self->look_for_debug($set, $pkg2, $pkg2, $state); 355 } 356 } 357 OpenBSD::Add::tag_user_packages($set); 358 return 1; 359} 360 361sub process_set 362{ 363 my ($self, $set, $state) = @_; 364 my @problems = (); 365 for my $h ($set->older, $set->hints) { 366 next if $h->{update_found}; 367 if (!defined $h->update($self, $set, $state)) { 368 push(@problems, $h->pkgname); 369 } 370 } 371 if (@problems > 0) { 372 $state->tracker->cant($set) if !$set->{quirks}; 373 if ($set->{updates} != 0) { 374 $state->say("Can't update #1: no update found for #2", 375 $set->print, join(',', @problems)); 376 } 377 return 0; 378 } elsif ($set->{updates} == 0) { 379 $state->tracker->uptodate($set); 380 return 0; 381 } 382 $state->tracker->add_set($set); 383 return 1; 384} 385 386sub stem2location 387{ 388 my ($self, $locator, $name, $state, $is_quirks) = @_; 389 my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name)); 390 if (@$l > 1 && !$state->defines('allversions')) { 391 $l = OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l); 392 } 393 return $state->choose_location($name, $l, $is_quirks); 394} 395 3961; 397