From 039cbdaaca23c9e872a2bab23f91224c76c0f23b Mon Sep 17 00:00:00 2001 From: espie Date: Tue, 13 Jun 2023 09:07:16 +0000 Subject: [PATCH] move to use v5.36; tested by me over the last few weeks, and tb@ also fixed a "manual install" bug properly reported by tb@ aside that there should be *no functional change*. If you see any message like "hey, the number of params is wrong" it is a fringe case I didn't run into and should be easy to fix. --- usr.sbin/pkg_add/OpenBSD/Add.pm | 208 ++--- usr.sbin/pkg_add/OpenBSD/AddCreateDelete.pm | 123 +-- usr.sbin/pkg_add/OpenBSD/AddDelete.pm | 160 ++-- usr.sbin/pkg_add/OpenBSD/ArcCheck.pm | 38 +- usr.sbin/pkg_add/OpenBSD/BaseState.pm | 154 ++-- usr.sbin/pkg_add/OpenBSD/CollisionReport.pm | 17 +- usr.sbin/pkg_add/OpenBSD/Delete.pm | 170 ++-- usr.sbin/pkg_add/OpenBSD/Dependencies.pm | 83 +- .../OpenBSD/Dependencies/SolverBase.pm | 119 +-- usr.sbin/pkg_add/OpenBSD/Error.pm | 81 +- .../pkg_add/OpenBSD/ForwardDependencies.pm | 28 +- usr.sbin/pkg_add/OpenBSD/FwUpdate.pm | 80 +- usr.sbin/pkg_add/OpenBSD/Getopt.pm | 13 +- usr.sbin/pkg_add/OpenBSD/Handle.pm | 78 +- usr.sbin/pkg_add/OpenBSD/IdCache.pm | 31 +- usr.sbin/pkg_add/OpenBSD/InstalledInfo.pm | 63 +- usr.sbin/pkg_add/OpenBSD/Interactive.pm | 18 +- usr.sbin/pkg_add/OpenBSD/LibSpec.pm | 110 +-- usr.sbin/pkg_add/OpenBSD/LibSpec/Build.pm | 43 +- usr.sbin/pkg_add/OpenBSD/Log.pm | 67 +- usr.sbin/pkg_add/OpenBSD/Mtree.pm | 11 +- usr.sbin/pkg_add/OpenBSD/OldLibs.pm | 68 +- usr.sbin/pkg_add/OpenBSD/PackageInfo.pm | 52 +- usr.sbin/pkg_add/OpenBSD/PackageLocation.pm | 107 +-- usr.sbin/pkg_add/OpenBSD/PackageLocator.pm | 33 +- usr.sbin/pkg_add/OpenBSD/PackageName.pm | 113 +-- usr.sbin/pkg_add/OpenBSD/PackageRepository.pm | 237 ++--- .../OpenBSD/PackageRepository/Cache.pm | 26 +- .../pkg_add/OpenBSD/PackageRepository/HTTP.pm | 63 +- .../OpenBSD/PackageRepository/Installed.pm | 104 +-- .../OpenBSD/PackageRepository/Persistent.pm | 29 +- .../pkg_add/OpenBSD/PackageRepository/SCP.pm | 29 +- .../pkg_add/OpenBSD/PackageRepositoryList.pm | 35 +- usr.sbin/pkg_add/OpenBSD/PackingElement.pm | 831 +++++++----------- usr.sbin/pkg_add/OpenBSD/PackingList.pm | 159 ++-- usr.sbin/pkg_add/OpenBSD/Paths.pm | 122 ++- usr.sbin/pkg_add/OpenBSD/PkgAdd.pm | 257 ++---- usr.sbin/pkg_add/OpenBSD/PkgCfl.pm | 27 +- usr.sbin/pkg_add/OpenBSD/PkgCheck.pm | 250 ++---- usr.sbin/pkg_add/OpenBSD/PkgCreate.pm | 476 ++++------ usr.sbin/pkg_add/OpenBSD/PkgDelete.pm | 86 +- usr.sbin/pkg_add/OpenBSD/PkgInfo.pm | 115 +-- usr.sbin/pkg_add/OpenBSD/PkgSign.pm | 64 +- usr.sbin/pkg_add/OpenBSD/PkgSpec.pm | 114 +-- usr.sbin/pkg_add/OpenBSD/ProgressMeter.pm | 62 +- .../pkg_add/OpenBSD/ProgressMeter/Term.pm | 81 +- usr.sbin/pkg_add/OpenBSD/Replace.pm | 24 +- usr.sbin/pkg_add/OpenBSD/RequiredBy.pm | 41 +- usr.sbin/pkg_add/OpenBSD/Search.pm | 90 +- usr.sbin/pkg_add/OpenBSD/SharedItems.pm | 35 +- usr.sbin/pkg_add/OpenBSD/SharedLibs.pm | 3 +- usr.sbin/pkg_add/OpenBSD/Signature.pm | 85 +- usr.sbin/pkg_add/OpenBSD/Signer.pm | 27 +- usr.sbin/pkg_add/OpenBSD/State.pm | 119 +-- usr.sbin/pkg_add/OpenBSD/Subst.pm | 44 +- usr.sbin/pkg_add/OpenBSD/Temp.pm | 34 +- usr.sbin/pkg_add/OpenBSD/Tracker.pm | 59 +- usr.sbin/pkg_add/OpenBSD/Update.pm | 72 +- usr.sbin/pkg_add/OpenBSD/UpdateSet.pm | 172 ++-- usr.sbin/pkg_add/OpenBSD/Ustar.pm | 233 ++--- usr.sbin/pkg_add/OpenBSD/Vstat.pm | 177 ++-- usr.sbin/pkg_add/OpenBSD/md5.pm | 39 +- 62 files changed, 2366 insertions(+), 4123 deletions(-) diff --git a/usr.sbin/pkg_add/OpenBSD/Add.pm b/usr.sbin/pkg_add/OpenBSD/Add.pm index c27a7d836db..8804c610747 100644 --- a/usr.sbin/pkg_add/OpenBSD/Add.pm +++ b/usr.sbin/pkg_add/OpenBSD/Add.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Add.pm,v 1.194 2023/05/27 09:58:26 espie Exp $ +# $OpenBSD: Add.pm,v 1.195 2023/06/13 09:07:16 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::Add; use OpenBSD::Error; @@ -25,9 +24,8 @@ use OpenBSD::ArcCheck; use OpenBSD::Paths; use File::Copy; -sub manpages_index +sub manpages_index($state) { - my ($state) = @_; return unless defined $state->{addman}; my $destdir = $state->{destdir}; @@ -44,9 +42,8 @@ sub manpages_index delete $state->{addman}; } -sub register_installation +sub register_installation($plist, $state) { - my ($plist, $state) = @_; if ($state->{not}) { $plist->to_cache; } else { @@ -58,17 +55,13 @@ sub register_installation } } -sub validate_plist +sub validate_plist($plist, $state, $set) { - my ($plist, $state, $set) = @_; - $plist->prepare_for_addition($state, $plist->pkgname, $set); } -sub record_partial_installation +sub record_partial_installation($plist, $state, $h) { - my ($plist, $state, $h) = @_; - use OpenBSD::PackingElement; my $n = $plist->make_shallow_copy($h); @@ -96,10 +89,8 @@ sub record_partial_installation return $borked; } -sub perform_installation +sub perform_installation($handle, $state) { - my ($handle, $state) = @_; - return if $state->defines('stub'); $state->{partial} = $handle->{partial}; @@ -111,9 +102,8 @@ sub perform_installation } } -sub skip_to_the_end +sub skip_to_the_end($handle, $state, $tied, $p) { - my ($handle, $state, $tied, $p) = @_; $state->tweak_header("skipping"); for my $e (values %$tied) { $e->tie($state); @@ -130,10 +120,8 @@ sub skip_to_the_end } } -sub perform_extraction +sub perform_extraction($handle, $state) { - my ($handle, $state) = @_; - return if $state->defines('stub'); $handle->{partial} = {}; @@ -195,18 +183,15 @@ sub perform_extraction my $user_tagged = {}; -sub extract_pkgname +sub extract_pkgname($pkgname) { - my $pkgname = shift; $pkgname =~ s/^.*\///; $pkgname =~ s/\.tgz$//; return $pkgname; } -sub tweak_package_status +sub tweak_package_status($pkgname, $state) { - my ($pkgname, $state) = @_; - $pkgname = extract_pkgname($pkgname); return 0 unless is_installed($pkgname); return 0 unless $user_tagged->{$pkgname}; @@ -224,10 +209,8 @@ sub tweak_package_status return 0; } -sub tweak_plist_status +sub tweak_plist_status($plist, $state) { - my ($plist, $state) = @_; - my $pkgname = $plist->pkgname; if ($state->defines('FW_UPDATE')) { $plist->has('firmware') or @@ -239,9 +222,9 @@ sub tweak_plist_status } } -sub tag_user_packages +sub tag_user_packages(@p) { - for my $set (@_) { + for my $set (@p) { for my $n ($set->newer_names) { $user_tagged->{OpenBSD::PackageName::url2pkgname($n)} = 1; } @@ -278,28 +261,26 @@ use OpenBSD::Error; my ($uidcache, $gidcache); # $self->prepare_for_addition($state, $pkgname, $set) -sub prepare_for_addition +sub prepare_for_addition($, $, $, $) { } # $self->find_extractible($state, $wanted, $tied): # sort item into wanted (needed from archive) / tied (already there) -sub find_extractible +sub find_extractible($, $, $, $) { } -sub extract +sub extract($self, $state) { - my ($self, $state) = @_; $state->{partial}{$self} = 1; if ($state->{interrupted}) { die "Interrupted"; } } -sub install +sub install($self, $state) { - my ($self, $state) = @_; # XXX "normal" items are already in partial, but NOT stuff # that's install-only, like symlinks and dirs... $state->{partial}{$self} = 1; @@ -308,14 +289,13 @@ sub install } } -sub copy_info +# $self->copy_info($dest, $state) +sub copy_info($, $, $) { } -sub set_modes +sub set_modes($self, $state, $name) { - my ($self, $state, $name) = @_; - if (defined $self->{owner} || defined $self->{group}) { require OpenBSD::IdCache; @@ -350,14 +330,13 @@ package OpenBSD::PackingElement::Meta; # XXX stuff that's invisible to find_extractible should be considered extracted # for the most part, otherwise we create broken partial packages -sub find_extractible +sub find_extractible($self, $state, $wanted, $tied) { - my ($self, $state, $wanted, $tied) = @_; $state->{partial}{$self} = 1; } package OpenBSD::PackingElement::Cwd; -sub find_extractible +sub find_extractible # forwarder { &OpenBSD::PackingElement::Meta::find_extractible; } @@ -365,10 +344,8 @@ sub find_extractible package OpenBSD::PackingElement::ExtraInfo; use OpenBSD::Error; -sub prepare_for_addition +sub prepare_for_addition($self, $state, $pkgname, $) { - my ($self, $state, $pkgname) = @_; - if ($state->{ftp_only} && $self->{ftp} ne 'yes') { $state->errsay("Package #1 is not for ftp", $pkgname); $state->{problems}++; @@ -378,13 +355,11 @@ sub prepare_for_addition package OpenBSD::PackingElement::NewAuth; use OpenBSD::Error; -sub add_entry +sub add_entry($, $l, @p) { - shift; # get rid of self - my $l = shift; - while (@_ >= 2) { - my $f = shift; - my $v = shift; + while (@p >= 2) { + my $f = shift @p; + my $v = shift @p; next if !defined $v or $v eq ''; if ($v =~ m/^\!(.*)$/o) { push(@$l, $f, $1); @@ -394,9 +369,8 @@ sub add_entry } } -sub prepare_for_addition +sub prepare_for_addition($self, $state, $pkgname, $) { - my ($self, $state, $pkgname) = @_; my $ok = $self->check; if (defined $ok) { if ($ok == 0) { @@ -408,9 +382,8 @@ sub prepare_for_addition $self->{okay} = $ok; } -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); my $auth = $self->name; $state->say("adding #1 #2", $self->type, $auth) if $state->verbose >= 2; @@ -424,12 +397,10 @@ sub install package OpenBSD::PackingElement::NewUser; -sub command { OpenBSD::Paths->useradd } +sub command($) { OpenBSD::Paths->useradd } -sub build_args +sub build_args($self, $l) { - my ($self, $l) = @_; - $self->add_entry($l, '-u', $self->{uid}, '-g', $self->{group}, @@ -441,12 +412,10 @@ sub build_args package OpenBSD::PackingElement::NewGroup; -sub command { OpenBSD::Paths->groupadd } +sub command($) { OpenBSD::Paths->groupadd } -sub build_args +sub build_args($self, $l) { - my ($self, $l) = @_; - $self->add_entry($l, '-g', $self->{gid}); } @@ -456,9 +425,8 @@ use File::Basename; use File::Path; use OpenBSD::Temp; -sub find_extractible +sub find_extractible($self, $state, $wanted, $tied) { - my ($self, $state, $wanted, $tied) = @_; if ($self->{tieto} || $self->{link} || $self->{symlink}) { $tied->{$self->name} = $self; } else { @@ -466,9 +434,8 @@ sub find_extractible } } -sub prepare_for_addition +sub prepare_for_addition($self, $state, $pkgname, $) { - my ($self, $state, $pkgname) = @_; my $fname = $self->retrieve_fullname($state, $pkgname); # check for collisions with existing stuff if ($state->vstat->exists($fname)) { @@ -489,9 +456,8 @@ sub prepare_for_addition } } -sub prepare_to_extract +sub prepare_to_extract($self, $state, $file) { - my ($self, $state, $file) = @_; my $fullname = $self->fullname; my $destdir = $state->{destdir}; @@ -504,9 +470,8 @@ sub prepare_to_extract $file->{destdir} = $destdir; } -sub find_safe_dir +sub find_safe_dir($self, $state) { - my ($self, $state) = @_; # figure out a safe directory where to put the temp file my $fullname = $self->fullname; @@ -539,9 +504,8 @@ sub find_safe_dir return $d; } -sub create_temp +sub create_temp($self, $d, $state) { - my ($self, $d, $state) = @_; my $fullname = $self->fullname; my ($fh, $tempname) = OpenBSD::Temp::permanent_file($d, "pkg"); $self->{tempname} = $tempname; @@ -556,9 +520,8 @@ sub create_temp return ($fh, $tempname); } -sub may_create_temp +sub may_create_temp($self, $d, $state) { - my ($self, $d, $state) = @_; if ($self->{avoid_temp}) { if (open(my $fh, '>', $self->{avoid_temp})) { return ($fh, $self->{avoid_temp}); @@ -568,9 +531,8 @@ sub may_create_temp return $self->create_temp($d, $state); } -sub tie +sub tie($self, $state) { - my ($self, $state) = @_; if (defined $self->{link} || defined $self->{symlink}) { return; } @@ -602,10 +564,8 @@ sub tie } -sub extract +sub extract($self, $state, $file) { - my ($self, $state, $file) = @_; - $self->SUPER::extract($state); my $d = $self->find_safe_dir($state); @@ -636,9 +596,8 @@ sub extract } } -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); my $fullname = $self->fullname; my $destdir = $state->{destdir}; @@ -677,17 +636,14 @@ sub install } package OpenBSD::PackingElement::Extra; -sub find_extractible +sub find_extractible($self, $state, $wanted, $tied) { - my ($self, $state, $wanted, $tied) = @_; - $state->{current_set}{known_extra}{$self->fullname} = 1; } package OpenBSD::PackingElement::RcScript; -sub install +sub install($self, $state) { - my ($self, $state) = @_; $state->{add_rcscripts}{$self->fullname} = 1; $self->SUPER::install($state); } @@ -696,9 +652,8 @@ package OpenBSD::PackingElement::Sample; use OpenBSD::Error; use File::Copy; -sub prepare_for_addition +sub prepare_for_addition($self, $state, $pkgname, $) { - my ($self, $state, $pkgname) = @_; if (!defined $self->{copyfrom}) { $state->errsay("\@sample element #1 does not reference a valid file", $self->fullname); @@ -720,22 +675,18 @@ sub prepare_for_addition } } -sub find_extractible +sub find_extractible($self, $state, $wanted, $tied) { - my ($self, $state, $wanted, $tied) = @_; - $state->{current_set}{known_sample}{$self->fullname} = 1; } # $self->extract($state) -sub extract +sub extract($, $) { } -sub install +sub install($self, $state) { - my ($self, $state) = @_; - $self->SUPER::install($state); my $destdir = $state->{destdir}; my $filename = $destdir.$self->fullname; @@ -776,20 +727,19 @@ sub install } package OpenBSD::PackingElement::Sampledir; -sub extract +sub extract($, $) { } -sub install +sub install # forwarder { &OpenBSD::PackingElement::Dir::install; } package OpenBSD::PackingElement::Mandir; -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); if (!$state->{current_set}{known_mandirs}{$self->fullname}) { $state->log("You may wish to add #1 to /etc/man.conf", @@ -799,9 +749,8 @@ sub install package OpenBSD::PackingElement::Manpage; -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); $self->register_manpage($state, 'addman'); } @@ -810,9 +759,8 @@ package OpenBSD::PackingElement::InfoFile; use File::Basename; use OpenBSD::Error; -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); return if $state->{not}; my $fullname = $state->{destdir}.$self->fullname; @@ -821,9 +769,8 @@ sub install } package OpenBSD::PackingElement::Shell; -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); return if $state->{not}; my $fullname = $self->fullname; @@ -843,9 +790,8 @@ sub install } package OpenBSD::PackingElement::Dir; -sub extract +sub extract($self, $state) { - my ($self, $state) = @_; my $fullname = $self->fullname; my $destdir = $state->{destdir}; @@ -857,9 +803,8 @@ sub extract $state->make_path($destdir.$fullname, $fullname); } -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); my $fullname = $self->fullname; my $destdir = $state->{destdir}; @@ -874,38 +819,32 @@ sub install package OpenBSD::PackingElement::Exec; use OpenBSD::Error; -sub install +sub install($self, $state) { - my ($self, $state) = @_; - $self->SUPER::install($state); if ($self->should_run($state)) { $self->run($state); } } -sub should_run() { 1 } +sub should_run($, $) { 1 } package OpenBSD::PackingElement::ExecAdd; -sub should_run +sub should_run($self, $state) { - my ($self, $state) = @_; return !$state->replacing; } package OpenBSD::PackingElement::ExecUpdate; -sub should_run +sub should_run($self, $state) { - my ($self, $state) = @_; return $state->replacing; } package OpenBSD::PackingElement::Tag; -sub install +sub install($self, $state) { - my ($self, $state) = @_; - for my $d (@{$self->{definition_list}}) { $d->add_tag($self, "install", $state); } @@ -913,9 +852,8 @@ sub install package OpenBSD::PackingElement::Lib; -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); $self->mark_ldconfig_directory($state); } @@ -924,9 +862,8 @@ package OpenBSD::PackingElement::SpecialFile; use OpenBSD::PackageInfo; use OpenBSD::Error; -sub copy_info +sub copy_info($self, $dest, $state) { - my ($self, $dest, $state) = @_; require File::Copy; File::Copy::move($self->fullname, $dest) or @@ -934,27 +871,24 @@ sub copy_info $self->fullname, $dest, $!); } -sub extract +sub extract($self, $state) { - my ($self, $state) = @_; $self->may_verify_digest($state); } -sub find_extractible +sub find_extractible($self, $state, $, $) { - my ($self, $state) = @_; $self->may_verify_digest($state); } package OpenBSD::PackingElement::FCONTENTS; -sub copy_info +sub copy_info($, $, $) { } package OpenBSD::PackingElement::AskUpdate; -sub prepare_for_addition +sub prepare_for_addition($self, $state, $pkgname, $set) { - my ($self, $state, $pkgname, $set) = @_; my @old = $set->older_names; if ($self->spec->match_ref(\@old) > 0) { my $key = "update_".OpenBSD::PackageName::splitstem($pkgname); @@ -974,9 +908,8 @@ sub prepare_for_addition } package OpenBSD::PackingElement::FDISPLAY; -sub install +sub install($self, $state) { - my ($self, $state) = @_; my $d = $self->{d}; if (!$state->{current_set}{known_displays}{$self->{d}->key}) { $self->prepare($state); @@ -985,9 +918,8 @@ sub install } package OpenBSD::PackingElement::FUNDISPLAY; -sub find_extractible +sub find_extractible($self, $state, $wanted, $tied) { - my ($self, $state, $wanted, $tied) = @_; $state->{current_set}{known_displays}{$self->{d}->key} = 1; $self->SUPER::find_extractible($state, $wanted, $tied); } diff --git a/usr.sbin/pkg_add/OpenBSD/AddCreateDelete.pm b/usr.sbin/pkg_add/OpenBSD/AddCreateDelete.pm index 4dc96af5315..c7d1d701b68 100644 --- a/usr.sbin/pkg_add/OpenBSD/AddCreateDelete.pm +++ b/usr.sbin/pkg_add/OpenBSD/AddCreateDelete.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: AddCreateDelete.pm,v 1.51 2023/05/27 09:59:51 espie Exp $ +# $OpenBSD: AddCreateDelete.pm,v 1.52 2023/06/13 09:07:16 espie Exp $ # # Copyright (c) 2007-2014 Marc Espie # @@ -16,8 +16,7 @@ # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; # common behavior to pkg_add, pkg_delete, pkg_create @@ -27,61 +26,42 @@ our @ISA = qw(OpenBSD::State); use OpenBSD::State; use OpenBSD::ProgressMeter; -sub init +sub init($self, @p) { - my $self = shift; - $self->{progressmeter} = OpenBSD::ProgressMeter->new; $self->{bad} = 0; - $self->SUPER::init(@_); + $self->SUPER::init(@p); $self->{export_level}++; } -sub progress +sub progress($self) { - my $self = shift; return $self->{progressmeter}; } -sub not +sub not($self) { - my $self = shift; return $self->{not}; } -sub sync_display +sub sync_display($self) { - my $self = shift; $self->progress->clear; } -sub add_interactive_options +sub add_interactive_options($self) { - my $self = shift; $self->{has_interactive_options} = 1; return $self; } -sub interactive_class +sub handle_options($state, $opt_string, @usage) { - my ($class, $i) = @_; - if ($i) { - require OpenBSD::Interactive; - return 'OpenBSD::Interactive'; - } else { - return 'OpenBSD::InteractiveStub'; - } -} - -sub handle_options -{ - my ($state, $opt_string, @usage) = @_; - my $i; if ($state->{has_interactive_options}) { $opt_string .= 'iI'; - $state->{opt}{i} = sub { + $state->{opt}{i} = sub() { $i++; }; }; @@ -100,64 +80,65 @@ sub handle_options $state->{interactive} = $state->interactive_class($i)->new($state, $i); } +sub interactive_class($, $i) +{ + if ($i) { + require OpenBSD::Interactive; + return 'OpenBSD::Interactive'; + } else { + return 'OpenBSD::InteractiveStub'; + } +} -sub is_interactive +sub is_interactive($self) { - return shift->{interactive}->is_interactive; + return $self->{interactive}->is_interactive; } -sub find_window_size +sub find_window_size($state) { - my $state = shift; $state->SUPER::find_window_size; $state->{progressmeter}->compute_playfield; } -sub handle_continue +sub handle_continue($state) { - my $state = shift; $state->SUPER::handle_continue; $state->{progressmeter}->handle_continue; } -sub confirm_defaults_to_no +sub confirm_defaults_to_no($self, @p) { - my $self = shift; - return $self->{interactive}->confirm($self->f(@_), 0); + return $self->{interactive}->confirm($self->f(@p), 0); } -sub confirm_defaults_to_yes +sub confirm_defaults_to_yes($self, @p) { - my $self = shift; - return $self->{interactive}->confirm($self->f(@_), 1); + return $self->{interactive}->confirm($self->f(@p), 1); } -sub ask_list +sub ask_list($self, @p) { - my $self = shift; - return $self->{interactive}->ask_list(@_); + return $self->{interactive}->ask_list(@p); } -sub vsystem +sub vsystem($self, @p) { - my $self = shift; if ($self->verbose < 2) { - $self->system(@_); + $self->system(@p); } else { - $self->verbose_system(@_); + $self->verbose_system(@p); } } -sub system +sub system($self, @p) { - my $self = shift; - $self->SUPER::system(@_); + $self->SUPER::system(@p); } -sub run_makewhatis +sub run_makewhatis($state, $opts, $l) { - my ($state, $opts, $l) = @_; - my $braindead = sub { chdir('/'); }; + my $braindead = sub() { chdir('/'); }; while (@$l > 1000) { my @b = splice(@$l, 0, 1000); $state->vsystem($braindead, @@ -167,43 +148,36 @@ sub run_makewhatis OpenBSD::Paths->makewhatis, @$opts, '--', @$l); } -# TODO the maze of ntogo/todo/... is a mess -sub ntogo +# TODO this stuff is definitely not as clear as it could be +sub ntogo($self, $offset = 0) { - my ($self, $offset) = @_; - return $self->{wantntogo} ? $self->progress->ntogo($self, $offset) : $self->f("ok"); } -sub ntogo_string +sub ntogo_string($self, $offset = 0) { - my ($self, $offset) = @_; - return $self->{wantntogo} ? - $self->f(" (#1)", $self->ntodo($offset // 0)) : + $self->f(" (#1)", $self->ntodo($offset)) : $self->f(""); } -sub solve_dependency +sub solve_dependency($self, $solver, $dep, $package) { - my ($self, $solver, $dep, $package) = @_; return $solver->really_solve_dependency($self, $dep, $package); } package OpenBSD::AddCreateDelete; use OpenBSD::Error; -sub handle_options +sub handle_options($self, $opt_string, $state, @usage) { - my ($self, $opt_string, $state, @usage) = @_; $state->handle_options($opt_string, $self, @usage); } -sub try_and_run_command +sub try_and_run_command($self, $state) { - my ($self, $state) = @_; if ($state->defines('pkg-debug')) { $self->run_command($state); } else { @@ -221,25 +195,22 @@ sub try_and_run_command } package OpenBSD::InteractiveStub; -sub new +sub new($class, $, $) { - my $class = shift; bless {}, $class; } -sub ask_list +sub ask_list($, $, @values) { - my ($self, $prompt, @values) = @_; return $values[0]; } -sub confirm +sub confirm($, $, $yesno) { - my ($self, $prompt, $yesno) = @_; return $yesno; } -sub is_interactive +sub is_interactive($) { return 0; } diff --git a/usr.sbin/pkg_add/OpenBSD/AddDelete.pm b/usr.sbin/pkg_add/OpenBSD/AddDelete.pm index 08662844fa7..d4b67feb120 100644 --- a/usr.sbin/pkg_add/OpenBSD/AddDelete.pm +++ b/usr.sbin/pkg_add/OpenBSD/AddDelete.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: AddDelete.pm,v 1.98 2023/05/27 10:00:23 espie Exp $ +# $OpenBSD: AddDelete.pm,v 1.99 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2010 Marc Espie # @@ -16,39 +16,34 @@ # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; # common behavior to pkg_add / pkg_delete package main; our $not; package OpenBSD::PackingElement::FileObject; -sub retrieve_fullname +sub retrieve_fullname($self, $state, $pkgname) { - my ($self, $state, $pkgname) = @_; return $state->{destdir}.$self->fullname; } package OpenBSD::PackingElement::FileBase; -sub retrieve_size +sub retrieve_size($self) { - my $self = shift; return $self->{size}; } package OpenBSD::PackingElement::SpecialFile; use OpenBSD::PackageInfo; -sub retrieve_fullname +sub retrieve_fullname($self, $state, $pkgname) { - my ($self, $state, $pkgname); return installed_info($pkgname).$self->name; } package OpenBSD::PackingElement::FCONTENTS; -sub retrieve_size +sub retrieve_size($self) { - my $self = shift; my $size = 0; my $cname = $self->fullname; if (defined $cname) { @@ -65,10 +60,8 @@ use OpenBSD::PackageInfo; use OpenBSD::AddCreateDelete; our @ISA = qw(OpenBSD::AddCreateDelete); -sub do_the_main_work +sub do_the_main_work($self, $state) { - my ($self, $state) = @_; - if ($state->{bad}) { return; } @@ -91,24 +84,20 @@ sub do_the_main_work return $dielater; } -sub handle_end_tags +sub handle_end_tags($self, $state) { - my ($self, $state) = @_; return if !defined $state->{tags}{atend}; $state->progress->for_list("Running tags", [keys %{$state->{tags}{atend}}], - sub { - my $k = shift; + sub($k) { return if $state->{tags}{deleted}{$k}; return if $state->{tags}{superseded}{$k}; $state->{tags}{atend}{$k}->run_tag($state); }); } -sub run_command +sub run_command($self, $state) { - my ($self, $state) = @_; - lock_db($state->{not}, $state) unless $state->defines('nolock'); $state->check_root; $self->process_parameters($state); @@ -129,10 +118,8 @@ sub run_command rethrow $dielater; } -sub parse_and_run +sub parse_and_run($self, $cmd) { - my ($self, $cmd) = @_; - my $state = $self->new_state($cmd); $state->handle_options; @@ -167,19 +154,17 @@ sub parse_and_run } # $self->silence_children($state) -sub silence_children +sub silence_children($, $) { - 1 } # nothing to do -sub tweak_list +sub tweak_list($, $) { } -sub process_setlist +sub process_setlist($self, $state) { - my ($self, $state) = @_; $state->tracker->todo(@{$state->{setlist}}); # this is the actual very small loop that processes all sets while (my $set = shift @{$state->{setlist}}) { @@ -193,22 +178,19 @@ sub process_setlist } package OpenBSD::SharedItemsRecorder; -sub new +sub new($class) { - my $class = shift; return bless {}, $class; } -sub is_empty +sub is_empty($self) { - my $self = shift; return !(defined $self->{dirs} or defined $self->{users} or defined $self->{groups}); } -sub cleanup +sub cleanup($self, $state) { - my ($self, $state) = @_; return if $self->is_empty or $state->{not}; require OpenBSD::SharedItems; @@ -220,12 +202,10 @@ use OpenBSD::Vstat; use OpenBSD::Log; our @ISA = qw(OpenBSD::AddCreateDelete::State); -sub handle_options +sub handle_options($state, $opt_string, @usage) { - my ($state, $opt_string, @usage) = @_; - $state->{extra_stats} = 0; - $state->{opt}{V} = sub { + $state->{opt}{V} = sub() { $state->{extra_stats}++; }; $state->{no_exports} = 1; @@ -271,52 +251,46 @@ sub handle_options $state->{destdir} = $base; } -sub init +sub init($self, @p) { - my $self = shift; $self->{l} = OpenBSD::Log->new($self); $self->{vstat} = OpenBSD::Vstat->new($self); $self->{status} = OpenBSD::Status->new; $self->{recorder} = OpenBSD::SharedItemsRecorder->new; $self->{v} = 0; - $self->SUPER::init(@_); + $self->SUPER::init(@p); $self->{export_level}++; } -sub syslog +sub syslog($self, @p) { - my $self = shift; return unless $self->{loglevel}; - Sys::Syslog::syslog('info', $self->f(@_)); + Sys::Syslog::syslog('info', $self->f(@p)); } -sub ntodo +sub ntodo($state, $offset) { - my ($state, $offset) = @_; return $state->tracker->sets_todo($offset); } # one-level dependencies tree, for nicer printouts -sub build_deptree +sub build_deptree($state, $set, @deps) { - my ($state, $set, @deps) = @_; - if (defined $state->{deptree}{$set}) { $set = $state->{deptree}{$set}; } for my $dep (@deps) { - $state->{deptree}{$dep} = $set unless - defined $state->{deptree}{$dep}; + $state->{deptree}{$dep} = $set + unless defined $state->{deptree}{$dep}; } } -sub deptree_header +sub deptree_header($state, $pkg) { - my ($state, $pkg) = @_; - if (defined $state->{deptree}->{$pkg}) { - my $s = $state->{deptree}->{$pkg}->real_set; + if (defined $state->{deptree}{$pkg}) { + my $s = $state->{deptree}{$pkg}->real_set; if ($s eq $pkg) { - delete $state->{deptree}->{$pkg}; + delete $state->{deptree}{$pkg}; } else { return $s->short_print.':'; } @@ -324,26 +298,22 @@ sub deptree_header return ''; } -sub vstat +sub vstat($self) { - my $self = shift; return $self->{vstat}; } -sub log +sub log($self, @p) { - my $self = shift; - if (@_ == 0) { + if (@p == 0) { return $self->{l}; } else { - $self->{l}->say(@_); + $self->{l}->say(@p); } } -sub run_quirks +sub run_quirks($state, $sub) { - my ($state, $sub) = @_; - if (!exists $state->{quirks}) { eval { use lib ('/usr/local/libdata/perl5/site_perl'); @@ -373,9 +343,8 @@ sub run_quirks } } -sub check_root +sub check_root($state) { - my $state = shift; if ($< && !$state->defines('nonroot')) { if ($state->{not}) { $state->errsay("#1 should be run as root", @@ -386,15 +355,13 @@ sub check_root } } -sub choose_location +sub choose_location($state, $name, $list, $is_quirks = 0) { - my ($state, $name, $list, $is_quirks) = @_; if (@$list == 0) { if (!$is_quirks) { $state->errsay("Can't find #1", $name); $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $quirks->filter_obsolete([$name], $state); }); } @@ -407,7 +374,7 @@ sub choose_location if ($state->is_interactive) { $h{''} = undef; $state->progress->clear; - my $cmp = sub { + my $cmp = sub { # XXX prototypable ? return -1 if !defined $h{$a}; return 1 if !defined $h{$b}; my $r = $h{$a}->pkgname->to_pattern cmp @@ -428,36 +395,30 @@ sub choose_location } } -sub status +sub status($self) { - my $self = shift; - return $self->{status}; } -sub replacing +sub replacing($self) { - my $self = shift; return $self->{replacing}; } OpenBSD::Auto::cache(ldconfig, - sub { - my $self = shift; + sub($self) { return OpenBSD::LdConfig->new($self); }); # if we're not running as root, allow some stuff when not under /usr/local -sub allow_nonroot +sub allow_nonroot($state, $path) { - my ($state, $path) = @_; return $state->defines('nonroot') && $path !~ m,^\Q$state->{localbase}/\E,; } -sub make_path +sub make_path($state, $path, $fullname) { - my ($state, $path, $fullname) = @_; require File::Path; if ($state->allow_nonroot($fullname)) { eval { @@ -471,16 +432,14 @@ sub make_path # this is responsible for running ldconfig when needed package OpenBSD::LdConfig; -sub new +sub new($class, $state) { - my ($class, $state) = @_; bless { state => $state, todo => 0 }, $class; } # called once to figure out which directories are actually used -sub init +sub init($self) { - my $self = shift; my $state = $self->{state}; my $destdir = $state->{destdir}; @@ -508,9 +467,8 @@ sub init } # called from libs to figure out whether ldconfig should be rerun -sub mark_directory +sub mark_directory($self, $name) { - my ($self, $name) = @_; if (!defined $self->{path}) { $self->init; } @@ -522,9 +480,8 @@ sub mark_directory } # call before running any command (or at end) to run ldconfig just in time -sub ensure +sub ensure($self) { - my $self = shift; if ($self->{todo}) { my $state = $self->{state}; $state->vsystem(@{$self->{ldconfig}}, "-R") @@ -536,12 +493,10 @@ sub ensure # the object that gets displayed during status updates package OpenBSD::Status; -sub print +sub print($self, $state) { - my ($self, $state) = @_; - my $what = $self->{what}; - $what //= "Processing"; + $what //= 'Processing'; my $object; if (defined $self->{object}) { $object = $self->{object}; @@ -558,33 +513,28 @@ sub print } } -sub set +sub set($self, $set) { - my ($self, $set) = @_; delete $self->{object}; $self->{set} = $set; return $self; } -sub object +sub object($self, $object) { - my ($self, $object) = @_; delete $self->{set}; $self->{object} = $object; return $self; } -sub what +sub what($self, $what = undef) { - my ($self, $what) = @_; $self->{what} = $what; return $self; } -sub new +sub new($class) { - my $class = shift; - bless {}, $class; } diff --git a/usr.sbin/pkg_add/OpenBSD/ArcCheck.pm b/usr.sbin/pkg_add/OpenBSD/ArcCheck.pm index 0f9dbec6182..ce5dd3569d0 100644 --- a/usr.sbin/pkg_add/OpenBSD/ArcCheck.pm +++ b/usr.sbin/pkg_add/OpenBSD/ArcCheck.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: ArcCheck.pm,v 1.41 2023/05/27 10:00:48 espie Exp $ +# $OpenBSD: ArcCheck.pm,v 1.42 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2005-2006 Marc Espie # @@ -34,20 +34,18 @@ # $o->validate_meta($item) or # error... -use strict; -use warnings; +use v5.36; use OpenBSD::Ustar; package OpenBSD::Ustar::Object; use POSIX; -sub is_allowed() { 0 } +sub is_allowed($) { 0 } # match archive header link name against actual link name -sub _check_linkname +sub _check_linkname($self, $linkname) { - my ($self, $linkname) = @_; my $c = $self->{linkname}; if ($self->isHardLink && defined $self->{cwd}) { $c = $self->{cwd}.'/'.$c; @@ -55,16 +53,13 @@ sub _check_linkname return $c eq $linkname; } -sub _errsay +sub _errsay($o, @msg) { - my ($self, @args) = @_; - $self->{archive}{state}->errsay(@args); + $o->{archive}{state}->errsay(@msg); } -sub validate_meta +sub validate_meta($o, $item) { - my ($o, $item) = @_; - $o->{cwd} = $item->cwd; if (defined $item->{symlink} || $o->isSymLink) { if (!defined $item->{symlink}) { @@ -120,10 +115,8 @@ sub validate_meta return $o->verify_modes($item); } -sub _strip_modes +sub _strip_modes($o, $item) { - my ($o, $item) = @_; - my $result = $o->{mode}; # disallow writable files/dirs without explicit annotation @@ -149,16 +142,14 @@ sub _strip_modes return $result; } -sub _printable_mode +sub _printable_mode($o) { - my $o = shift; return sprintf("%4o", $o->{mode} & (S_IRWXU | S_IRWXG | S_IRWXO | S_ISUID | S_ISGID)); } -sub verify_modes +sub verify_modes($o, $item) { - my ($o, $item) = @_; my $result = 1; if (!defined $item->{owner}) { @@ -186,21 +177,20 @@ sub verify_modes } package OpenBSD::Ustar::HardLink; -sub is_allowed() { 1 } +sub is_allowed($) { 1 } package OpenBSD::Ustar::SoftLink; -sub is_allowed() { 1 } +sub is_allowed($) { 1 } package OpenBSD::Ustar::File; -sub is_allowed() { 1 } +sub is_allowed($) { 1 } package OpenBSD::Ustar; use POSIX; # prepare item according to pkg_create's rules. -sub prepare_long +sub prepare_long($self, $item) { - my ($self, $item) = @_; my $entry; if (defined $item->{wtempname}) { $entry = $self->prepare($item->{wtempname}, ''); diff --git a/usr.sbin/pkg_add/OpenBSD/BaseState.pm b/usr.sbin/pkg_add/OpenBSD/BaseState.pm index 161e5745e51..231a0e6e77e 100644 --- a/usr.sbin/pkg_add/OpenBSD/BaseState.pm +++ b/usr.sbin/pkg_add/OpenBSD/BaseState.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: BaseState.pm,v 1.2 2023/06/07 15:09:01 espie Exp $ +# $OpenBSD: BaseState.pm,v 1.3 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2022 Marc Espie # @@ -16,36 +16,33 @@ # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; package OpenBSD::BaseState; use Carp; -sub can_output +sub can_output($) { 1; } -sub sync_display +sub sync_display($) { } my $forbidden = qr{[^[:print:]\s]}; -sub safe +sub safe($self, $string) { - my ($self, $string) = @_; $string =~ s/$forbidden/?/g; return $string; } -sub f +sub f($self, @p) { - my $self = shift; - if (@_ == 0) { + if (@p == 0) { return undef; } - my ($fmt, @l) = @_; + my ($fmt, @l) = @p; # is there anything to format, actually ? if ($fmt =~ m/\#\d/) { @@ -60,85 +57,71 @@ sub f return $fmt; } -sub _fatal +sub _fatal($self, @p) { - my $self = shift; # implementation note: to print "fatal errors" elsewhere, # the way is to eval { croak @_}; and decide what to do with $@. delete $SIG{__DIE__}; $self->sync_display; - croak @_, "\n"; + croak @p, "\n"; } -sub fatal +sub fatal($self, @p) { - my $self = shift; - $self->_fatal($self->f(@_)); + $self->_fatal($self->f(@p)); } -sub _fhprint +sub _fhprint($self, $fh, @p) { - my $self = shift; - my $fh = shift; $self->sync_display; - print $fh @_; + print $fh @p; } -sub _print +sub _print($self, @p) { - my $self = shift; - $self->_fhprint(\*STDOUT, @_) if $self->can_output; + $self->_fhprint(\*STDOUT, @p) if $self->can_output; } -sub _errprint +sub _errprint($self, @p) { - my $self = shift; - $self->_fhprint(\*STDERR, @_); + $self->_fhprint(\*STDERR, @p); } -sub fhprint +sub fhprint($self, $fh, @p) { - my $self = shift; - my $fh = shift; - $self->_fhprint($fh, $self->f(@_)); + $self->_fhprint($fh, $self->f(@p)); } -sub fhsay +sub fhsay($self, $fh, @p) { - my $self = shift; - my $fh = shift; - if (@_ == 0) { + if (@p == 0) { $self->_fhprint($fh, "\n"); } else { - $self->_fhprint($fh, $self->f(@_), "\n"); + $self->_fhprint($fh, $self->f(@p), "\n"); } } -sub print +sub print($self, @p) { - my $self = shift; - $self->fhprint(\*STDOUT, @_) if $self->can_output; + $self->fhprint(\*STDOUT, @p) if $self->can_output; } -sub say +sub say($self, @p) { - my $self = shift; - $self->fhsay(\*STDOUT, @_) if $self->can_output; + $self->fhsay(\*STDOUT, @p) if $self->can_output; } -sub errprint +sub errprint($self, @p) { - my $self = shift; - $self->fhprint(\*STDERR, @_); + $self->fhprint(\*STDERR, @p); } -sub errsay +sub errsay($self, @p) { - my $self = shift; - $self->fhsay(\*STDERR, @_); + $self->fhsay(\*STDERR, @p); } my @signal_name = (); -sub fillup_names +sub fillup_names($) { { # XXX force autoload @@ -170,10 +153,8 @@ sub fillup_names $signal_name[29] = 'INFO'; } -sub find_signal +sub find_signal($self, $number) { - my ($self, $number) = @_; - if (@signal_name == 0) { $self->fillup_names; } @@ -181,11 +162,8 @@ sub find_signal return $signal_name[$number] || $number; } -sub child_error +sub child_error($self, $error = $?) { - my ($self, $error) = @_; - $error //= $?; - my $extra = ""; if ($error & 128) { @@ -199,20 +177,19 @@ sub child_error } } -sub _system +sub _system($self, @p) { - my $self = shift; $self->sync_display; my ($todo, $todo2); - if (ref $_[0] eq 'CODE') { - $todo = shift; + if (ref $p[0] eq 'CODE') { + $todo = shift @p; } else { - $todo = sub {}; + $todo = sub() {}; } - if (ref $_[0] eq 'CODE') { - $todo2 = shift; + if (ref $p[0] eq 'CODE') { + $todo2 = shift @p; } else { - $todo2 = sub {}; + $todo2 = sub() {}; } my $r = fork; if (!defined $r) { @@ -220,7 +197,7 @@ sub _system } elsif ($r == 0) { $DB::inhibit_exit = 0; &$todo(); - exec {$_[0]} @_ or + exec {$p[0]} @p or exit 1; } else { &$todo2(); @@ -229,27 +206,24 @@ sub _system } } -sub system +sub system($self, @p) { - my $self = shift; - my $r = $self->_system(@_); + my $r = $self->_system(@p); if ($r != 0) { - if (ref $_[0] eq 'CODE') { - shift; + if (ref $p[0] eq 'CODE') { + shift @p; } - if (ref $_[0] eq 'CODE') { - shift; + if (ref $p[0] eq 'CODE') { + shift @p; } $self->errsay("system(#1) failed: #2", - join(", ", @_), $self->child_error); + join(", ", @p), $self->child_error); } return $r; } -sub verbose_system +sub verbose_system($self, @p) { - my $self = shift; - my @p = @_; if (ref $p[0]) { shift @p; } @@ -258,7 +232,7 @@ sub verbose_system } $self->print("Running #1", join(' ', @p)); - my $r = $self->_system(@_); + my $r = $self->_system(@p); if ($r != 0) { $self->say("... failed: #1", $self->child_error); } else { @@ -266,40 +240,36 @@ sub verbose_system } } -sub copy_file +sub copy_file($self, @p) { - my $self = shift; require File::Copy; - my $r = File::Copy::copy(@_); + my $r = File::Copy::copy(@p); if (!$r) { - $self->say("copy(#1) failed: #2", join(',', @_), $!); + $self->say("copy(#1) failed: #2", join(',', @p), $!); } return $r; } -sub unlink +sub unlink($self, $verbose, @p) { - my $self = shift; - my $verbose = shift; - my $r = unlink @_; - if ($r != @_) { + my $r = unlink @p; + if ($r != @p) { $self->say("rm #1 failed: removed only #2 targets, #3", - join(' ', @_), $r, $!); + join(' ', @p), $r, $!); } elsif ($verbose) { - $self->say("rm #1", join(' ', @_)); + $self->say("rm #1", join(' ', @p)); } return $r; } -sub copy +sub copy($self, @p) { - my $self = shift; require File::Copy; - my $r = File::Copy::copy(@_); + my $r = File::Copy::copy(@p); if (!$r) { - $self->say("copy(#1) failed: #2", join(',', @_), $!); + $self->say("copy(#1) failed: #2", join(',', @p), $!); } return $r; } diff --git a/usr.sbin/pkg_add/OpenBSD/CollisionReport.pm b/usr.sbin/pkg_add/OpenBSD/CollisionReport.pm index b3f10f5cfdf..2e76d67fb2f 100644 --- a/usr.sbin/pkg_add/OpenBSD/CollisionReport.pm +++ b/usr.sbin/pkg_add/OpenBSD/CollisionReport.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: CollisionReport.pm,v 1.48 2019/09/04 12:27:38 espie Exp $ +# $OpenBSD: CollisionReport.pm,v 1.49 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2006 Marc Espie # @@ -15,18 +15,16 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackingElement; -sub handle_collisions +sub handle_collisions($, $, $, $) { } package OpenBSD::PackingElement::FileBase; -sub handle_collisions +sub handle_collisions($self, $todo, $pkg, $bypkg) { - my ($self, $todo, $pkg, $bypkg) = @_; my $name = $self->fullname; if (defined $todo->{$name}) { push(@{$bypkg->{$pkg}}, $name); @@ -38,9 +36,8 @@ package OpenBSD::CollisionReport; use OpenBSD::PackingList; use OpenBSD::PackageInfo; -sub find_collisions +sub find_collisions($todo, $state) { - my ($todo, $state) = @_; my $verbose = $state->verbose >= 3; my $bypkg = {}; for my $name (keys %$todo) { @@ -68,10 +65,8 @@ sub find_collisions return $bypkg; } -sub collision_report +sub collision_report($list, $state, $set) { - my ($list, $state, $set) = @_; - my $destdir = $state->{destdir}; if ($state->defines('removecollisions')) { diff --git a/usr.sbin/pkg_add/OpenBSD/Delete.pm b/usr.sbin/pkg_add/OpenBSD/Delete.pm index 567c1991a39..e118784eacd 100644 --- a/usr.sbin/pkg_add/OpenBSD/Delete.pm +++ b/usr.sbin/pkg_add/OpenBSD/Delete.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Delete.pm,v 1.167 2023/05/27 10:01:08 espie Exp $ +# $OpenBSD: Delete.pm,v 1.168 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::Delete; use OpenBSD::Error; @@ -25,9 +24,8 @@ use OpenBSD::RequiredBy; use OpenBSD::Paths; use File::Basename; -sub keep_old_files +sub keep_old_files($state, $plist) { - my ($state, $plist) = @_; my $p = OpenBSD::PackingList->new; my $borked = borked_package($plist->pkgname); $p->set_infodir(installed_info($borked)); @@ -39,9 +37,8 @@ sub keep_old_files return $borked; } -sub manpages_unindex +sub manpages_unindex($state) { - my ($state) = @_; return unless defined $state->{rmman}; my $destdir = $state->{destdir}; @@ -57,17 +54,13 @@ sub manpages_unindex delete $state->{rmman}; } -sub validate_plist +sub validate_plist($plist, $state) { - my ($plist, $state) = @_; - $plist->prepare_for_deletion($state, $plist->pkgname); } -sub remove_packing_info +sub remove_packing_info($plist, $state) { - my ($plist, $state) = @_; - my $dir = $plist->infodir; for my $fname (info_names()) { @@ -79,9 +72,8 @@ sub remove_packing_info $state->fatal("can't finish removing directory #1: #2", $dir, $!); } -sub delete_handle +sub delete_handle($handle, $state) { - my ($handle, $state) = @_; my $pkgname = $handle->pkgname; my $plist = $handle->plist; if ($plist->has('firmware') && !$state->defines('FW_UPDATE')) { @@ -107,10 +99,8 @@ sub delete_handle delete_plist($plist, $state); } -sub unregister_dependencies +sub unregister_dependencies($plist, $state) { - my ($plist, $state) = @_; - my $pkgname = $plist->pkgname; my $l = OpenBSD::Requiring->new($pkgname); @@ -127,10 +117,8 @@ sub unregister_dependencies $l->erase; } -sub delete_plist +sub delete_plist($plist, $state) { - my ($plist, $state) = @_; - my $pkgname = $plist->pkgname; $state->{pkgname} = $pkgname; if (!$state->defines('stub')) { @@ -156,9 +144,8 @@ sub delete_plist package OpenBSD::PackingElement; -sub rename_file_to_temp +sub rename_file_to_temp($self, $state) { - my ($self, $state) = @_; require OpenBSD::Temp; my $n = $self->realname($state); @@ -181,39 +168,36 @@ sub rename_file_to_temp } # $self->prepare_for_deletion($state, $pkgname) -sub prepare_for_deletion +sub prepare_for_deletion($, $, $) { } # $self->delete($state) -sub delete +sub delete($, $) { } # $self->record_shared($recorder, $pkgname) -sub record_shared +sub record_shared($, $, $) { } -sub copy_old_stuff +sub copy_old_stuff($self, $plist, $state) { } package OpenBSD::PackingElement::Cwd; -sub copy_old_stuff +sub copy_old_stuff($self, $plist, $state) { - my ($self, $plist, $state) = @_; $self->add_object($plist); } package OpenBSD::PackingElement::FileObject; use File::Basename; -sub mark_directory +sub mark_directory($self, $state, $dir) { - my ($self, $state, $dir) = @_; - $state->{dirs_okay}{$dir} = 1; my $d2 = dirname($dir); if ($d2 ne $dir) { @@ -221,17 +205,13 @@ sub mark_directory } } -sub mark_dir +sub mark_dir($self, $state) { - my ($self, $state) = @_; - $self->mark_directory($state, dirname($self->fullname)); } -sub do_not_delete +sub do_not_delete($self, $state) { - my ($self, $state) = @_; - my $realname = $self->realname($state); $state->{baddelete} = 1; $self->{stillaround} = 1; @@ -252,27 +232,23 @@ sub do_not_delete package OpenBSD::PackingElement::DirlikeObject; -sub mark_dir +sub mark_dir($self, $state) { - my ($self, $state) = @_; $self->mark_directory($state, $self->fullname); } package OpenBSD::PackingElement::RcScript; # XXX we should check stuff more thoroughly -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; $state->{delete_rcscripts}{$self->fullname} = 1; $self->SUPER::delete($state); } package OpenBSD::PackingElement::NewUser; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; - if ($state->verbose >= 2) { $state->say("rmuser: #1", $self->name); } @@ -280,17 +256,14 @@ sub delete $self->record_shared($state->{recorder}, $state->{pkgname}); } -sub record_shared +sub record_shared($self, $recorder, $pkgname) { - my ($self, $recorder, $pkgname) = @_; $recorder->{users}{$self->name} = $pkgname; } package OpenBSD::PackingElement::NewGroup; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; - if ($state->verbose >= 2) { $state->say("rmgroup: #1", $self->name); } @@ -298,24 +271,20 @@ sub delete $self->record_shared($state->{recorder}, $state->{pkgname}); } -sub record_shared +sub record_shared($self, $recorder, $pkgname) { - my ($self, $recorder, $pkgname) = @_; $recorder->{groups}{$self->name} = $pkgname; } package OpenBSD::PackingElement::DirBase; -sub prepare_for_deletion +sub prepare_for_deletion($self, $state, $pkgname) { - my ($self, $state, $pkgname) = @_; $state->vstat->remove_directory( $self->retrieve_fullname($state, $pkgname), $self); } -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; - if ($state->verbose >= 5) { $state->say("rmdir: #1", $self->fullname); } @@ -323,66 +292,59 @@ sub delete $self->record_shared($state->{recorder}, $state->{pkgname}); } -sub record_shared +sub record_shared($self, $recorder, $pkgname) { - my ($self, $recorder, $pkgname) = @_; # enough for the entry to exist, we only record interesting # entries more thoroughly $recorder->{dirs}{$self->fullname} //= []; } package OpenBSD::PackingElement::Mandir; -sub record_shared +sub record_shared($self, $recorder, $pkgname) { - my ($self, $recorder, $pkgname) = @_; $self->{pkgname} = $pkgname; push(@{$recorder->{dirs}{$self->fullname}} , $self); } package OpenBSD::PackingElement::Fontdir; -sub record_shared +sub record_shared($self, $recorder, $pkgname) { - my ($self, $recorder, $pkgname) = @_; $self->{pkgname} = $pkgname; push(@{$recorder->{dirs}{$self->fullname}} , $self); $recorder->{fonts_todo}{$self->fullname} = 1; } package OpenBSD::PackingElement::Infodir; -sub record_shared +sub record_shared # forwarder { &OpenBSD::PackingElement::Mandir::record_shared; } package OpenBSD::PackingElement::Unexec; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; if ($self->should_run($state)) { $self->run($state); } } -sub should_run { 1 } +sub should_run($, $) { 1 } package OpenBSD::PackingElement::UnexecDelete; -sub should_run +sub should_run($self, $state) { - my ($self, $state) = @_; return !$state->replacing; } package OpenBSD::PackingElement::UnexecUpdate; -sub should_run +sub should_run($self, $state) { - my ($self, $state) = @_; return $state->replacing; } package OpenBSD::PackingElement::DefineTag::Atend; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; if (!$state->replacing) { $state->{tags}{deleted}{$self->name} = 1; } @@ -390,10 +352,8 @@ sub delete package OpenBSD::PackingElement::Tag; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; - for my $d (@{$self->{definition_list}}) { $d->add_tag($self, "delete", $state); } @@ -402,10 +362,8 @@ sub delete package OpenBSD::PackingElement::FileBase; use OpenBSD::Error; -sub prepare_for_deletion +sub prepare_for_deletion($self, $state, $pkgname) { - my ($self, $state, $pkgname) = @_; - my $fname = $self->retrieve_fullname($state, $pkgname); my $s; my $size = $self->{tied} ? 0 : $self->retrieve_size; @@ -420,9 +378,8 @@ sub prepare_for_deletion } } -sub is_intact +sub is_intact($self, $state, $realname) { - my ($self, $state, $realname) = @_; return 1 if defined($self->{link}) or $self->{nochecksum}; if (!defined $self->{d}) { if ($self->fullname eq $realname) { @@ -447,9 +404,8 @@ sub is_intact return 0; } -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; my $realname = $self->realname($state); return if defined $state->{current_set}{dont_delete}{$realname}; @@ -502,10 +458,8 @@ sub delete } } -sub copy_old_stuff +sub copy_old_stuff($self, $plist, $state) { - my ($self, $plist, $state) = @_; - if (defined $self->{stillaround}) { delete $self->{stillaround}; if ($state->replacing) { @@ -518,26 +472,24 @@ sub copy_old_stuff package OpenBSD::PackingElement::SpecialFile; use OpenBSD::PackageInfo; -sub copy_old_stuff +sub copy_old_stuff($, $, $) { } package OpenBSD::PackingElement::Meta; -sub copy_old_stuff +sub copy_old_stuff($self, $plist, $state) { - my ($self, $plist, $state) = @_; $self->add_object($plist); } package OpenBSD::PackingElement::DigitalSignature; -sub copy_old_stuff +sub copy_old_stuff($, $, $) { } package OpenBSD::PackingElement::FDESC; -sub copy_old_stuff +sub copy_old_stuff($self, $plist, $state) { - my ($self, $plist, $state) = @_; require File::Copy; File::Copy::copy($self->fullname, $plist->infodir); @@ -548,9 +500,8 @@ package OpenBSD::PackingElement::Sample; use OpenBSD::Error; use File::Basename; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; my $realname = $self->realname($state); my $orig = $self->{copyfrom}; @@ -603,9 +554,8 @@ sub delete package OpenBSD::PackingElement::InfoFile; use File::Basename; use OpenBSD::Error; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; unless ($state->{not}) { my $fullname = $state->{destdir}.$self->fullname; $state->vsystem(OpenBSD::Paths->install_info, @@ -615,9 +565,8 @@ sub delete } package OpenBSD::PackingElement::Shell; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; unless ($state->{not}) { my $destdir = $state->{destdir}; my $fullname = $self->fullname; @@ -645,9 +594,8 @@ sub delete package OpenBSD::PackingElement::Extra; use File::Basename; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; return if defined $state->{current_set}{known_extra}{$self->fullname}; my $realname = $self->realname($state); if ($state->verbose >= 2 && $state->{extra}) { @@ -666,9 +614,8 @@ sub delete package OpenBSD::PackingElement::Extradir; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; return unless $state->{extra}; return if defined $state->{current_set}{known_extra}{$self->fullname}; my $realname = $self->realname($state); @@ -682,9 +629,8 @@ sub delete package OpenBSD::PackingElement::ExtraUnexec; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; if ($state->{extra}) { $self->run($state); } else { @@ -693,34 +639,29 @@ sub delete } package OpenBSD::PackingElement::Lib; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; $self->SUPER::delete($state); $self->mark_ldconfig_directory($state); } package OpenBSD::PackingElement::Depend; -sub copy_old_stuff +sub copy_old_stuff($self, $plist, $state) { - my ($self, $plist, $state) = @_; - OpenBSD::PackingElement::Comment->add($plist, "\@".$self->keyword." ".$self->stringize); } package OpenBSD::PackingElement::FDISPLAY; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; $state->{current_set}{known_displays}{$self->{d}->key} = 1; $self->SUPER::delete($state); } package OpenBSD::PackingElement::FUNDISPLAY; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; my $d = $self->{d}; if (!$state->{current_set}{known_displays}{$self->{d}->key}) { $self->prepare($state); @@ -729,9 +670,8 @@ sub delete } package OpenBSD::PackingElement::Mandir; -sub delete +sub delete($self, $state) { - my ($self, $state) = @_; $state->{current_set}{known_mandirs}{$self->fullname} = 1; $self->SUPER::delete($state); } diff --git a/usr.sbin/pkg_add/OpenBSD/Dependencies.pm b/usr.sbin/pkg_add/OpenBSD/Dependencies.pm index 1e40ca04e0e..717f8869347 100644 --- a/usr.sbin/pkg_add/OpenBSD/Dependencies.pm +++ b/usr.sbin/pkg_add/OpenBSD/Dependencies.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Dependencies.pm,v 1.174 2023/05/21 16:07:35 espie Exp $ +# $OpenBSD: Dependencies.pm,v 1.175 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2005-2010 Marc Espie # @@ -14,55 +14,48 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; use OpenBSD::Dependencies::SolverBase; package _cache; -sub new +sub new($class, $v) { - my ($class, $v) = @_; bless \$v, $class; } -sub pretty +sub pretty($self) { - my $self = shift; return ref($self)."(".$$self.")"; } package _cache::self; our @ISA=(qw(_cache)); -sub do +sub do($v, $solver, $state, $dep, $package) { - my ($v, $solver, $state, $dep, $package) = @_; push(@{$package->{before}}, $$v); return $$v; } package _cache::installed; our @ISA=(qw(_cache)); -sub do +sub do($v, $solver, $state, $dep, $package) { - my ($v, $solver, $state, $dep, $package) = @_; return $$v; } package _cache::bad; our @ISA=(qw(_cache)); -sub do +sub do($v, $solver, $state, $dep, $package) { - my ($v, $solver, $state, $dep, $package) = @_; return $$v; } package _cache::to_install; our @ISA=(qw(_cache)); -sub do +sub do($v, $solver, $state, $dep, $package) { - my ($v, $solver, $state, $dep, $package) = @_; if ($state->tracker->{uptodate}{$$v}) { bless $v, "_cache::installed"; $solver->set_global($dep, $v); @@ -88,9 +81,8 @@ sub do package _cache::to_update; our @ISA=(qw(_cache)); -sub do +sub do($v, $solver, $state, $dep, $package) { - my ($v, $solver, $state, $dep, $package) = @_; my $alt = $solver->find_dep_in_self($state, $dep); if ($alt) { $solver->set_cache($dep, _cache::self->new($alt)); @@ -125,23 +117,18 @@ our @ISA = qw(OpenBSD::Dependencies::SolverBase); use OpenBSD::PackageInfo; -sub merge +sub merge($solver, @extra) { - my ($solver, @extra) = @_; - $solver->clone('cache', @extra); } -sub new +sub new($class, $set) { - my ($class, $set) = @_; bless { set => $set, bad => [] }, $class; } -sub check_for_loops +sub check_for_loops($self, $state) { - my ($self, $state) = @_; - my $initial = $self->{set}; my @todo = (); @@ -185,10 +172,8 @@ sub check_for_loops } } -sub find_dep_in_repositories +sub find_dep_in_repositories($self, $state, $dep) { - my ($self, $state, $dep) = @_; - return unless $dep->spec->is_valid; my $default = $dep->{def}; @@ -224,10 +209,8 @@ sub find_dep_in_repositories } } -sub find_dep_in_stuff_to_install +sub find_dep_in_stuff_to_install($self, $state, $dep) { - my ($self, $state, $dep) = @_; - my $v = $self->find_candidate($dep, keys %{$state->tracker->{uptodate}}); if ($v) { @@ -257,10 +240,8 @@ sub find_dep_in_stuff_to_install return $v; } -sub really_solve_dependency +sub really_solve_dependency($self, $state, $dep, $package) { - my ($self, $state, $dep, $package) = @_; - my $v; if ($state->{allow_replacing}) { @@ -318,10 +299,8 @@ sub really_solve_dependency return $v; } -sub check_depends +sub check_depends($self) { - my $self = shift; - for my $dep ($self->dependencies) { push(@{$self->{bad}}, $dep) unless is_installed($dep) or @@ -330,10 +309,8 @@ sub check_depends return $self->{bad}; } -sub register_dependencies +sub register_dependencies($self, $state) { - my ($self, $state) = @_; - require OpenBSD::RequiredBy; for my $pkg ($self->{set}->newer) { my $pkgname = $pkg->pkgname; @@ -346,9 +323,8 @@ sub register_dependencies } } -sub repair_dependencies +sub repair_dependencies($self, $state) { - my ($self, $state) = @_; for my $p ($self->{set}->newer) { my $pkgname = $p->pkgname; for my $pkg (installed_packages(1)) { @@ -359,9 +335,8 @@ sub repair_dependencies } } -sub find_old_lib +sub find_old_lib($self, $state, $base, $pattern, $lib) { - my ($self, $state, $base, $pattern, $lib) = @_; require OpenBSD::Search; @@ -375,17 +350,13 @@ sub find_old_lib return undef; } -sub errsay_library +sub errsay_library($solver, $state, $h) { - my ($solver, $state, $h) = @_; - $state->errsay("Can't install #1 because of libraries", $h->pkgname); } -sub solve_old_depends +sub solve_old_depends($self, $state) { - my ($self, $state) = @_; - $self->{old_dependencies} = {}; for my $package ($self->{set}->older) { for my $dep (@{$package->dependency_info->{depend}}) { @@ -397,9 +368,8 @@ sub solve_old_depends } } -sub solve_handle_tags +sub solve_handle_tags($solver, $h, $state) { - my ($solver, $h, $state) = @_; my $plist = $h->plist; return 1 if !defined $plist->{tags}; my $okay = 1; @@ -415,10 +385,8 @@ sub solve_handle_tags return $okay; } -sub solve_tags +sub solve_tags($solver, $state) { - my ($solver, $state) = @_; - my $okay = 1; for my $h ($solver->{set}->changed_handles) { if (!$solver->solve_handle_tags($h, $state)) { @@ -433,14 +401,13 @@ sub solve_tags } package OpenBSD::PackingElement; -sub repair_dependency +sub repair_dependency($, $, $) { } package OpenBSD::PackingElement::Dependency; -sub repair_dependency +sub repair_dependency($self, $requiring, $required) { - my ($self, $requiring, $required) = @_; if ($self->spec->filter($required) == 1) { require OpenBSD::RequiredBy; OpenBSD::RequiredBy->new($required)->add($requiring); diff --git a/usr.sbin/pkg_add/OpenBSD/Dependencies/SolverBase.pm b/usr.sbin/pkg_add/OpenBSD/Dependencies/SolverBase.pm index 8f0f9603518..c631c3480c4 100644 --- a/usr.sbin/pkg_add/OpenBSD/Dependencies/SolverBase.pm +++ b/usr.sbin/pkg_add/OpenBSD/Dependencies/SolverBase.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: SolverBase.pm,v 1.15 2023/05/27 10:08:45 espie Exp $ +# $OpenBSD: SolverBase.pm,v 1.16 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2005-2018 Marc Espie # @@ -14,17 +14,18 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; # generic dependencies lookup class: walk the dependency tree as far # as necessary to resolve dependencies package OpenBSD::lookup; -sub lookup -{ - my ($self, $solver, $dependencies, $state, $obj) = @_; +# this is a template method that relies on subclasses defining +# find_in_already_done, find_in_extra_sources, find_in_new_source +# and find_elsewhere accordingly +sub lookup($self, $solver, $dependencies, $state, $obj) +{ my $known = $self->{known}; if (my $r = $self->find_in_already_done($solver, $state, $obj)) { $dependencies->{$r} = 1; @@ -71,9 +72,8 @@ sub lookup # While walking the dependency tree, we may loop back to an older package, # because we're relying on dep lists on disk, that we haven't adjusted yet # since we're just checking. We need to prepare for the update here as well! -sub may_adjust +sub may_adjust($self, $solver, $state, $dep) { - my ($self, $solver, $state, $dep) = @_; my $h = $solver->{set}{older}{$dep}; if (defined $h) { $state->print("Detecting older #1...", $dep) @@ -93,19 +93,15 @@ sub may_adjust return undef; } -sub new +sub new($class, $solver) { - my ($class, $solver) = @_; - # prepare for closure my @todo = $solver->dependencies; bless { todo => \@todo, done => {}, known => {} }, $class; } -sub dump +sub dump($self, $state) { - my ($self, $state) = @_; - return unless %{$self->{done}}; $state->say("Full dependency tree is #1", join(' ', keys %{$self->{done}})); @@ -114,19 +110,14 @@ sub dump package OpenBSD::lookup::library; our @ISA=qw(OpenBSD::lookup); -sub say_found +sub say_found($self, $state, $obj, $where) { - my ($self, $state, $obj, $where) = @_; - $state->say("found libspec #1 in #2", $obj->to_string, $where) if $state->verbose >= 3; } -sub find_in_already_done +sub find_in_already_done($self, $solver, $state, $obj) { - my ($self, $solver, $state, $obj) = @_; - - my $r = $solver->check_lib_spec($state, $solver->{localbase}, $obj, $self->{known}); if ($r) { @@ -137,9 +128,8 @@ sub find_in_already_done } } -sub find_in_extra_sources +sub find_in_extra_sources($self, $solver, $state, $obj) { - my ($self, $solver, $state, $obj) = @_; return undef if !$obj->is_valid || defined $obj->{dir}; $state->shlibs->add_libs_from_system($state->{destdir}); @@ -152,10 +142,8 @@ sub find_in_extra_sources return undef; } -sub find_in_new_source +sub find_in_new_source($self, $solver, $state, $obj, $dep) { - my ($self, $solver, $state, $obj, $dep) = @_; - if (defined $solver->{set}{newer}{$dep}) { $state->shlibs->add_libs_from_plist($solver->{set}{newer}{$dep}->plist); } else { @@ -168,10 +156,8 @@ sub find_in_new_source return undef; } -sub find_elsewhere +sub find_elsewhere($self, $solver, $state, $obj) { - my ($self, $solver, $state, $obj) = @_; - for my $n ($solver->{set}->newer) { for my $dep (@{$n->dependency_info->{depend}}) { my $r = $solver->find_old_lib($state, @@ -188,10 +174,8 @@ sub find_elsewhere package OpenBSD::lookup::tag; our @ISA=qw(OpenBSD::lookup); -sub new +sub new($class, $solver, $state) { - my ($class, $solver, $state) = @_; - # prepare for closure if (!defined $solver->{old_dependencies}) { $solver->solve_old_depends($state); @@ -200,17 +184,16 @@ sub new bless { todo => \@todo, done => {}, known => {} }, $class; } -sub find_in_extra_sources +sub find_in_extra_sources($, $, $, $) { } -sub find_elsewhere +sub find_elsewhere($, $, $, $) { } -sub find_in_already_done +sub find_in_already_done($self, $solver, $state, $obj) { - my ($self, $solver, $state, $obj) = @_; my $r = $self->{known_tags}{$obj->name}; if (defined $r) { my ($dep, $d) = @$r; @@ -222,9 +205,8 @@ sub find_in_already_done return undef; } -sub find_in_plist +sub find_in_plist($self, $plist, $dep) { - my ($self, $plist, $dep) = @_; if (defined $plist->{tags_definitions}) { while (my ($name, $d) = each %{$plist->{tags_definitions}}) { $self->{known_tags}{$name} = [$dep, $d]; @@ -232,9 +214,8 @@ sub find_in_plist } } -sub find_in_new_source +sub find_in_new_source($self, $solver, $state, $obj, $dep) { - my ($self, $solver, $state, $obj, $dep) = @_; my $plist; if (defined $solver->{set}{newer}{$dep}) { @@ -254,9 +235,8 @@ sub find_in_new_source # both the solver and the conflict cache inherit from cloner # they both want to merge several hashes from extra data. package OpenBSD::Cloner; -sub clone +sub clone($self, $h, @extra) { - my ($self, $h, @extra) = @_; for my $extra (@extra) { next unless defined $extra; while (my ($k, $e) = each %{$extra->{$h}}) { @@ -274,34 +254,29 @@ our @ISA = qw(OpenBSD::Cloner); my $global_cache = {}; -sub cached +sub cached($self, $dep) { - my ($self, $dep) = @_; return $global_cache->{$dep->{pattern}} || $self->{cache}{$dep->{pattern}}; } -sub set_cache +sub set_cache($self, $dep, $value) { - my ($self, $dep, $value) = @_; $self->{cache}{$dep->{pattern}} = $value; } -sub set_global +sub set_global($self, $dep, $value) { - my ($self, $dep, $value) = @_; $global_cache->{$dep->{pattern}} = $value; } -sub global_cache +sub global_cache($self, $pattern) { - my ($self, $pattern) = @_; return $global_cache->{$pattern}; } -sub find_candidate +sub find_candidate($self, $dep, @list) { - my ($self, $dep, @list) = @_; my @candidates = $dep->spec->filter(@list); if (@candidates >= 1) { return $candidates[0]; @@ -310,10 +285,8 @@ sub find_candidate } } -sub solve_dependency +sub solve_dependency($self, $state, $dep, $package) { - my ($self, $state, $dep, $package) = @_; - my $v; if (defined $self->cached($dep)) { @@ -335,10 +308,8 @@ sub solve_dependency $state->solve_dependency($self, $dep, $package); } -sub solve_depends +sub solve_depends($self, $state) { - my ($self, $state) = @_; - $self->{all_dependencies} = {}; $self->{to_register} = {}; $self->{deplist} = {}; @@ -358,9 +329,8 @@ sub solve_depends return sort values %{$self->{deplist}}; } -sub solve_wantlibs +sub solve_wantlibs($solver, $state) { - my ($solver, $state) = @_; my $okay = 1; my $lib_finder = OpenBSD::lookup::library->new($solver); @@ -384,9 +354,8 @@ sub solve_wantlibs return $okay; } -sub dump +sub dump($self, $state) { - my ($self, $state) = @_; if ($self->dependencies) { $state->print("Direct dependencies for #1 resolve to #2", $self->{set}->print, join(' ', $self->dependencies)); @@ -397,9 +366,8 @@ sub dump } } -sub dependencies +sub dependencies($self) { - my $self = shift; if (wantarray) { return keys %{$self->{all_dependencies}}; } else { @@ -407,9 +375,8 @@ sub dependencies } } -sub check_lib_spec +sub check_lib_spec($self, $state, $base, $spec, $dependencies) { - my ($self, $state, $base, $spec, $dependencies) = @_; my $r = $state->shlibs->lookup_libspec($base, $spec); for my $candidate (@$r) { if ($dependencies->{$candidate->origin}) { @@ -419,24 +386,19 @@ sub check_lib_spec return; } -sub find_dep_in_installed +sub find_dep_in_installed($self, $state, $dep) { - my ($self, $state, $dep) = @_; - return $self->find_candidate($dep, @{$self->installed_list}); } -sub find_dep_in_self +sub find_dep_in_self($self, $state, $dep) { - my ($self, $state, $dep) = @_; - return $self->find_candidate($dep, $self->{set}->newer_names, $self->{set}->kept_names); } -sub find_in_self +sub find_in_self($solver, $plist, $state, $tag) { - my ($solver, $plist, $state, $tag) = @_; return 0 unless defined $plist->{tags_definitions}{$tag->name}; $tag->{definition_list} = $plist->{tags_definitions}{$tag->name}; $tag->{found_in_self} = 1; @@ -447,8 +409,7 @@ sub find_in_self use OpenBSD::PackageInfo; OpenBSD::Auto::cache(installed_list, - sub { - my $self = shift; + sub($self) { my @l = installed_packages(); for my $o ($self->{set}->older_names) { @@ -458,16 +419,14 @@ OpenBSD::Auto::cache(installed_list, } ); -sub add_dep +sub add_dep($self, $d) { - my ($self, $d) = @_; $self->{deplist}{$d} = $d; } -sub verify_tag +sub verify_tag($self, $tag, $state, $plist, $is_old) { - my ($self, $tag, $state, $plist, $is_old) = @_; my $bad_return = $is_old ? 1 : 0; my $type = $is_old ? "Warning" : "Error"; my $msg = "#1 in #2: \@tag #3"; diff --git a/usr.sbin/pkg_add/OpenBSD/Error.pm b/usr.sbin/pkg_add/OpenBSD/Error.pm index ebc29e7e5f8..996bd3e8d45 100644 --- a/usr.sbin/pkg_add/OpenBSD/Error.pm +++ b/usr.sbin/pkg_add/OpenBSD/Error.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Error.pm,v 1.42 2023/05/27 10:01:21 espie Exp $ +# $OpenBSD: Error.pm,v 1.43 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2004-2010 Marc Espie # @@ -14,18 +14,15 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; # this is a set of common classes related to error handling in pkg land package OpenBSD::Auto; -sub cache :prototype(*&) +sub cache :prototype(*&)($sym, $code) { - my ($sym, $code) = @_; my $callpkg = caller; - my $actual = sub { - my $self = shift; + my $actual = sub($self) { return $self->{$sym} //= &$code($self); }; no strict 'refs'; @@ -36,40 +33,35 @@ package OpenBSD::SigHandler; # instead of "local" sighandlers, let's do objects that revert # to their former state afterwards -sub new +sub new($class) { - my $class = shift; # keep previous state bless {}, $class; } -sub DESTROY +sub DESTROY($self) { - my $self = shift; while (my ($s, $v) = each %$self) { $SIG{$s} = $v; } } -sub set +sub set($self, @p) { - my $self = shift; - my $v = pop; - for my $s (@_) { + my $v = pop @p; + for my $s (@p) { $self->{$s} = $SIG{$s}; $SIG{$s} = $v; } return $self; } -sub intercept +sub intercept($self, @p) { - my $self = shift; - my $v = pop; - return $self->set(@_, - sub { - my $sig = shift; + my $v = pop @p; + return $self->set(@p, + sub($sig, @) { &$v($sig); $SIG{$sig} = $self->{$sig}; kill -$sig, $$; @@ -93,9 +85,8 @@ my $atend = {}; # hash of code to run on fatal signals my $cleanup = {}; -sub cleanup +sub cleanup($class, $sig) { - my ($class, $sig) = @_; # XXX note that order of cleanup is "unpredictable" for my $v (values %$cleanup) { &$v($sig); @@ -106,34 +97,31 @@ END { # XXX localize $? so that cleanup doesn't fuck up our exit code local $?; for my $v (values %$atend) { - &$v(); + &$v(undef); } } # register each code block "by name" so that we can re-register each # block several times -sub register +sub register($class, $code) { - my ($class, $code) = @_; $cleanup->{$code} = $code; } -sub atend +sub atend($class, $code) { - my ($class, $code) = @_; $cleanup->{$code} = $code; $atend->{$code} = $code; } -my $handler = sub { - my $sig = shift; +my $handler = sub($sig, @) { __PACKAGE__->cleanup($sig); # after cleanup, just propagate the signal $SIG{$sig} = 'DEFAULT'; kill $sig, $$; }; -sub reset +sub reset($) { for my $sig (qw(INT QUIT HUP KILL TERM)) { $SIG{$sig} = $handler; @@ -153,9 +141,8 @@ our ($FileName, $Line, $FullMessage); our @INTetc = (qw(INT QUIT HUP TERM)); use Carp; -sub dienow +sub dienow($error, $handler) { - my ($error, $handler) = @_; if ($error) { if ($error =~ m/^(.*?)(?:\s+at\s+(.*)\s+line\s+(\d+)\.?)?$/o) { local $_ = $1; @@ -170,48 +157,44 @@ sub dienow } } -sub try :prototype(&@) +sub try :prototype(&@)($try, $catch) { - my ($try, $catch) = @_; - eval { &$try }; + eval { &$try() }; dienow($@, $catch); } -sub throw +sub throw(@p) { - croak @_; + croak @p; } -sub rethrow +sub rethrow($e) { - my $e = shift; die $e if $e; } -sub catch :prototype(&) +sub catch :prototype(&)($code) { - bless $_[0], "OpenBSD::Error::catch"; + bless $code, "OpenBSD::Error::catch"; } -sub rmtree +sub rmtree($class, @p) { - my $class = shift; require File::Path; require Cwd; # XXX make sure we live somewhere Cwd::getcwd() || chdir('/'); - File::Path::rmtree(@_); + File::Path::rmtree(@p); } package OpenBSD::Error::catch; -# TODO why keep the data we don't use ?... -sub exec + +sub exec($self, $fullerror, $error, $filename, $line) { - my ($self, $full, $e) = @_; - &$self; + &$self(); } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/ForwardDependencies.pm b/usr.sbin/pkg_add/OpenBSD/ForwardDependencies.pm index db99078e6e0..9fabf479109 100644 --- a/usr.sbin/pkg_add/OpenBSD/ForwardDependencies.pm +++ b/usr.sbin/pkg_add/OpenBSD/ForwardDependencies.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: ForwardDependencies.pm,v 1.17 2021/10/12 09:06:37 espie Exp $ +# $OpenBSD: ForwardDependencies.pm,v 1.18 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2009 Marc Espie # @@ -16,16 +16,14 @@ # handling of forward dependency adjustments -use strict; -use warnings; +use v5.36; package OpenBSD::ForwardDependencies; require OpenBSD::RequiredBy; -sub find +sub find($class, $set) { - my ($class, $set) = @_; my $forward = {}; for my $old ($set->older) { for my $f (OpenBSD::RequiredBy->new($old->pkgname)->list) { @@ -36,10 +34,8 @@ sub find bless { forward => $forward, set => $set}, $class; } -sub find_belated_update +sub find_belated_update($set, $state, $old) { - my ($set, $state, $old) = @_; - for my $n ($set->newer) { if ($n->conflict_list->conflicts_with($old->pkgname)) { if (defined $old->{update_found}) { @@ -54,9 +50,8 @@ sub find_belated_update return $old->{update_found}; } -sub adjust +sub adjust($self, $state) { - my ($self, $state) = @_; my $set = $self->{set}; for my $f (keys %{$self->{forward}}) { @@ -93,9 +88,8 @@ sub adjust } } -sub dump +sub dump($self, $result, $state) { - my ($self, $result, $state) = @_; $state->say("#1 forward dependencies:", $self->{set}->print); while (my ($pkg, $l) = each %$result) { if (@$l == 1) { @@ -109,10 +103,8 @@ sub dump } } -sub check +sub check($self, $state) { - my ($self, $state) = @_; - my @r = keys %{$self->{forward}}; my $set = $self->{set}; my $result = {}; @@ -141,15 +133,13 @@ sub check } package OpenBSD::PackingElement; -sub check_forward_dependency +sub check_forward_dependency($, $, $, $, $) { } package OpenBSD::PackingElement::Dependency; -sub check_forward_dependency +sub check_forward_dependency($self, $f, $old, $new, $r) { - my ($self, $f, $old, $new, $r) = @_; - # nothing to validate if old dependency doesn't concern us. return unless $self->spec->filter(@$old); # nothing to do if new dependency just matches diff --git a/usr.sbin/pkg_add/OpenBSD/FwUpdate.pm b/usr.sbin/pkg_add/OpenBSD/FwUpdate.pm index bbb8ae32a0f..bc741a4e14c 100644 --- a/usr.sbin/pkg_add/OpenBSD/FwUpdate.pm +++ b/usr.sbin/pkg_add/OpenBSD/FwUpdate.pm @@ -1,7 +1,7 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: FwUpdate.pm,v 1.34 2022/03/10 07:18:24 hastings Exp $ +# $OpenBSD: FwUpdate.pm,v 1.35 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2014 Marc Espie # @@ -17,8 +17,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; use OpenBSD::PkgAdd; use OpenBSD::PackageRepository; use OpenBSD::PackageLocator; @@ -26,9 +25,8 @@ use OpenBSD::PackageLocator; package OpenBSD::FwUpdate::Locator; our @ISA = qw(OpenBSD::PackageLocator); -sub add_default +sub add_default($self, $state, $p) { - my ($self, $state, $p) = @_; my $path = $state->opt('p'); if (!$path) { my $dir = OpenBSD::Paths->os_directory; @@ -43,19 +41,18 @@ sub add_default package OpenBSD::FwUpdate::State; our @ISA = qw(OpenBSD::PkgAdd::State); -sub cache_directory +sub cache_directory($) { return undef; } -sub locator +sub locator($) { return "OpenBSD::FwUpdate::Locator"; } -sub handle_options +sub handle_options($state) { - my $state = shift; $state->OpenBSD::State::handle_options('adinp:', '[-adinv] [-D keyword] [-p path] [driver...]'); $state->{not} = $state->opt('n'); @@ -83,53 +80,46 @@ sub handle_options $state->{subst}->add('NO_SCP', 1); } -sub finish_init +sub finish_init($state) { - my $state = shift; delete $state->{signer_list}; # XXX uncache value $state->{subst}->add('FW_UPDATE', 1); } -sub installed_drivers +sub installed_drivers($self) { - my $self = shift; return keys %{$self->{installed_drivers}}; } -sub is_installed +sub is_installed($self, $driver) { - my ($self, $driver) = @_; return $self->{installed_drivers}{$driver}; } -sub machine_drivers +sub machine_drivers($self) { - my $self = shift; return keys %{$self->{machine_drivers}}; } -sub all_drivers +sub all_drivers($self) { - my $self = shift; return keys %{$self->{all_drivers}}; } -sub is_needed +sub is_needed($self, $driver) { my ($self, $driver) = @_; return $self->{machine_drivers}{$driver}; } -sub display_timestamp +sub display_timestamp($state, $pkgname, $timestamp) { - my ($state, $pkgname, $timestamp) = @_; return unless $state->verbose; $state->SUPER::display_timestamp($pkgname, $timestamp); } -sub fw_status +sub fw_status($state, $msg, $list) { - my ($state, $msg, $list) = @_; return if @$list == 0; $state->say("#1: #2", $msg, join(' ', @$list)); } @@ -141,7 +131,7 @@ package OpenBSD::FwUpdate; our @ISA = qw(OpenBSD::PkgAdd); OpenBSD::Auto::cache(updater, - sub { + sub($) { require OpenBSD::Update; return OpenBSD::FwUpdate::Update->new; }); @@ -154,10 +144,8 @@ my %possible_drivers = map {($_, "$_-firmware")} my %match = map {($_, qr{^\Q$_\E\d+\s+at\s})} (keys %possible_drivers); $match{'intel'} = qr{^cpu\d+: Intel}; -sub parse_dmesg +sub parse_dmesg($self, $f, $search, $found) { - my ($self, $f, $search, $found) = @_; - while (<$f>) { chomp; for my $driver (keys %$search) { @@ -168,9 +156,8 @@ sub parse_dmesg } } -sub find_machine_drivers +sub find_machine_drivers($self, $state) { - my ($self, $state) = @_; $state->{machine_drivers} = {}; $state->{all_drivers} = \%possible_drivers; my %search = %possible_drivers; @@ -188,15 +175,13 @@ sub find_machine_drivers } } -sub driver2firmware +sub driver2firmware($k) { - my $k = shift; return $possible_drivers{$k}; } -sub find_installed_drivers +sub find_installed_drivers($self, $state) { - my ($self, $state) = @_; my $inst = $state->repo->installed; for my $driver (keys %possible_drivers) { my $search = OpenBSD::Search::Stem->new(driver2firmware($driver)); @@ -209,15 +194,13 @@ sub find_installed_drivers } -sub new_state +sub new_state($self, $cmd) { - my ($self, $cmd) = @_; return OpenBSD::FwUpdate::State->new($cmd); } -sub find_handle +sub find_handle($self, $state, $driver) { - my ($self, $state, $driver) = @_; my $pkgname = driver2firmware($driver); my $set; my $h = $state->is_installed($driver); @@ -229,9 +212,8 @@ sub find_handle return $set; } -sub mark_set_for_deletion +sub mark_set_for_deletion($self, $set, $state) { - my ($self, $set, $state) = @_; # XXX to be simplified. Basically, we pre-do the work of the updater... for my $h ($set->older) { $h->{update_found} = 1; @@ -240,29 +222,25 @@ sub mark_set_for_deletion } # no quirks for firmware, bypass entirely -sub do_quirks +sub do_quirks($self, $state) { - my ($self, $state) = @_; $state->finish_init; } -sub to_remove +sub to_remove($self, $state, $driver) { - my ($self, $state, $driver) = @_; $self->mark_set_for_deletion($self->to_add_or_update($state, $driver)); } -sub to_add_or_update +sub to_add_or_update($self, $state, $driver) { - my ($self, $state, $driver) = @_; my $set = $self->find_handle($state, $driver); push(@{$state->{setlist}}, $set); return $set; } -sub show_info +sub show_info($self, $state) { - my ($self, $state) = @_; my (@installed, @unneeded, @needed); for my $d ($state->installed_drivers) { my $h = $state->is_installed($d)->pkgname; @@ -282,15 +260,13 @@ sub show_info $state->fw_status("Missing", \@needed); } -sub silence_children +sub silence_children($, $) { 0 } -sub process_parameters +sub process_parameters($self, $state) { - my ($self, $state) = @_; - $self->find_machine_drivers($state); $self->find_installed_drivers($state); diff --git a/usr.sbin/pkg_add/OpenBSD/Getopt.pm b/usr.sbin/pkg_add/OpenBSD/Getopt.pm index 98713830664..eedb555df17 100644 --- a/usr.sbin/pkg_add/OpenBSD/Getopt.pm +++ b/usr.sbin/pkg_add/OpenBSD/Getopt.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Getopt.pm,v 1.15 2023/05/21 13:44:21 espie Exp $ +# $OpenBSD: Getopt.pm,v 1.16 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2006 Marc Espie # @@ -18,8 +18,7 @@ # This is inspired by Getopt::Std, except for the ability to invoke subs # on options. -use strict; -use warnings; +use v5.36; package OpenBSD::Getopt; require Exporter; @@ -27,10 +26,8 @@ require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(getopts); -sub handle_option +sub handle_option($opt, $hash, @params) { - my ($opt, $hash, @params) = @_; - if (defined $hash->{$opt} and ref($hash->{$opt}) eq 'CODE') { &{$hash->{$opt}}(@params); } else { @@ -48,10 +45,8 @@ sub handle_option } } -sub getopts +sub getopts($args, $hash) { - my ($args, $hash) = @_; - $hash = {} unless defined $hash; local @EXPORT; diff --git a/usr.sbin/pkg_add/OpenBSD/Handle.pm b/usr.sbin/pkg_add/OpenBSD/Handle.pm index 12fb2ece71b..720169c99f8 100644 --- a/usr.sbin/pkg_add/OpenBSD/Handle.pm +++ b/usr.sbin/pkg_add/OpenBSD/Handle.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Handle.pm,v 1.43 2022/05/08 13:21:04 espie Exp $ +# $OpenBSD: Handle.pm,v 1.44 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2009 Marc Espie # @@ -18,8 +18,7 @@ # fairly non-descriptive name. Used to store various package information # during installs and updates. -use strict; -use warnings; +use v5.36; package OpenBSD::Handle; @@ -34,11 +33,10 @@ use constant { CANT_DELETE => 5, }; -sub is_real { return 1; } +sub is_real($) { return 1; } -sub cleanup +sub cleanup($self, $error = undef, $errorinfo = undef) { - my ($self, $error, $errorinfo) = @_; if (defined $error) { $self->{error} //= $error; $self->{errorinfo} //= $errorinfo; @@ -56,21 +54,18 @@ sub cleanup delete $self->{conflict_list}; } -sub new +sub new($class) { - my $class = shift; return bless {}, $class; } -sub system +sub system($class) { - my $class = shift; return OpenBSD::Handle::BaseSystem->new; } -sub pkgname +sub pkgname($self) { - my $self = shift; if (!defined $self->{pkgname}) { if (defined $self->{plist}) { $self->{pkgname} = $self->{plist}->pkgname; @@ -87,19 +82,18 @@ sub pkgname return $self->{pkgname}; } -sub location +sub location($self) { - return shift->{location}; + return $self->{location}; } -sub plist +sub plist($self) { - return shift->{plist}; + return $self->{plist}; } -sub dependency_info +sub dependency_info($self) { - my $self = shift; if (defined $self->{plist}) { return $self->{plist}; } elsif (defined $self->{location} && @@ -111,20 +105,18 @@ sub dependency_info } OpenBSD::Auto::cache(conflict_list, - sub { + sub($self) { require OpenBSD::PkgCfl; - return OpenBSD::PkgCfl->make_conflict_list(shift->dependency_info); + return OpenBSD::PkgCfl->make_conflict_list($self->dependency_info); }); -sub set_error +sub set_error($self, $error) { - my ($self, $error) = @_; $self->{error} = $error; } -sub has_error +sub has_error($self, $error = undef) { - my ($self, $error) = @_; if (!defined $self->{error}) { return undef; } @@ -134,15 +126,13 @@ sub has_error return $self->{error}; } -sub has_reported_error +sub has_reported_error($self) { - my $self = shift; return $self->{error_reported}; } -sub error_message +sub error_message($self) { - my $self = shift; my $error = $self->{error}; if ($error == BAD_PACKAGE) { return "bad package"; @@ -161,9 +151,8 @@ sub error_message } } -sub complete_old +sub complete_old($self) { - my $self = shift; my $location = $self->{location}; if (!defined $location) { @@ -180,9 +169,8 @@ sub complete_old } } -sub complete_dependency_info +sub complete_dependency_info($self) { - my $self = shift; my $location = $self->{location}; if (!defined $location) { @@ -195,10 +183,8 @@ sub complete_dependency_info } } -sub create_old +sub create_old($class, $pkgname, $state) { - - my ($class, $pkgname, $state) = @_; my $self= $class->new; $self->{name} = $pkgname; @@ -211,28 +197,24 @@ sub create_old return $self; } -sub create_new +sub create_new($class, $pkg) { - my ($class, $pkg) = @_; my $handle = $class->new; $handle->{name} = $pkg; $handle->{tweaked} = 0; return $handle; } -sub from_location +sub from_location($class, $location) { - my ($class, $location) = @_; my $handle = $class->new; $handle->{location} = $location; $handle->{tweaked} = 0; return $handle; } -sub get_plist +sub get_plist($handle, $state) { - my ($handle, $state) = @_; - my $location = $handle->{location}; my $pkg = $handle->pkgname; @@ -273,10 +255,8 @@ sub get_plist $handle->{plist} = $plist; } -sub get_location +sub get_location($handle, $state) { - my ($handle, $state) = @_; - my $name = $handle->{name}; my $location = $state->repo->find($name); @@ -300,10 +280,8 @@ sub get_location $handle->{pkgname} = $location->name; } -sub complete +sub complete($handle, $state) { - my ($handle, $state) = @_; - return if $handle->has_error; if (!defined $handle->{location}) { @@ -317,8 +295,8 @@ sub complete package OpenBSD::Handle::BaseSystem; our @ISA = qw(OpenBSD::Handle); -sub pkgname { return "BaseSystem"; } +sub pkgname($) { return "BaseSystem"; } -sub is_real { return 0; } +sub is_real($) { return 0; } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/IdCache.pm b/usr.sbin/pkg_add/OpenBSD/IdCache.pm index 35324d954e0..96e55be85c5 100644 --- a/usr.sbin/pkg_add/OpenBSD/IdCache.pm +++ b/usr.sbin/pkg_add/OpenBSD/IdCache.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: IdCache.pm,v 1.11 2023/05/16 14:31:54 espie Exp $ +# $OpenBSD: IdCache.pm,v 1.12 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2002-2005 Marc Espie # @@ -14,19 +14,16 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; package OpenBSD::SimpleIdCache; -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub lookup +sub lookup($self, $name, $default = undef) { - my ($self, $name, $default) = @_; my $r; if (defined $self->{$name}) { @@ -45,10 +42,8 @@ sub lookup package OpenBSD::IdCache; our @ISA=qw(OpenBSD::SimpleIdCache); -sub lookup +sub lookup($self, $name, $default = undef) { - my ($self, $name, $default) = @_; - if ($name =~ m/^\d+$/o) { return $name; } else { @@ -59,35 +54,35 @@ sub lookup package OpenBSD::UidCache; our @ISA=qw(OpenBSD::IdCache); -sub _convert +sub _convert($, $key) { - my @entry = getpwnam($_[1]); + my @entry = getpwnam($key); return @entry == 0 ? undef : $entry[2]; } package OpenBSD::GidCache; our @ISA=qw(OpenBSD::IdCache); -sub _convert +sub _convert($, $key) { - my @entry = getgrnam($_[1]); + my @entry = getgrnam($key); return @entry == 0 ? undef : $entry[2]; } package OpenBSD::UnameCache; our @ISA=qw(OpenBSD::SimpleIdCache); -sub _convert +sub _convert($, $key) { - return getpwuid($_[1]); + return getpwuid($key); } package OpenBSD::GnameCache; our @ISA=qw(OpenBSD::SimpleIdCache); -sub _convert +sub _convert($, $key) { - return getgrgid($_[1]); + return getgrgid($key); } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/InstalledInfo.pm b/usr.sbin/pkg_add/OpenBSD/InstalledInfo.pm index 33e7b6bb74c..6ffabfa131d 100644 --- a/usr.sbin/pkg_add/OpenBSD/InstalledInfo.pm +++ b/usr.sbin/pkg_add/OpenBSD/InstalledInfo.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: InstalledInfo.pm,v 1.1 2020/02/17 13:06:45 espie Exp $ +# $OpenBSD: InstalledInfo.pm,v 1.2 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::InstalledInfo; require Exporter; @@ -36,34 +35,29 @@ use constant { UNDISPLAY => '+UNDISPLAY' }; -sub new +sub new($class, $state, $dir = $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb) { - my ($class, $state, $dir) = @_; - $dir //= $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb; return bless {state => $state, pkgdb => $dir}, $class; } -sub list +sub list($self) { - my $self = shift; if (!defined $self->{list}) { $self->_init; } return $self->{list}; } -sub stems +sub stems($self) { - my $self = shift; if (!defined $self->{stemlist}) { $self->_init; } return $self->{stemlist}; } -sub _init +sub _init($self) { - my $self = shift; opendir(my $dir, $self->{pkgdb}) or $self->{state}->fatal("Bad pkg_db #1: #2", $self->{pgkdb}, $!); @@ -86,20 +80,18 @@ for my $i (@info) { $info{$i} = $j; } -sub add +sub add($self, @p) { - my $self = shift; - for my $p (@_) { + for my $p (@p) { $self->{list}{$p} = 1; $self->{stemlist}->add($p); } return $self; } -sub delete +sub delete($self, @p) { - my $self = shift; - for my $p (@_) { + for my $p (@p) { delete $self->{list}{$p}; $self->{stemlist}->delete($p); @@ -107,20 +99,17 @@ sub delete return $self; } -sub packages +sub packages($self, $all = 0) { - my $self = shift; - if ($_[0]) { + if ($all) { return grep { !/^\./o } keys %{$self->list}; } else { return keys %{$self->list}; } } -sub fullname +sub fullname($self, $name) { - my ($self, $name) = @_; - if ($name =~ m|^\Q$self->{pkgdb}\E/?|) { return "$name/"; } else { @@ -128,15 +117,13 @@ sub fullname } } -sub contents +sub contents($self, $name) { - my ($self, $name) = @_; return $self->info($name).CONTENTS; } -sub borked_package +sub borked_package($self, $pkgname) { - my ($self, $pkgname) = shift; $pkgname = "partial-$pkgname" unless $pkgname =~ m/^partial\-/; unless (-e "$self->{pkgdb}/$pkgname") { return $pkgname; @@ -149,9 +136,8 @@ sub borked_package return "$pkgname.$i"; } -sub libs_package +sub libs_package($self, $pkgname) { - my ($self, $pkgname) = @_; $pkgname =~ s/^\.libs\d*\-//; unless (-e "$self->{pkgdb}/.libs-$pkgname") { return ".libs-$pkgname"; @@ -164,9 +150,8 @@ sub libs_package return ".libs$i-$pkgname"; } -sub installed_name +sub installed_name($self, $path) { - my ($self, $path) = @_; require File::Spec; my $name = File::Spec->canonpath($path); $name =~ s|/$||o; @@ -175,28 +160,24 @@ sub installed_name return $name; } -sub is_installed +sub is_installed($self, $path) { - my ($self, $path) = @_; my $name = $self->installed_name($path); return defined $self->list->{$self->installed_name($path)}; } -sub info_names +sub info_names($class) { - my $class = shift; return @info; } -sub is_info_name +sub is_info_name($class, $name) { - my ($class, $name) = @_; return $info{$name}; } -sub lock +sub lock($self, $shared = 0, $quiet = 0) { - my ($self, $shared, $quiet) = @_; return if defined $self->{dlock}; my $mode = $shared ? LOCK_SH : LOCK_EX; open($self->{dlock}, '<', $self->{pkg_db}) or return; @@ -209,7 +190,7 @@ sub lock return $self; } -sub unlock +sub unlock($self) { my $self = shift; if (defined $self->{dlock}) { diff --git a/usr.sbin/pkg_add/OpenBSD/Interactive.pm b/usr.sbin/pkg_add/OpenBSD/Interactive.pm index 618556e701e..2b51dd4eadd 100644 --- a/usr.sbin/pkg_add/OpenBSD/Interactive.pm +++ b/usr.sbin/pkg_add/OpenBSD/Interactive.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Interactive.pm,v 1.22 2018/02/26 13:53:31 espie Exp $ +# $OpenBSD: Interactive.pm,v 1.23 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2005-2007 Marc Espie # @@ -14,14 +14,12 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; package OpenBSD::Interactive; -sub new +sub new($class, $state, $level) { - my ($class, $state, $level) = @_; bless { state => $state, always => 0, @@ -29,9 +27,8 @@ sub new }, $class; } -sub ask_list +sub ask_list($self, $prompt, @values) { - my ($self, $prompt, @values) = @_; if ($self->{always}) { return $values[0]; } @@ -83,9 +80,8 @@ LOOP: } } -sub confirm +sub confirm($self, $prompt, $yesno = 0) { - my ($self, $prompt, $yesno) = @_; if ($self->{always}) { return 1; } @@ -118,9 +114,9 @@ LOOP2: goto LOOP2; } -sub is_interactive +sub is_interactive($self) { - return shift->{level}; + return $self->{level}; } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/LibSpec.pm b/usr.sbin/pkg_add/OpenBSD/LibSpec.pm index 942eafd4957..d3f78d4fedb 100644 --- a/usr.sbin/pkg_add/OpenBSD/LibSpec.pm +++ b/usr.sbin/pkg_add/OpenBSD/LibSpec.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: LibSpec.pm,v 1.19 2023/05/27 10:01:38 espie Exp $ +# $OpenBSD: LibSpec.pm,v 1.20 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2010 Marc Espie # @@ -15,14 +15,12 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; package OpenBSD::LibObject; -sub key +sub key($self) { - my $self = shift; if (defined $self->{dir}) { return "$self->{dir}/$self->{stem}"; } else { @@ -30,43 +28,37 @@ sub key } } -sub major +sub major($self) { - my $self = shift; return $self->{major}; } -sub minor +sub minor($self) { - my $self = shift; return $self->{minor}; } -sub version +sub version($self) { - my $self = shift; return ".".$self->major.".".$self->minor; } -sub is_static { 0 } +sub is_static($) { 0 } -sub is_valid { 1 } +sub is_valid($) { 1 } -sub stem +sub stem($self) { - my $self = shift; return $self->{stem}; } -sub badclass +sub badclass($self) { "OpenBSD::BadLib"; } -sub lookup +sub lookup($spec, $repo, $base) { - my ($spec, $repo, $base) = @_; - my $approx = $spec->lookup_stem($repo); if (!defined $approx) { return undef; @@ -80,9 +72,8 @@ sub lookup return $r; } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; if ($a->key ne $b->key) { return $a->key cmp $b->key; } @@ -95,51 +86,47 @@ sub compare package OpenBSD::BadLib; our @ISA=qw(OpenBSD::LibObject); -sub to_string +sub to_string($self) { - my $self = shift; return $$self; } -sub new +sub new($class, $string) { - my ($class, $string) = @_; bless \$string, $class; } -sub is_valid +sub is_valid($) { return 0; } -sub lookup_stem +sub lookup_stem($, $) { return undef; } # $spec->match($library, $base) -sub match +sub match($, $, $) { return 0; } package OpenBSD::LibRepo; -sub new + +sub new($class) { - my $class = shift; bless {}, $class; } -sub register +sub register($repo, $lib, $origin) { - my ($repo, $lib, $origin) = @_; $lib->set_origin($origin); push @{$repo->{$lib->stem}}, $lib; } -sub find_best +sub find_best($repo, $stem) { - my ($repo, $stem) = @_; my $best; if (exists $repo->{$stem}) { @@ -155,9 +142,8 @@ sub find_best package OpenBSD::Library; our @ISA = qw(OpenBSD::LibObject); -sub from_string +sub from_string($class, $filename) { - my ($class, $filename) = @_; if (my ($dir, $stem, $major, $minor) = $filename =~ m/^(.*)\/lib([^\/]+)\.so\.(\d+)\.(\d+)$/o) { bless { dir => $dir, stem => $stem, major => $major, minor => $minor }, $class; @@ -166,34 +152,29 @@ sub from_string } } -sub to_string +sub to_string($self) { - my $self = shift; return "$self->{dir}/lib$self->{stem}.so.$self->{major}.$self->{minor}"; } -sub set_origin +sub set_origin($self, $origin) { - my ($self, $origin) = @_; $self->{origin} = $origin; return $self; } -sub origin +sub origin($self) { - my $self = shift; return $self->{origin}; } -sub no_match_dispatch +sub no_match_dispatch($library, $spec, $base) { - my ($library, $spec, $base) = @_; return $spec->no_match_shared($library, $base); } -sub is_better +sub is_better($self, $other) { - my ($self, $other) = @_; if ($other->is_static) { return 1; } @@ -209,9 +190,8 @@ sub is_better package OpenBSD::LibSpec; our @ISA = qw(OpenBSD::LibObject); -sub new +sub new($class, $dir, $stem, $major, $minor) { - my ($class, $dir, $stem, $major, $minor) = @_; bless { dir => $dir, stem => $stem, major => $major, minor => $minor @@ -220,16 +200,13 @@ sub new my $cached = {}; -sub from_string +sub from_string($class, $s) { - my ($class, $s) = @_; return $cached->{$s} //= $class->new_from_string($s); } -sub new_with_stem +sub new_with_stem($class, $stem, $major, $minor) { - my ($class, $stem, $major, $minor) = @_; - if ($stem =~ m/^(.*)\/([^\/]+)$/o) { return $class->new($1, $2, $major, $minor); } else { @@ -237,9 +214,8 @@ sub new_with_stem } } -sub new_from_string +sub new_from_string($class, $string) { - my ($class, $string) = @_; if (my ($stem, $major, $minor) = $string =~ m/^(.*)\.(\d+)\.(\d+)$/o) { return $class->new_with_stem($stem, $major, $minor); } else { @@ -247,17 +223,14 @@ sub new_from_string } } -sub to_string +sub to_string($self) { - my $self = shift; return join('.', $self->key, $self->major, $self->minor); } -sub lookup_stem +sub lookup_stem($spec, $repo) { - my ($spec, $repo) = @_; - my $result = $repo->{$spec->stem}; if (!defined $result) { return undef; @@ -266,16 +239,13 @@ sub lookup_stem } } -sub no_match_major +sub no_match_major($spec, $library) { - my ($spec, $library) = @_; return $spec->major != $library->major; } -sub no_match_name +sub no_match_name($spec, $library, $base) { - my ($spec, $library, $base) = @_; - if (defined $spec->{dir}) { if ("$base/$spec->{dir}" eq $library->{dir}) { return undef; @@ -290,10 +260,8 @@ sub no_match_name return "bad directory"; } -sub no_match_shared +sub no_match_shared($spec, $library, $base) { - my ($spec, $library, $base) = @_; - if ($spec->no_match_major($library)) { return "bad major"; } @@ -305,15 +273,13 @@ sub no_match_shared } # classic double dispatch pattern -sub no_match +sub no_match($spec, $library, $base) { - my ($spec, $library, $base) = @_; return $library->no_match_dispatch($spec, $base); } -sub match +sub match($spec, $library, $base) { - my ($spec, $library, $base) = @_; return !$spec->no_match($library, $base); } diff --git a/usr.sbin/pkg_add/OpenBSD/LibSpec/Build.pm b/usr.sbin/pkg_add/OpenBSD/LibSpec/Build.pm index 4dc3dbc7cc9..2d5e6022574 100644 --- a/usr.sbin/pkg_add/OpenBSD/LibSpec/Build.pm +++ b/usr.sbin/pkg_add/OpenBSD/LibSpec/Build.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Build.pm,v 1.7 2010/11/27 11:55:14 espie Exp $ +# $OpenBSD: Build.pm,v 1.8 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2010 Marc Espie # @@ -15,46 +15,41 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; # the specs used during build are slightly different from the specs at # runtime. package OpenBSD::Library::Static; our @ISA = qw(OpenBSD::Library); -sub new +sub new($class, $dir, $stem) { - my ($class, $dir, $stem) = @_; bless {dir => $dir, stem => $stem}, $class; } -sub no_match_dispatch +sub no_match_dispatch($library, $spec, $base) { - my ($library, $spec, $base) = @_; return $spec->no_match_static($library, $base); } -sub to_string +sub to_string($self) { - my $self = shift; return "$self->{dir}/lib$self->{stem}.a"; } -sub version { ".a" } +sub version($) { ".a" } -sub is_static { 1 } +sub is_static($) { 1 } -sub is_better { 0 } +sub is_better($, $) { 0 } package OpenBSD::Library::Build; our @ISA = qw(OpenBSD::Library); -sub static +sub static($) { 'OpenBSD::Library::Static'; } -sub from_string +sub from_string($class, $filename) { - my ($class, $filename) = @_; if (my ($dir, $stem) = $filename =~ m/^(.*)\/lib([^\/]+)\.a$/o) { return $class->static->new($dir, $stem); } else { @@ -63,14 +58,13 @@ sub from_string } package OpenBSD::LibSpec; -sub no_match_static +sub no_match_static # forwarder { &OpenBSD::LibSpec::no_match_name; } -sub findbest +sub findbest($spec, $repo, $base) { - my ($spec, $repo, $base) = @_; my $spec2 = OpenBSD::LibSpec::GT->new($spec->{dir}, $spec->{stem}, 0, 0); my $r = $spec2->lookup($repo, $base); @@ -93,15 +87,13 @@ sub findbest package OpenBSD::LibSpec::GT; our @ISA = qw(OpenBSD::LibSpec); -sub no_match_major +sub no_match_major($spec, $library) { - my ($spec, $library) = @_; return $spec->major > $library->major; } -sub to_string +sub to_string($self) { - my $self = shift; return $self->key.">=".$self->major.".".$self->minor; } @@ -110,10 +102,8 @@ sub to_string package OpenBSD::LibSpec::Build; our @ISA = qw(OpenBSD::LibSpec); -sub new_from_string +sub new_from_string($class, $string) { - my ($class, $string) = @_; - $string =~ s/\.$//; if (my ($stem, $strict, $major, $minor) = $string =~ m/^(.*?)(\>?)\=(\d+)\.(\d+)$/o) { return $class->new_object($stem, $strict, $major, $minor); @@ -124,9 +114,8 @@ sub new_from_string } } -sub new_object +sub new_object($class, $stem, $strict, $major, $minor) { - my ($class, $stem, $strict, $major, $minor) = @_; my $n = $strict eq '' ? "OpenBSD::LibSpec" : "OpenBSD::LibSpec::GT"; return $n->new_with_stem($stem, $major, $minor); } diff --git a/usr.sbin/pkg_add/OpenBSD/Log.pm b/usr.sbin/pkg_add/OpenBSD/Log.pm index 1610267d5f9..9eb45704eed 100644 --- a/usr.sbin/pkg_add/OpenBSD/Log.pm +++ b/usr.sbin/pkg_add/OpenBSD/Log.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Log.pm,v 1.9 2014/07/27 22:17:33 espie Exp $ +# $OpenBSD: Log.pm,v 1.10 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2010 Marc Espie # @@ -16,76 +16,65 @@ # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; package OpenBSD::Log; -sub new +sub new($class, $printer) { - my ($class, $printer) = @_; bless { p => $printer }, $class; } -sub set_context +sub set_context($self, $context) { - my ($self, $context) = @_; $self->{context} = $context; } -sub messages +sub messages($self) { - my $self = shift; $self->{context} //= "???"; return $self->{messages}{$self->{context}} //= []; } -sub errmessages +sub errmessages($self) { - my $self = shift; $self->{context} //= "???"; return $self->{errmessages}{$self->{context}} //= []; } -sub f +sub f($self, @p) { - my $self = shift; - $self->{p}->f(@_); + $self->{p}->f(@p); } -sub print +sub print($self, @p) { - my $self = shift; - push(@{$self->messages}, $self->f(@_)); + push(@{$self->messages}, $self->f(@p)); } -sub say +sub say($self, @p) { - my $self = shift; - push(@{$self->messages}, $self->f(@_)."\n"); + push(@{$self->messages}, $self->f(@p)."\n"); } -sub errprint +sub errprint($self, @p) { - my $self = shift; - push(@{$self->errmessages}, $self->f(@_)); + push(@{$self->errmessages}, $self->f(@p)); } -sub errsay +sub errsay($self, @p) { - my $self = shift; - push(@{$self->errmessages}, $self->f(@_)."\n"); + push(@{$self->errmessages}, $self->f(@p)."\n"); } -sub specialsort +sub specialsort(@p) { - return ((sort grep { /^\-/ } @_), (sort grep { /^\+/} @_), - (sort grep { !/^[\-+]/ } @_)); + return ((sort grep { /^\-/ } @p), (sort grep { /^\+/} @p), + (sort grep { !/^[\-+]/ } @p)); } -sub dump +sub dump($self) { - my $self = shift; for my $ctxt (specialsort keys %{$self->{errmessages}}) { my $msgs = $self->{errmessages}{$ctxt}; if (@$msgs > 0) { @@ -104,32 +93,30 @@ sub dump $self->{messages} = {}; } -sub fatal +sub fatal($self, @p) { - my $self = shift; if (defined $self->{context}) { - $self->{p}->_fatal($self->{context}, ":", $self->f(@_)); + $self->{p}->_fatal($self->{context}, ":", $self->f(@p)); } - $self->{p}->_fatal($self->f(@_)); + $self->{p}->_fatal($self->f(@p)); } -sub system +sub system($self, @p) { - my $self = shift; - if (open(my $grab, "-|", @_)) { + if (open(my $grab, "-|", @p)) { while (<$grab>) { $self->{p}->_print($_); } if (!close $grab) { $self->{p}->say("system(#1) failed: #2 #3", - join(", ", @_), $!, + join(", ", @p), $!, $self->{p}->child_error); } return $?; } else { $self->{p}->say("system(#1) was not run: #2 #3", - join(", ", @_), $!, $self->{p}->child_error); + join(", ", @p), $!, $self->{p}->child_error); } } diff --git a/usr.sbin/pkg_add/OpenBSD/Mtree.pm b/usr.sbin/pkg_add/OpenBSD/Mtree.pm index 552ff1adf70..e7913645651 100644 --- a/usr.sbin/pkg_add/OpenBSD/Mtree.pm +++ b/usr.sbin/pkg_add/OpenBSD/Mtree.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Mtree.pm,v 1.13 2014/03/18 18:53:29 espie Exp $ +# $OpenBSD: Mtree.pm,v 1.14 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2004-2005 Marc Espie # @@ -15,17 +15,15 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::Mtree; use File::Spec; # read an mtree file, and produce the corresponding directory hierarchy -sub parse_fh +sub parse_fh($mtree, $basedir, $fh, $h = undef) { - my ($mtree, $basedir, $fh, $h) = @_; while(<$fh>) { chomp; s/^\s*//o; @@ -50,9 +48,8 @@ sub parse_fh } } -sub parse +sub parse($mtree, $basedir, $filename, $h = undef) { - my ($mtree, $basedir, $filename, $h) = @_; open my $file, '<', $filename or die "can't open $filename: $!"; parse_fh($mtree, $basedir, $file, $h); close $file; diff --git a/usr.sbin/pkg_add/OpenBSD/OldLibs.pm b/usr.sbin/pkg_add/OpenBSD/OldLibs.pm index e4e214d1267..46e0c648c51 100644 --- a/usr.sbin/pkg_add/OpenBSD/OldLibs.pm +++ b/usr.sbin/pkg_add/OpenBSD/OldLibs.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: OldLibs.pm,v 1.16 2023/05/27 10:01:51 espie Exp $ +# $OpenBSD: OldLibs.pm,v 1.17 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2004-2010 Marc Espie # @@ -14,82 +14,77 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; package OpenBSD::PackingElement; # $self->mark_lib($libs, $libpatterns) # store libs into hashes -sub mark_lib +sub mark_lib($, $, $) { } -sub unmark_lib +sub unmark_lib($, $, $) { } # $self->separate_element($libs, $c1, $c2) # based on libs hash, do we sort it into clone 1 or clone 2 -sub separate_element +sub separate_element($self, $, $, $c2) { - my ($self, $libs, $c1, $c2) = @_; $c2->{$self} = 1; } -sub special_deep_copy +sub special_deep_copy($self, $copy, $h, $) { - my ($self, $copy, $h) = @_; $self->clone->add_object($copy) if defined $h->{$self}; } package OpenBSD::PackingElement::Meta; # so every meta element ends up in both -sub separate_element +sub separate_element($self, $, $c1, $c2) { - my ($self, $libs, $c1, $c2) = @_; $c1->{$self} = 1; $c2->{$self} = 1; } package OpenBSD::PackingElement::DigitalSignature; -sub separate_element + +sub separate_element($self, $, $, $c2) { - my ($self, $libs, $c1, $c2) = @_; $c2->{$self} = 1; } package OpenBSD::PackingElement::State; -sub separate_element +sub separate_element # forwarder { &OpenBSD::PackingElement::Meta::separate_element; } package OpenBSD::PackingElement::Depend; -sub separate_element +sub separate_element # forwarder { &OpenBSD::PackingElement::separate_element; } package OpenBSD::PackingElement::SpecialFile; -sub separate_element +sub separate_element # forwarder { &OpenBSD::PackingElement::separate_element; } package OpenBSD::PackingElement::FCONTENTS; -sub special_deep_copy +sub special_deep_copy($, $, $, $) { } package OpenBSD::PackingElement::Lib; use File::Basename; -sub mark_lib +sub mark_lib($self, $libs, $libpatterns) { - my ($self, $libs, $libpatterns) = @_; my $libname = $self->fullname; my ($stem, $major, $minor, $dir) = $self->parse($libname); if (defined $stem) { @@ -98,9 +93,8 @@ sub mark_lib $libs->{$libname} = 1; } -sub separate_element +sub separate_element($self, $libs, $c1, $c2) { - my ($self, $libs, $c1, $c2) = @_; if ($libs->{$self->fullname}) { $c1->{$self} = 1; } else { @@ -108,9 +102,8 @@ sub separate_element } } -sub unmark_lib +sub unmark_lib($self, $libs, $libpatterns) { - my ($self, $libs, $libpatterns) = @_; my $libname = $self->fullname; my ($stem, $major, $minor, $dir) = $self->parse($libname); if (defined $stem) { @@ -123,9 +116,8 @@ sub unmark_lib delete $libs->{$libname}; } -sub enforce_dir +sub enforce_dir($self, $path, $copy, $dirs) { - my ($self, $path, $copy, $dirs) = @_; my $d = dirname($path); my $localbase = $copy->localbase; @@ -142,9 +134,8 @@ sub enforce_dir OpenBSD::PackingElement::Dir->add($copy, $d); } -sub special_deep_copy +sub special_deep_copy($self, $copy, $h, $dirs) { - my ($self, $copy, $h, $dirs) = @_; $self->enforce_dir($self->fullname, $copy, $dirs); $self->SUPER::special_deep_copy($copy, $h, $dirs); } @@ -153,9 +144,8 @@ package OpenBSD::OldLibs; use OpenBSD::RequiredBy; use OpenBSD::PackageInfo; -sub split_some_libs +sub split_some_libs($plist, $libs) { - my ($plist, $libs) = @_; my $c1 = {}; my $c2 = {}; $plist->separate_element($libs, $c1, $c2); @@ -167,10 +157,8 @@ sub split_some_libs } # create a packing-list with only the libraries we want to keep around. -sub split_libs +sub split_libs($plist, $to_split) { - my ($plist, $to_split) = @_; - (my $splitted, $plist) = split_some_libs($plist, $to_split); require OpenBSD::PackageInfo; @@ -187,10 +175,8 @@ sub split_libs return ($plist, $splitted); } -sub adjust_depends_closure +sub adjust_depends_closure($oldname, $plist, $state) { - my ($oldname, $plist, $state) = @_; - $state->say(" Packages that depend on those shared libraries:") if $state->verbose >= 3; @@ -205,10 +191,8 @@ sub adjust_depends_closure } } -sub do_save_libs +sub do_save_libs($o, $libs, $state) { - my ($o, $libs, $state) = @_; - my $oldname = $o->pkgname; ($o->{plist}, my $stub_list) = split_libs($o->plist, $libs); @@ -241,10 +225,8 @@ sub do_save_libs adjust_depends_closure($oldname, $stub_list, $state); } -sub save_libs_from_handle +sub save_libs_from_handle($o, $set, $state) { - my ($o, $set, $state) = @_; - my $libs = {}; my $p = {}; @@ -267,10 +249,8 @@ sub save_libs_from_handle } } -sub save +sub save($self, $set, $state) { - my ($self, $set, $state) = @_; - for my $o ($set->older) { save_libs_from_handle($o, $set, $state); } diff --git a/usr.sbin/pkg_add/OpenBSD/PackageInfo.pm b/usr.sbin/pkg_add/OpenBSD/PackageInfo.pm index 979b0f4f9af..37ff4336b32 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageInfo.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageInfo.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageInfo.pm,v 1.64 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: PackageInfo.pm,v 1.65 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackageInfo; require Exporter; @@ -50,7 +49,7 @@ for my $i (@info) { $info{$i} = $j; } -sub _init_list +sub _init_list() { $list = {}; $stemlist = OpenBSD::PackageName::compile_stemlist(); @@ -63,30 +62,30 @@ sub _init_list closedir($dir); } -sub add_installed +sub add_installed(@p) { if (!defined $list) { _init_list(); } - for my $p (@_) { + for my $p (@p) { $list->{$p} = 1; $stemlist->add($p); } } -sub delete_installed +sub delete_installed(@p) { if (!defined $list) { _init_list(); } - for my $p (@_) { + for my $p (@p) { delete $list->{$p}; $stemlist->delete($p); } } -sub installed_stems +sub installed_stems() { if (!defined $list) { _init_list(); @@ -94,22 +93,20 @@ sub installed_stems return $stemlist; } -sub installed_packages +sub installed_packages($all = 0) { if (!defined $list) { _init_list(); } - if ($_[0]) { + if ($all) { return grep { !/^\./o } keys %$list; } else { return keys %$list; } } -sub installed_info +sub installed_info($name) { - my $name = shift; - # XXX remove the o if we allow pkg_db to change dynamically if ($name =~ m|^\Q$pkg_db\E/?|o) { return "$name/"; @@ -118,15 +115,13 @@ sub installed_info } } -sub installed_contents +sub installed_contents($name) { - my $name = shift; return installed_info($name).CONTENTS; } -sub borked_package +sub borked_package($pkgname) { - my $pkgname = shift; $pkgname = "partial-$pkgname" unless $pkgname =~ m/^partial\-/; unless (-e "$pkg_db/$pkgname") { return $pkgname; @@ -139,9 +134,8 @@ sub borked_package return "$pkgname.$i"; } -sub libs_package +sub libs_package($pkgname) { - my $pkgname = shift; $pkgname =~ s/^\.libs\d*\-//; unless (-e "$pkg_db/.libs-$pkgname") { return ".libs-$pkgname"; @@ -154,19 +148,19 @@ sub libs_package return ".libs$i-$pkgname"; } -sub is_installed +sub is_installed($p) { - my $name = installed_name(shift); + my $name = installed_name($p); if (!defined $list) { installed_packages(); } return defined $list->{$name}; } -sub installed_name +sub installed_name($p) { require File::Spec; - my $name = File::Spec->canonpath(shift); + my $name = File::Spec->canonpath($p); $name =~ s|/$||o; # XXX remove the o if we allow pkg_db to change dynamically $name =~ s|^\Q$pkg_db\E/?||o; @@ -174,22 +168,20 @@ sub installed_name return $name; } -sub info_names +sub info_names() { return @info; } -sub is_info_name +sub is_info_name($name) { - my $name = shift; return $info{$name}; } my $dlock; -sub lock_db +sub lock_db($shared = 0, $state = undef) { - my ($shared, $state) = @_; my $mode = $shared ? LOCK_SH : LOCK_EX; open($dlock, '<', $pkg_db) or return; if (flock($dlock, $mode | LOCK_NB)) { @@ -206,7 +198,7 @@ sub lock_db return; } -sub unlock_db +sub unlock_db() { if (defined $dlock) { flock($dlock, LOCK_UN); diff --git a/usr.sbin/pkg_add/OpenBSD/PackageLocation.pm b/usr.sbin/pkg_add/OpenBSD/PackageLocation.pm index 63a6cd11baa..69b396d50a0 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageLocation.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageLocation.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageLocation.pm,v 1.60 2022/05/08 13:31:40 espie Exp $ +# $OpenBSD: PackageLocation.pm,v 1.61 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2007 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackageLocation; @@ -25,44 +24,37 @@ use OpenBSD::Temp; use OpenBSD::Error; use OpenBSD::Paths; -sub new +sub new($class, $repository, $name) { - my ($class, $repository, $name) = @_; - - my $self = { repository => $repository, name => $repository->canonicalize($name) }; - bless $self, $class; - return $self; + return bless { + repository => $repository, + name => $repository->canonicalize($name) + }, $class; } -sub decorate +sub decorate($self, $plist) { - my ($self, $plist) = @_; $self->{repository}->decorate($plist, $self); } -sub url +sub url($self) { - my $self = shift; - return $self->{repository}->url($self->name); } -sub name +sub name($self) { - my $self = shift; return $self->{name}; } OpenBSD::Auto::cache(pkgname, - sub { - my $self = shift; + sub($self) { return OpenBSD::PackageName->from_string($self->name); }); OpenBSD::Auto::cache(update_info, - sub { - my $self = shift; + sub($self) { my $name = $self->name; if ($name =~ /^quirks\-/) { return $self->plist; @@ -91,10 +83,8 @@ OpenBSD::Auto::cache(update_info, }); # make sure self is opened and move to the right location if need be. -sub _opened +sub _opened($self) { - my $self = shift; - if (defined $self->{fh}) { return $self; } @@ -122,18 +112,15 @@ sub _opened return $self; } -sub _set_callback +sub _set_callback($self) { - my $self = shift; if (defined $self->{callback} && defined $self->{_archive}) { $self->{_archive}->set_callback($self->{callback}); } } -sub find_contents +sub find_contents($self) { - my $self = shift; - while (my $e = $self->next) { if ($e->isFile && is_info_name($e->{name})) { if ($e->{name} eq CONTENTS ) { @@ -147,9 +134,8 @@ sub find_contents } } -sub contents +sub contents($self) { - my $self = shift; if (!defined $self->{contents}) { if (!$self->_opened) { return; @@ -160,9 +146,8 @@ sub contents return $self->{contents}; } -sub grab_info +sub grab_info($self) { - my $self = shift; my $dir = $self->{dir} = OpenBSD::Temp->dir; if (!defined $dir) { $self->{repository}{state}->fatal(OpenBSD::Temp->last_error); @@ -200,10 +185,8 @@ sub grab_info return 1; } -sub grabPlist +sub grabPlist($self, $code = \&OpenBSD::PackingList::defaultCode) { - my ($self, $code) = @_; - my $plist = $self->plist($code); if (defined $plist) { $self->wipe_info; @@ -214,16 +197,14 @@ sub grabPlist } } -sub forget +sub forget($self) { - my $self = shift; $self->wipe_info; $self->close_now; } -sub wipe_info +sub wipe_info($self) { - my $self = shift; $self->{repository}->wipe_info($self); $self->{repository}->close_now($self); delete $self->{contents}; @@ -233,19 +214,16 @@ sub wipe_info delete $self->{_unput}; } -sub info +sub info($self) { - my $self = shift; - if (!defined $self->{dir}) { $self->grab_info; } return $self->{dir}; } -sub plist +sub plist($self, $code = \&OpenBSD::PackingList::defaultCode) { - my ($self, $code) = @_; require OpenBSD::PackingList; if (defined $self->{dir} && -f $self->{dir}.CONTENTS) { @@ -264,39 +242,33 @@ sub plist return; } -sub close +sub close($self, $hint = 0) { - my ($self, $hint) = @_; $self->{repository}->close($self, $hint); } -sub finish_and_close +sub finish_and_close($self) { - my $self = shift; $self->{repository}->finish_and_close($self); } -sub close_now +sub close_now($self) { - my $self = shift; $self->{repository}->close_now($self); } -sub close_after_error +sub close_after_error($self) { - my $self = shift; $self->{repository}->close_after_error($self); } -sub close_with_client_error +sub close_with_client_error($self) { - my $self = shift; $self->{repository}->close_with_client_error($self); } -sub deref +sub deref($self) { - my $self = shift; delete $self->{fh}; delete $self->{pid2}; delete $self->{_archive}; @@ -304,10 +276,8 @@ sub deref } # proxy for archive operations -sub next +sub next($self) { - my $self = shift; - if (!$self->_opened) { return; } @@ -324,28 +294,23 @@ sub next return $self->{_current}; } -sub unput +sub unput($self) { - my $self = shift; $self->{_unput} = 1; } -sub getNext +sub getNext($self) { - my $self = shift; - return $self->{_archive}->next; } -sub skip +sub skip($self) { - my $self = shift; return $self->{_archive}->skip; } -sub set_callback +sub set_callback($self, $code) { - my ($self, $code) = @_; $self->{callback} = $code; $self->_set_callback; } @@ -354,16 +319,14 @@ package OpenBSD::PackageLocation::Installed; our @ISA = qw(OpenBSD::PackageLocation); -sub info +sub info($self) { - my $self = shift; require OpenBSD::PackageInfo; $self->{dir} = OpenBSD::PackageInfo::installed_info($self->name); } -sub plist +sub plist($self, $code = \&OpenBSD::PackingList::defaultCode) { - my ($self, $code) = @_; require OpenBSD::PackingList; return OpenBSD::PackingList->from_installation($self->name, $code); } diff --git a/usr.sbin/pkg_add/OpenBSD/PackageLocator.pm b/usr.sbin/pkg_add/OpenBSD/PackageLocator.pm index 977de465082..e9d34fe4a7c 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageLocator.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageLocator.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageLocator.pm,v 1.110 2017/05/29 12:28:54 espie Exp $ +# $OpenBSD: PackageLocator.pm,v 1.111 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2010 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackageLocator; @@ -25,9 +24,8 @@ use OpenBSD::PackageRepository; my $default_path; -sub add_default +sub add_default($self, $state, $p) { - my ($self, $state, $p) = @_; my $w; if (defined $ENV{TRUSTED_PKG_PATH}) { @@ -53,33 +51,29 @@ sub add_default } } -sub build_default_path +sub build_default_path($self, $state) { - my ($self, $state) = @_; $default_path = OpenBSD::PackageRepositoryList->new($state); $self->add_default($state, $default_path); } -sub default_path +sub default_path($self,$state) { - my ($self, $state) = @_; if (!defined $default_path) { $self->build_default_path($state); } return $default_path; } -sub printable_default_path +sub printable_default_path($self, $state) { - my ($self, $state) = @_; - return join(':', $self->default_path($state)->do_something('url')); } -sub path_parse +sub path_parse($self, $pkgname, $state) { - my ($self, $pkgname, $state, $path) = (@_, './'); + my $path = './'; if ($pkgname =~ m/^(.*[\/\:])(.*)/) { ($pkgname, $path) = ($2, $1); } @@ -87,10 +81,8 @@ sub path_parse return (OpenBSD::PackageRepository->new($path, $state), $pkgname); } -sub find +sub find($self, $url, $state) { - my ($self, $url, $state) = @_; - my $package; if ($url =~ m/[\/\:]/o) { my ($repository, $pkgname) = $self->path_parse($url, $state); @@ -104,10 +96,8 @@ sub find return $package; } -sub grabPlist +sub grabPlist($self, $url, $code, $state) { - my ($self, $url, $code, $state) = @_; - my $plist; if ($url =~ m/[\/\:]/o) { my ($repository, $pkgname) = $self->path_parse($url, $state); @@ -121,9 +111,8 @@ sub grabPlist return $plist; } -sub match_locations +sub match_locations($self, @search) { - my ($self, @search) = @_; my $state = pop @search; return $self->default_path($state)->match_locations(@search); } diff --git a/usr.sbin/pkg_add/OpenBSD/PackageName.pm b/usr.sbin/pkg_add/OpenBSD/PackageName.pm index 4cbe0b6bf9d..f107a2c64ea 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageName.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageName.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageName.pm,v 1.57 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: PackageName.pm,v 1.58 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2010 Marc Espie # @@ -15,14 +15,12 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackageName; -sub url2pkgname +sub url2pkgname($name) { - my $name = $_[0]; $name =~ s|.*/||; $name =~ s|\.tgz$||; @@ -30,9 +28,8 @@ sub url2pkgname } # see packages-specs(7) -sub splitname +sub splitname($n) { - my $n = shift; if ($n =~ /^(.*?)\-(\d.*)$/o) { my $stem = $1; my $rest = $2; @@ -45,15 +42,13 @@ sub splitname my $cached = {}; -sub from_string +sub from_string($class, $s) { - my ($class, $s) = @_; return $cached->{$s} //= $class->new_from_string($s); } -sub new_from_string +sub new_from_string($class, $n) { - my ($class, $n) = @_; if ($n =~ /^(.*?)\-(\d.*)$/o) { my $stem = $1; my $rest = $2; @@ -71,9 +66,8 @@ sub new_from_string } } -sub splitstem +sub splitstem($s) { - my $s = shift; if ($s =~ /^(.*?)\-\d/o) { return $1; } else { @@ -81,16 +75,15 @@ sub splitstem } } -sub pkg2stem +sub pkg2stem($pkg) { - my $s = splitstem(shift); + my $s = splitstem($pkg); $s =~ tr/A-Z/a-z/; return $s; } -sub is_stem +sub is_stem($s) { - my $s = shift; if ($s =~ m/\-\d/o || $s eq '-') { return 0; } else { @@ -98,39 +91,35 @@ sub is_stem } } -sub compile_stemlist +sub compile_stemlist(@p) { my $hash = {}; - for my $n (@_) { + for my $n (@p) { $hash->{pkg2stem($n)}{$n} = 1; } bless $hash, "OpenBSD::PackageLocator::_compiled_stemlist"; } -sub avail2stems +sub avail2stems(@p) { - my @avail = @_; - return compile_stemlist(@avail); + return compile_stemlist(@p); } package OpenBSD::PackageLocator::_compiled_stemlist; -sub find +sub find($self, $stem) { - my ($self, $stem) = @_; $stem =~ tr/A-Z/a-z/; return keys %{$self->{$stem}}; } -sub add +sub add($self, $pkgname) { - my ($self, $pkgname) = @_; $self->{OpenBSD::PackageName::pkg2stem($pkgname)}{$pkgname} = 1; } -sub delete +sub delete($self, $pkgname) { - my ($self, $pkgname) = @_; my $stem = OpenBSD::PackageName::pkg2stem($pkgname); delete $self->{$stem}{$pkgname}; if(keys %{$self->{$stem}} == 0) { @@ -138,9 +127,8 @@ sub delete } } -sub find_partial +sub find_partial($self, $partial) { - my ($self, $partial) = @_; my @result = (); while (my ($stem, $pkgs) = each %$self) { next unless $stem =~ /\Q$partial\E/i; @@ -153,9 +141,8 @@ package OpenBSD::PackageName::dewey; my $cache = {}; -sub from_string +sub from_string($class, $string) { - my ($class, $string) = @_; my $o = bless { deweys => [ split(/\./o, $string) ], suffix => '', suffix_value => 0}, $class; if ($o->{deweys}->[-1] =~ m/^(\d+)(rc|alpha|beta|pre|pl)(\d*)$/) { @@ -166,15 +153,13 @@ sub from_string return $o; } -sub make +sub make($class, $string) { - my ($class, $string) = @_; return $cache->{$string} //= $class->from_string($string); } -sub to_string +sub to_string($self) { - my $self = shift; my $r = join('.', @{$self->{deweys}}); if ($self->{suffix}) { $r .= $self->{suffix} . $self->{suffix_value}; @@ -182,9 +167,8 @@ sub to_string return $r; } -sub suffix_compare +sub suffix_compare($a, $b) { - my ($a, $b) = @_; if ($a->{suffix} eq $b->{suffix}) { return $a->{suffix_value} <=> $b->{suffix_value}; } @@ -213,9 +197,8 @@ sub suffix_compare return 0; } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; # Try a diff in dewey numbers first for (my $i = 0; ; $i++) { if (!defined $a->{deweys}->[$i]) { @@ -235,9 +218,8 @@ sub compare return suffix_compare($a, $b); } -sub dewey_compare +sub dewey_compare($a, $b) { - my ($a, $b) = @_; # numerical comparison if ($a =~ m/^\d+$/o and $b =~ m/^\d+$/o) { return $a <=> $b; @@ -256,23 +238,18 @@ sub dewey_compare package OpenBSD::PackageName::version; -sub p +sub p($self) { - my $self = shift; - return defined $self->{p} ? $self->{p} : -1; } -sub v +sub v($self) { - my $self = shift; - return defined $self->{v} ? $self->{v} : -1; } -sub from_string +sub from_string($class, $string) { - my ($class, $string) = @_; my $o = bless {}, $class; if ($string =~ m/^(.*)v(\d+)$/o) { $o->{v} = $2; @@ -287,9 +264,8 @@ sub from_string return $o; } -sub to_string +sub to_string($o) { - my $o = shift; my $string = $o->{dewey}->to_string; if (defined $o->{p}) { $string .= 'p'.$o->{p}; @@ -300,15 +276,13 @@ sub to_string return $string; } -sub pnum_compare +sub pnum_compare($a, $b) { - my ($a, $b) = @_; return $a->p <=> $b->p; } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; # Simple case: epoch number if ($a->v != $b->v) { return $a->v <=> $b->v; @@ -321,9 +295,8 @@ sub compare return $a->{dewey}->compare($b->{dewey}); } -sub has_issues +sub has_issues($self) { - my $self = shift; if ($self->{dewey}{deweys}[-1] =~ m/v\d+$/ && defined $self->{p}) { return ("correct order is pNvM"); } else { @@ -332,56 +305,48 @@ sub has_issues } package OpenBSD::PackageName::Stem; -sub to_string +sub to_string($o) { - my $o = shift; return $o->{stem}; } -sub to_pattern +sub to_pattern($o) { - my $o = shift; return $o->{stem}.'-*'; } -sub has_issues +sub has_issues($self) { - my $self = shift; return ("is a stem"); } package OpenBSD::PackageName::Name; -sub flavor_string +sub flavor_string($o) { - my $o = shift; return join('-', sort keys %{$o->{flavors}}); } -sub to_string +sub to_string($o) { - my $o = shift; return join('-', $o->{stem}, $o->{version}->to_string, sort keys %{$o->{flavors}}); } -sub to_pattern +sub to_pattern($o) { - my $o = shift; return join('-', $o->{stem}, '*', $o->flavor_string); } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; if ($a->{stem} ne $b->{stem} || $a->flavor_string ne $b->flavor_string) { return undef; } return $a->{version}->compare($b->{version}); } -sub has_issues +sub has_issues($self) { - my $self = shift; return ((map {"flavor $_ can't start with digit"} grep { /^\d/ } keys %{$self->{flavors}}), $self->{version}->has_issues); diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepository.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepository.pm index 405d6abcb41..f54409b69af 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepository.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepository.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageRepository.pm,v 1.175 2023/05/27 10:02:38 espie Exp $ +# $OpenBSD: PackageRepository.pm,v 1.176 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2010 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; # XXX load extra class, grab match from Base class, and tweak inheritance # to get all methods. @@ -32,25 +31,21 @@ use OpenBSD::Paths; use OpenBSD::Error; use OpenBSD::Temp; -sub make_error_file +sub make_error_file($self, $object) { - my ($self, $object) = @_; $object->{errors} = OpenBSD::Temp->file; if (!defined $object->{errors}) { $self->{state}->fatal(OpenBSD::Temp->last_error); } } -sub baseurl +sub baseurl($self) { - my $self = shift; - return $self->{path}; } -sub new +sub new($class, $baseurl, $state) { - my ($class, $baseurl, $state) = @_; if (!defined $state) { require Carp; Carp::croak "fatal: old api call to $class: needs state"; @@ -62,18 +57,16 @@ sub new return $o; } -sub can_be_empty +sub can_be_empty($self) { - my $self = shift; $self->{empty_okay} = 1; return $self; } my $cache = {}; -sub unique +sub unique($class, $o) { - my ($class, $o) = @_; return $o unless defined $o; if (defined $cache->{$o->url}) { return $cache->{$o->url}; @@ -83,35 +76,31 @@ sub unique } OpenBSD::Handler->atend( - sub { + sub($) { for my $repo (values %$cache) { $repo->cleanup; } }); -sub parse_fullurl +sub parse_fullurl($class, $r, $state) { - my ($class, $r, $state) = @_; - $class->strip_urlscheme($r) or return undef; return $class->unique($class->parse_url($r, $state)); } -sub dont_cleanup +sub dont_cleanup($) { } -sub ftp { 'OpenBSD::PackageRepository::FTP' } -sub http { 'OpenBSD::PackageRepository::HTTP' } -sub https { 'OpenBSD::PackageRepository::HTTPS' } -sub scp { 'OpenBSD::PackageRepository::SCP' } -sub file { 'OpenBSD::PackageRepository::Local' } -sub installed { 'OpenBSD::PackageRepository::Installed' } +sub ftp($) { 'OpenBSD::PackageRepository::FTP' } +sub http($) { 'OpenBSD::PackageRepository::HTTP' } +sub https($) { 'OpenBSD::PackageRepository::HTTPS' } +sub scp($) { 'OpenBSD::PackageRepository::SCP' } +sub file($) { 'OpenBSD::PackageRepository::Local' } +sub installed($) { 'OpenBSD::PackageRepository::Installed' } -sub parse +sub parse($class, $r, $state) { - my ($class, $r, $state) = @_; - { no warnings qw(uninitialized); # in case installpath is empty $$r =~ s/^installpath(\:|$)/$state->installpath.$1/e; @@ -150,16 +139,13 @@ sub parse } } -sub available +sub available($self) { - my $self = shift; - return @{$self->list}; } -sub stemlist +sub stemlist($self) { - my $self = shift; if (!defined $self->{stemlist}) { require OpenBSD::PackageName; my @l = $self->available; @@ -172,10 +158,8 @@ sub stemlist return $self->{stemlist}; } -sub wipe_info +sub wipe_info($self, $pkg) { - my ($self, $pkg) = @_; - require File::Path; my $dir = $pkg->{dir}; @@ -187,23 +171,23 @@ sub wipe_info } # by default, all objects may exist -sub may_exist +# $repo->may_exist($name) +sub may_exist($, $) { return 1; } # by default, we don't track opened files for this key -sub opened +sub opened($) { undef; } # hint: 0 premature close, 1 real error. undef, normal ! -sub close +sub close($self, $object, $hint = undef) { - my ($self, $object, $hint) = @_; close($object->{fh}) if defined $object->{fh}; if (defined $object->{pid2}) { local $SIG{ALRM} = sub { @@ -219,10 +203,8 @@ sub close $object->deref; } -sub make_room +sub make_room($self) { - my $self = shift; - # kill old files if too many my $already = $self->opened; if (defined $already) { @@ -239,10 +221,8 @@ sub make_room } # open method that tracks opened files per-host. -sub open +sub open($self, $object) { - my ($self, $object) = @_; - return unless $self->may_exist($object->{name}); # kill old files if too many @@ -259,9 +239,8 @@ sub open return $fh; } -sub find +sub find($repository, $name) { - my ($repository, $name) = @_; my $self = $repository->new_location($name); if ($self->contents) { @@ -270,17 +249,15 @@ sub find return undef; } -sub grabPlist +sub grabPlist($repository, $name, @code) { - my ($repository, $name, @code) = @_; my $self = $repository->new_location($name); return $self->grabPlist(@code); } -sub parse_problems +sub parse_problems($self, $filename, $hint = 0, $object = undef) { - my ($self, $filename, $hint, $object) = @_; CORE::open(my $fh, '<', $filename) or return; my $baseurl = $self->url; my $objecturl = $baseurl; @@ -387,14 +364,13 @@ sub parse_problems unlink $filename; } -sub cleanup +sub cleanup($) { # nothing to do } -sub relative_url +sub relative_url($self, $name = undef) { - my ($self, $name) = @_; if (defined $name) { return $self->baseurl.$name.".tgz"; } else { @@ -402,17 +378,15 @@ sub relative_url } } -sub add_to_list +sub add_to_list($self, $list, $filename) { - my ($self, $list, $filename) = @_; if ($filename =~ m/^(.*\-\d.*)\.tgz$/o) { push(@$list, $1); } } -sub did_it_fork +sub did_it_fork($self, $pid) { - my ($self, $pid) = @_; if (!defined $pid) { $self->{state}->fatal("Cannot fork: #1", $!); } @@ -423,12 +397,10 @@ sub did_it_fork } } -sub uncompress +sub uncompress($self, $object, @p) { - my $self = shift; - my $object = shift; require IO::Uncompress::Gunzip; - my $fh = IO::Uncompress::Gunzip->new(@_, MultiStream => 1); + my $fh = IO::Uncompress::Gunzip->new(@p, MultiStream => 1); my $result = ""; if ($object->{is_signed}) { my $h = $fh->getHeaderInfo; @@ -448,22 +420,19 @@ sub uncompress return $fh; } -sub signify_pipe +sub signify_pipe($self, $object, @p) { - my $self = shift; - my $object = shift; CORE::open STDERR, ">>", $object->{errors}; exec {OpenBSD::Paths->signify} ("signify", "-zV", - @_) + @p) or $self->{state}->fatal("Can't run #1: #2", OpenBSD::Paths->signify, $!); } -sub check_signed +sub check_signed($self, $object) { - my ($self, $object) = @_; if ($object->{repository}{trusted}) { return 0; } @@ -479,19 +448,19 @@ package OpenBSD::PackageRepository::Local; our @ISA=qw(OpenBSD::PackageRepository); use OpenBSD::Error; -sub is_local_file +sub is_local_file($) { return 1; } -sub urlscheme +sub urlscheme($) { return 'file'; } my $pkg_db; -sub pkg_db +sub pkg_db($) { if (!defined $pkg_db) { use OpenBSD::Paths; @@ -500,10 +469,8 @@ sub pkg_db return $pkg_db; } -sub parse_fullurl +sub parse_fullurl($class, $r, $state) { - my ($class, $r, $state) = @_; - my $ok = $class->strip_urlscheme($r); my $o = $class->parse_url($r, $state); if (!$ok && $o->{path} eq $class->pkg_db."/") { @@ -517,9 +484,8 @@ sub parse_fullurl } # wrapper around copy, that sometimes does not copy -sub may_copy +sub may_copy($self, $object, $destdir) { - my ($self, $object, $destdir) = @_; my $src = $self->relative_url($object->{name}); require File::Spec; my (undef, undef, $base) = File::Spec->splitpath($src); @@ -537,9 +503,8 @@ sub may_copy $self->{state}->copy_file($src, $destdir); } -sub open_pipe +sub open_pipe($self, $object) { - my ($self, $object) = @_; if (defined $self->{state}->cache_directory) { $self->may_copy($object, $self->{state}->cache_directory); } @@ -559,27 +524,25 @@ sub open_pipe } } -sub may_exist +sub may_exist($self, $name) { - my ($self, $name) = @_; return -r $self->relative_url($name); } my $local = []; -sub opened +sub opened($) { return $local; } -sub maxcount +sub maxcount($) { return 3; } -sub list +sub list($self) { - my $self = shift; my $l = []; my $dname = $self->baseurl; opendir(my $dir, $dname) or return $l; @@ -594,21 +557,18 @@ sub list package OpenBSD::PackageRepository::Distant; our @ISA=qw(OpenBSD::PackageRepository); -sub baseurl +sub baseurl($self) { - my $self = shift; - return "//$self->{host}$self->{path}"; } -sub setup_session +sub setup_session($) { # nothing to do except for https } -sub parse_url +sub parse_url($class, $r, $state) { - my ($class, $r, $state) = @_; # same heuristics as ftp(1): # find host part, rest is parsed as a local url if (my ($host, $path) = $$r =~ m/^\/\/(.*?)(\/.*)$/) { @@ -629,10 +589,8 @@ sub parse_url my $buffsize = 2 * 1024 * 1024; -sub pkg_copy +sub pkg_copy($self, $in, $object) { - my ($self, $in, $object) = @_; - my $name = $object->{name}; my $dir = $object->{cache_dir}; @@ -688,9 +646,8 @@ sub pkg_copy close($in); } -sub open_pipe +sub open_pipe($self, $object) { - my ($self, $object) = @_; $self->make_error_file($object); my $d = $self->{state}->cache_directory; if (defined $d) { @@ -749,9 +706,8 @@ sub open_pipe } } -sub finish_and_close +sub finish_and_close($self, $object) { - my ($self, $object) = @_; if (defined $object->{cache_dir}) { while (defined $object->next) { } @@ -766,9 +722,8 @@ our %distant = (); my ($fetch_uid, $fetch_gid, $fetch_user); -sub fill_up_fetch_data +sub fill_up_fetch_data($self) { - my $self = shift; if ($< == 0) { $fetch_user = '_pkgfetch'; unless ((undef, undef, $fetch_uid, $fetch_gid) = @@ -782,24 +737,21 @@ sub fill_up_fetch_data } } -sub fetch_id +sub fetch_id($self) { - my $self = shift; if (!defined $fetch_user) { $self->fill_up_fetch_data; } return ($fetch_uid, $fetch_gid, $fetch_user); } -sub ftp_cmd +sub ftp_cmd($self) { - my $self = shift; return OpenBSD::Paths->ftp; } -sub drop_privileges_and_setup_env +sub drop_privileges_and_setup_env($self) { - my $self = shift; my ($uid, $gid, $user) = $self->fetch_id; if (defined $uid) { # we happen right before exec, so change id permanently @@ -841,9 +793,8 @@ sub drop_privileges_and_setup_env } -sub grab_object +sub grab_object($self, $object) { - my ($self, $object) = @_; my ($ftp, @extra) = split(/\s+/, $self->ftp_cmd); $self->drop_privileges_and_setup_env; exec {$ftp} @@ -854,9 +805,8 @@ sub grab_object or $self->{state}->fatal("Can't run #1: #2", $self->ftp_cmd, $!); } -sub open_read_ftp +sub open_read_ftp($self, $cmd, $errors = undef) { - my ($self, $cmd, $errors) = @_; my $child_pid = open(my $fh, '-|'); if ($child_pid) { $self->{pipe_pid} = $child_pid; @@ -870,21 +820,19 @@ sub open_read_ftp } } -sub close_read_ftp +sub close_read_ftp($self, $fh) { - my ($self, $fh) = @_; close($fh); waitpid $self->{pipe_pid}, 0; } -sub maxcount +sub maxcount($) { return 1; } -sub opened +sub opened($self) { - my $self = $_[0]; my $k = $self->{host}; if (!defined $distant{$k}) { $distant{$k} = []; @@ -892,9 +840,8 @@ sub opened return $distant{$k}; } -sub should_have +sub should_have($self, $pkgname) { - my ($self, $pkgname) = @_; if (defined $self->{lasterror} && $self->{lasterror} == 421) { return (defined $self->{list}) && grep { $_ eq $pkgname } @{$self->{list}}; @@ -903,13 +850,11 @@ sub should_have } } -sub try_until_success +sub try_until_success($self, $pkgname, $code) { - my ($self, $pkgname, $code) = @_; - for (my $retry = 5; $retry <= 160; $retry *= 2) { undef $self->{lasterror}; - my $o = &$code; + my $o = &$code(); if (defined $o) { return $o; } @@ -926,28 +871,23 @@ sub try_until_success return undef; } -sub find +sub find($self, $pkgname, @extra) { - my ($self, $pkgname, @extra) = @_; - return $self->try_until_success($pkgname, - sub { + sub() { return $self->SUPER::find($pkgname, @extra); }); } -sub grabPlist +sub grabPlist($self, $pkgname, @extra) { - my ($self, $pkgname, @extra) = @_; - return $self->try_until_success($pkgname, - sub { + sub() { return $self->SUPER::grabPlist($pkgname, @extra); }); } -sub list +sub list($self) { - my ($self) = @_; if (!defined $self->{list}) { $self->make_room; my $error = OpenBSD::Temp->file; @@ -960,10 +900,8 @@ sub list return $self->{list}; } -sub get_http_list +sub get_http_list($self, $error) { - my ($self, $error) = @_; - my $fullname = $self->url; my $l = []; my $fh = $self->open_read_ftp($self->ftp_cmd." -o - $fullname", @@ -984,29 +922,26 @@ sub get_http_list package OpenBSD::PackageRepository::HTTP; our @ISA=qw(OpenBSD::PackageRepository::HTTPorFTP); -sub urlscheme +sub urlscheme($) { return 'http'; } -sub obtain_list +sub obtain_list($self, $error) { - my ($self, $error) = @_; return $self->get_http_list($error); } package OpenBSD::PackageRepository::HTTPS; our @ISA=qw(OpenBSD::PackageRepository::HTTP); -sub urlscheme +sub urlscheme($) { return 'https'; } -sub setup_session +sub setup_session($self) { - my $self = shift; - require OpenBSD::Temp; $self->{count} = 0; local $>; @@ -1015,22 +950,20 @@ sub setup_session $> = $uid; } my ($fh, undef) = OpenBSD::Temp::fh_file("session", - sub { unlink(shift); }); + sub($name) { unlink($name); }); if (!defined $fh) { $self->{state}->fatal(OpenBSD::Temp->last_error); } $self->{fh} = $fh; # XXX store the full fh and not the fileno } -sub ftp_cmd +sub ftp_cmd($self) { - my $self = shift; return $self->SUPER::ftp_cmd." -S session=/dev/fd/".fileno($self->{fh}); } -sub drop_privileges_and_setup_env +sub drop_privileges_and_setup_env($self) { - my $self = shift; $self->SUPER::drop_privileges_and_setup_env; # reset the CLOEXEC flag on that one use Fcntl; @@ -1040,14 +973,13 @@ sub drop_privileges_and_setup_env package OpenBSD::PackageRepository::FTP; our @ISA=qw(OpenBSD::PackageRepository::HTTPorFTP); -sub urlscheme +sub urlscheme($) { return 'ftp'; } -sub _list +sub _list($self, $cmd, $error) { - my ($self, $cmd, $error) = @_; my $l =[]; my $fh = $self->open_read_ftp($cmd, $error) or return; while(<$fh>) { @@ -1063,18 +995,15 @@ sub _list return $l; } -sub get_ftp_list +sub get_ftp_list($self, $error) { - my ($self, $error) = @_; - my $fullname = $self->url; return $self->_list("echo 'nlist'| ".$self->ftp_cmd." $fullname", $error); } -sub obtain_list +sub obtain_list($self, $error) { - my ($self, $error) = @_; if (defined $ENV{'ftp_proxy'} && $ENV{'ftp_proxy'} ne '') { return $self->get_http_list($error); } else { diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepository/Cache.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepository/Cache.pm index e4a7ff6c1d1..7c516f9c2d9 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepository/Cache.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepository/Cache.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Cache.pm,v 1.11 2022/05/29 10:48:41 espie Exp $ +# $OpenBSD: Cache.pm,v 1.12 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2022 Marc Espie # @@ -15,17 +15,14 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; # supplementary glue to add support for reading the update.db locate(1) # database in quirks package OpenBSD::PackageRepository::Cache; -sub new +sub new($class, $state, $setlist) { - my ($class, $state, $setlist) = @_; - return undef unless -f OpenBSD::Paths->updateinfodb; my $o = bless { @@ -37,9 +34,8 @@ sub new return $o; } -sub pipe_locate +sub pipe_locate($self, @params) { - my ($self, @params) = @_; unshift(@params, OpenBSD::Paths->locate, '-d', OpenBSD::Paths->updateinfodb, '--'); my $state = $self->{state}; @@ -52,16 +48,13 @@ sub pipe_locate # search objects such that the last one can do add_stem, so we oblige # (probably TODO: add a secondary interface in quirks, but this can do # in the meantime) -sub add_stem +sub add_stem($self, $stem) { - my ($self, $stem) = @_; $self->{stems}{$stem} = 1; } -sub prime_update_info_cache +sub prime_update_info_cache($self, $state, $setlist) { - my ($self, $state, $setlist) = @_; - my $progress = $state->progress; my $found = {}; @@ -85,8 +78,7 @@ sub prime_update_info_cache $stem =~ s/\-\-.*//; # and set flavors $self->add_stem($stem); $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $quirks->tweak_search($pseudo_search, $h, $state); }); @@ -129,10 +121,8 @@ sub prime_update_info_cache } } -sub get_cached_info +sub get_cached_info($self, $name) { - my ($self, $name) = @_; - my $state = $self->{state}; my $content; if (exists $self->{raw_data}{$name}) { diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepository/HTTP.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepository/HTTP.pm index d9cd1333cac..80826f38227 100755 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepository/HTTP.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepository/HTTP.pm @@ -1,6 +1,6 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: HTTP.pm,v 1.14 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: HTTP.pm,v 1.15 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2011 Marc Espie # @@ -23,14 +23,13 @@ use OpenBSD::PackageRepository::Persistent; package OpenBSD::PackageRepository::HTTP1; our @ISA = qw(OpenBSD::PackageRepository::Persistent); -sub urlscheme +sub urlscheme($) { return 'http'; } -sub initiate +sub initiate($self) { - my $self = shift; my ($rdfh, $wrfh); pipe($self->{getfh}, $wrfh) or die; pipe($rdfh, $self->{cmdfh}) or die; @@ -62,22 +61,20 @@ sub initiate package _Proxy::Header; -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub code +sub code($self) { my $self = shift; return $self->{code}; } package _Proxy::Connection; -sub new +sub new($class, $host, $port) { - my ($class, $host, $port) = @_; require IO::Socket::INET; my $o = IO::Socket::INET->new( PeerHost => $host, @@ -88,9 +85,8 @@ sub new bless {fh => $o, host => $host, buffer => ''}, $class; } -sub send_header +sub send_header($o, $document, %extra) { - my ($o, $document, %extra) = @_; my $crlf="\015\012"; $o->print("GET $document HTTP/1.1", $crlf, "Host: ", $o->{host}, $crlf); @@ -101,9 +97,8 @@ sub send_header $o->print($crlf); } -sub get_header +sub get_header($o) { - my $o = shift; my $l = $o->getline; if ($l !~ m,^HTTP/1\.1\s+(\d\d\d),) { return undef; @@ -132,9 +127,8 @@ sub get_header return $h; } -sub getline +sub getline($self) { - my $self = shift; while (1) { if ($self->{buffer} =~ s/^(.*?)\015\012//) { return $1; @@ -145,9 +139,8 @@ sub getline } } -sub retrieve +sub retrieve($self, $sz) { - my ($self, $sz) = @_; while(length($self->{buffer}) < $sz) { my $buffer; $self->{fh}->recv($buffer, $sz - length($self->{buffer})); @@ -158,9 +151,8 @@ sub retrieve return $result; } -sub retrieve_and_print +sub retrieve_and_print($self, $sz, $fh) { - my ($self, $sz, $fh) = @_; my $result = substr($self->{buffer}, 0, $sz); print $fh $result; my $retrieved = length($result); @@ -177,9 +169,8 @@ sub retrieve_and_print } } -sub retrieve_chunked +sub retrieve_chunked($self) { - my $self = shift; my $result = ''; while (1) { my $sz = $self->getline; @@ -192,10 +183,8 @@ sub retrieve_chunked return $result; } -sub retrieve_response +sub retrieve_response($self, $h) { - my ($self, $h) = @_; - if ($h->{chunked}) { return $self->retrieve_chunked; } @@ -205,10 +194,8 @@ sub retrieve_response return undef; } -sub retrieve_response_and_print +sub retrieve_response_and_print($self, $h, $fh) { - my ($self, $h, $fh) = @_; - if ($h->{chunked}) { print $fh $self->retrieve_chunked; } @@ -217,9 +204,8 @@ sub retrieve_response_and_print } } -sub print +sub print($self, @l) { - my ($self, @l) = @_; # print STDERR "Before print\n"; if (!print {$self->{fh}} @l) { print STDERR "network print failed with $!\n"; @@ -232,9 +218,8 @@ package _Proxy; my $pid; my $token = 0; -sub batch +sub batch($code) { - my $code = shift; if (defined $pid) { waitpid($pid, 0); undef $pid; @@ -250,7 +235,7 @@ sub batch } } -sub abort_batch +sub abort_batch() { if (defined $pid) { kill HUP => $pid; @@ -260,9 +245,8 @@ sub abort_batch print "\nABORTED $token\n"; } -sub get_directory +sub get_directory($o, $dname) { - my ($o, $dname) = @_; local $SIG{'HUP'} = 'IGNORE'; $o->send_header("$dname/"); my $h = $o->get_header; @@ -292,10 +276,8 @@ sub get_directory use File::Basename; -sub get_file +sub get_file($o, $fname) { - my ($o, $fname) = @_; - my $bailout = 0; $SIG{'HUP'} = sub { $bailout++; @@ -333,18 +315,17 @@ sub get_file } while ($end < $total_size); } -sub main +sub main($self) { - my $self = shift; my $o = _Proxy::Connection->new($self->{host}, "www"); while () { chomp; if (m/^LIST\s+(.*)$/o) { my $dname = $1; - batch(sub {get_directory($o, $dname);}); + batch(sub() {get_directory($o, $dname);}); } elsif (m/^GET\s+(.*)$/o) { my $fname = $1; - batch(sub { get_file($o, $fname);}); + batch(sub() { get_file($o, $fname);}); } elsif (m/^BYE$/o) { exit(0); } elsif (m/^ABORT$/o) { diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepository/Installed.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepository/Installed.pm index 09af353ed95..a6beb4b8feb 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepository/Installed.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepository/Installed.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Installed.pm,v 1.45 2023/05/17 15:45:36 espie Exp $ +# $OpenBSD: Installed.pm,v 1.46 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2007-2014 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; # XXX: we want to be able to load PackageRepository::Installed stand-alone, # so we put the only common method into PackageRepositoryBase. @@ -28,14 +27,13 @@ package OpenBSD::PackageRepositoryBase; my ($version, $current); -sub is_local_file +sub is_local_file($) { return 0; } -sub expand_locations +sub expand_locations($class, $string, $state) { - my ($class, $string, $state) = @_; require OpenBSD::Paths; if ($string eq '%a') { return OpenBSD::Paths->machine_architecture; @@ -50,9 +48,8 @@ sub expand_locations } } -sub get_cached_info +sub get_cached_info($repository, $name) { - my ($repository, $name) = @_; if (defined $repository->{info_cache}) { return $repository->{info_cache}->get_cached_info($name); } else { @@ -60,10 +57,8 @@ sub get_cached_info } } -sub setup_cache +sub setup_cache($repo, $setlist) { - my ($repo, $setlist) = @_; - my $state = $repo->{state}; return if $state->defines("NO_CACHING"); @@ -80,10 +75,8 @@ sub setup_cache } } -sub parse_url +sub parse_url($class, $r, $state) { - my ($class, $r, $state) = @_; - my $path; if ($$r =~ m/^(.*?)\:(.*)/) { @@ -114,17 +107,14 @@ sub parse_url bless { path => $path, release => $release, state => $state }, $class; } -sub parse_fullurl +sub parse_fullurl($class, $r, $state) { - my ($class, $r, $state) = @_; - $class->strip_urlscheme($r) or return undef; return $class->parse_url($r, $state); } -sub strip_urlscheme +sub strip_urlscheme($class, $r) { - my ($class, $r) = @_; if ($$r =~ m/^(.*?)\:(.*)$/) { my $scheme = lc($1); if ($scheme eq $class->urlscheme) { @@ -135,9 +125,8 @@ sub strip_urlscheme return 0; } -sub match_locations +sub match_locations($self, $search, @filters) { - my ($self, $search, @filters) = @_; my $l = $search->match_locations($self); while (my $filter = (shift @filters)) { last if @$l == 0; # don't bother filtering empty list @@ -146,59 +135,49 @@ sub match_locations return $l; } -sub url +sub url($self, $name = undef) { - my ($self, $name) = @_; return $self->urlscheme.':'.$self->relative_url($name); } -sub finish_and_close +sub finish_and_close($self, $object) { - my ($self, $object) = @_; $self->close($object); } -sub close_now +sub close_now($self, $object) { - my ($self, $object) = @_; $self->close($object, 0); } -sub close_after_error +sub close_after_error($self, $object) { - my ($self, $object) = @_; $self->close($object, 1); } -sub close_with_client_error +sub close_with_client_error($self, $object) { - my ($self, $object) = @_; $self->close($object, 1); } -sub canonicalize +sub canonicalize($self, $name) { - my ($self, $name) = @_; - if (defined $name) { $name =~ s/\.tgz$//o; } return $name; } -sub new_location +sub new_location($self, @args) { - my ($self, @args) = @_; - return $self->locationClassName->new($self, @args); } -sub locationClassName +sub locationClassName($) { "OpenBSD::PackageLocation" } -sub locations_list +sub locations_list($self) { - my $self = shift; if (!defined $self->{locations}) { my $l = []; require OpenBSD::PackageLocation; @@ -211,13 +190,12 @@ sub locations_list return $self->{locations}; } -sub reinitialize +sub reinitialize($) { } -sub decorate +sub decorate($self, $plist, $location) { - my ($self, $plist, $location) = @_; unless ($plist->has('url')) { OpenBSD::PackingElement::Url->add($plist, $location->url); } @@ -240,7 +218,7 @@ package OpenBSD::PackageRepository::Installed; our @ISA = (qw(OpenBSD::PackageRepositoryBase)); -sub urlscheme +sub urlscheme($) { return 'inst'; } @@ -248,35 +226,31 @@ sub urlscheme use OpenBSD::PackageInfo (qw(is_installed installed_info installed_packages installed_stems installed_name)); -sub new +sub new($class, $all, $state) { - my ($class, $all, $state) = @_; return bless { all => $all, state => $state }, $class; } -sub relative_url +sub relative_url($self, $name = '') { - my ($self, $name) = @_; $name or ''; } -sub close +sub close($, $, $ = undef) { } -sub make_error_file +sub make_error_file($, $) { } -sub canonicalize +sub canonicalize($self, $name) { - my ($self, $name) = @_; return installed_name($name); } -sub find +sub find($repository, $name) { - my ($repository, $name, $arch) = @_; my $self; if (is_installed($name)) { @@ -288,41 +262,39 @@ sub find return $self; } -sub locationClassName +sub locationClassName($) { "OpenBSD::PackageLocation::Installed" } -sub grabPlist +# XXX we pass a variable number of params because we +# don't know about the default value for code +sub grabPlist($repository, $name, $arch, @code) { - my ($repository, $name, $arch, $code) = @_; require OpenBSD::PackingList; - return OpenBSD::PackingList->from_installation($name, $code); + return OpenBSD::PackingList->from_installation($name, @code) } -sub available +sub available($self) { - my $self = shift; return installed_packages($self->{all}); } -sub list +sub list($self) { - my $self = shift; my @list = installed_packages($self->{all}); return \@list; } -sub stemlist +sub stemlist($) { return installed_stems(); } -sub wipe_info +sub wipe_info($, $) { } -sub may_exist +sub may_exist($self, $name) { - my ($self, $name) = @_; return is_installed($name); } diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepository/Persistent.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepository/Persistent.pm index 15d805e3853..ce3fe5a041c 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepository/Persistent.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepository/Persistent.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Persistent.pm,v 1.3 2017/11/03 15:30:12 espie Exp $ +# $OpenBSD: Persistent.pm,v 1.4 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,25 +15,21 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackageRepository::Persistent; our @ISA=qw(OpenBSD::PackageRepository::Distant); our %distant = (); -sub may_exist +sub may_exist($self, $name) { - my ($self, $name) = @_; my $l = $self->list; return grep {$_ eq $name } @$l; } -sub grab_object +sub grab_object($self, $object) { - my ($self, $object) = @_; - my $cmdfh = $self->{cmdfh}; my $getfh = $self->{getfh}; @@ -71,14 +67,13 @@ sub grab_object CORE::close($getfh); } -sub maxcount +sub maxcount($) { return 1; } -sub opened +sub opened($self) { - my $self = $_[0]; my $k = $self->{host}; if (!defined $distant{$k}) { $distant{$k} = []; @@ -86,9 +81,8 @@ sub opened return $distant{$k}; } -sub list +sub list($self) { - my ($self) = @_; if (!defined $self->{list}) { if (!defined $self->{controller}) { $self->initiate; @@ -120,9 +114,8 @@ sub list return $self->{list}; } -sub cleanup +sub cleanup($self) { - my $self = shift; if (defined $self->{controller}) { my $cmdfh = $self->{cmdfh}; my $getfh = $self->{getfh}; @@ -134,17 +127,15 @@ sub cleanup } } -sub dont_cleanup +sub dont_cleanup($self) { - my $self = shift; CORE::close($self->{cmdfh}); CORE::close($self->{getfh}); delete $self->{controller}; } -sub reinitialize +sub reinitialize($self) { - my $self = shift; $self->initiate; } diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepository/SCP.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepository/SCP.pm index adab12a7412..c25065ed936 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepository/SCP.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepository/SCP.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: SCP.pm,v 1.30 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: SCP.pm,v 1.31 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2003-2006 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::PackageRepository::Persistent; @@ -27,17 +26,15 @@ use IPC::Open2; use IO::Handle; use OpenBSD::Paths; -sub urlscheme +sub urlscheme($) { return 'scp'; } # Any SCP repository uses one single connection, reliant on a perl at end. # The connection starts by xfering and firing up the `distant' script. -sub initiate +sub initiate($self) { - my $self = shift; - my ($rdfh, $wrfh); $self->{controller} = open2($rdfh, $wrfh, OpenBSD::Paths->ssh, @@ -60,13 +57,13 @@ __DATA__ # Distant connection script. #! /usr/bin/perl +use v5.36; my $pid; my $token = 0; $|= 1; -sub batch +sub batch($code) { - my $code = shift; if (defined $pid) { waitpid($pid, 0); undef $pid; @@ -74,7 +71,7 @@ sub batch $token++; $pid = fork(); if (!defined $pid) { - print "ERROR: fork failed: $!\n"; + say "ERROR: fork failed: $!"; } if ($pid == 0) { &$code(); @@ -82,22 +79,20 @@ sub batch } } -sub abort_batch +sub abort_batch() { if (defined $pid) { kill 1, $pid; waitpid($pid, 0); undef $pid; } - print "\nABORTED $token\n"; + say "\nABORTED $token"; } my $dirs = {}; -sub expand_tilde +sub expand_tilde($arg) { - my $arg = shift; - return $dirs->{$arg} //= (getpwnam($arg))[7]."/"; } @@ -106,7 +101,7 @@ while () { if (m/^LIST\s+(.*)$/o) { my $dname = $1; $dname =~ s/^\/\~(.*?)\//expand_tilde($1)/e; - batch(sub { + batch(sub() { my $d; if (opendir($d, $dname)) { print "SUCCESS: directory $dname\n"; @@ -125,7 +120,7 @@ while () { } elsif (m/^GET\s+(.*)$/o) { my $fname = $1; $fname =~ s/^\/\~(.*?)\//expand_tilde($1)/e; - batch(sub { + batch(sub() { if (open(my $fh, '<', $fname)) { my $size = (stat $fh)[7]; print "TRANSFER: $size\n"; diff --git a/usr.sbin/pkg_add/OpenBSD/PackageRepositoryList.pm b/usr.sbin/pkg_add/OpenBSD/PackageRepositoryList.pm index ac5de0718d4..95bd49c653f 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageRepositoryList.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageRepositoryList.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageRepositoryList.pm,v 1.32 2020/02/19 14:22:29 espie Exp $ +# $OpenBSD: PackageRepositoryList.pm,v 1.33 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2006 Marc Espie # @@ -15,22 +15,19 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackageRepositoryList; -sub new +sub new($class, $state) { - my ($class, $state) = @_; return bless {l => [], k => {}, state => $state}, $class; } -sub filter_new +sub filter_new($self, @p) { - my $self = shift; my @l = (); - for my $r (@_) { + for my $r (@p) { next if !defined $r; next if $self->{k}{$r}; $self->{k}{$r} = 1; @@ -39,21 +36,18 @@ sub filter_new return @l; } -sub add +sub add($self, @p) { - my $self = shift; - push @{$self->{l}}, $self->filter_new(@_); + push @{$self->{l}}, $self->filter_new(@p); } -sub prepend +sub prepend($self, @p) { - my $self = shift; - unshift @{$self->{l}}, $self->filter_new(@_); + unshift @{$self->{l}}, $self->filter_new(@p); } -sub do_something +sub do_something($self, $do, $pkgname, @args) { - my ($self, $do, $pkgname, @args) = @_; if (defined $pkgname && $pkgname eq '-') { return OpenBSD::PackageRepository->pipe->new($self->{state})->$do($pkgname, @args); } @@ -64,22 +58,19 @@ sub do_something return undef; } -sub find +sub find($self, @args) { - my ($self, @args) = @_; return $self->do_something('find', @args); } -sub grabPlist +sub grabPlist($self, @args) { - my ($self, @args) = @_; return $self->do_something('grabPlist', @args); } -sub match_locations +sub match_locations($self, @search) { - my ($self, @search) = @_; my $result = []; for my $repo (@{$self->{l}}) { my $l = $repo->match_locations(@search); diff --git a/usr.sbin/pkg_add/OpenBSD/PackingElement.pm b/usr.sbin/pkg_add/OpenBSD/PackingElement.pm index 317914015dc..5dfaa3f496a 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackingElement.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackingElement.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackingElement.pm,v 1.286 2023/05/27 10:03:21 espie Exp $ +# $OpenBSD: PackingElement.pm,v 1.287 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,15 +15,11 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::PackageInfo; use OpenBSD::Paths; -# perl ipc -require 5.008_000; - # This is the basic class, which is mostly abstract, except for # create and register_with_factory. # It does provide base methods for stuff under it, though. @@ -35,9 +31,8 @@ require 5.008_000; package OpenBSD::PackingElement; our %keyword; -sub create +sub create($class, $line, $plist) { - my ($class, $line, $plist) = @_; if ($line =~ m/^\@(\S+)\s*(.*)$/o) { if (defined $keyword{$1}) { $keyword{$1}->add($plist, $2); @@ -50,54 +45,44 @@ sub create } } -sub register_with_factory +sub register_with_factory($class, $k = $class->keyword, $o = $class) { - my ($class, $k, $o) = @_; - if (!defined $k) { - $k = $class->keyword; - } - if (!defined $o) { - $o = $class; - } $keyword{$k} = $o; } -sub category() { 'items' } +sub category($) { 'items' } -sub new +sub new($class, $args) { - my ($class, $args) = @_; bless { name => $args }, $class; } -sub remove +sub remove($self, $plist) { - my ($self, $plist) = @_; $self->{deleted} = 1; } -sub clone +sub clone($object) { - my $object = shift; # shallow copy my %h = %$object; bless \%h, ref($object); } -sub register_manpage +# $self->register_manpage($plstate, $key) +sub register_manpage($, $, $) { } # plist keeps a "state" while reading a plist # $self->destate($plstate) -sub destate +sub destate($, $) { } -sub add_object +sub add_object($self, $plist) { - my ($self, $plist) = @_; $self->destate($plist->{state}); $plist->add2list($self); return $self; @@ -111,45 +96,39 @@ sub add_object # # most add methods have ONE single argument, except for # subclasses generated from comments ! -sub add +sub add($class, $plist, @args) { - my ($class, $plist, @args) = @_; - my $self = $class->new(@args); return $self->add_object($plist); } -sub needs_keyword() { 1 } +sub needs_keyword($) { 1 } -sub write +sub write($self, $fh) { - my ($self, $fh) = @_; my $s = $self->stringize; if ($self->needs_keyword) { $s = " $s" unless $s eq ''; - print $fh "\@", $self->keyword, "$s\n"; + say $fh "\@", $self->keyword, "$s"; } else { - print $fh "$s\n"; + say $fh $s; } } # specialized version to avoid copying digital signatures over -sub write_no_sig +sub write_no_sig($self, $fh) { - my ($self, $fh) = @_; $self->write($fh); } -sub write_without_variation +sub write_without_variation($self, $fh) { - my ($self, $fh) = @_; $self->write_no_sig($fh); } # needed for comment checking -sub fullstring +sub fullstring($self) { - my ($self, $fh) = @_; my $s = $self->stringize; if ($self->needs_keyword) { $s = " $s" unless $s eq ''; @@ -159,44 +138,39 @@ sub fullstring } } -sub name +sub name($self) { - my $self = shift; return $self->{name}; } -sub set_name +sub set_name($self, $v) { - my ($self, $v) = @_; $self->{name} = $v; } -sub stringize + +sub stringize($self) { - my $self = shift; return $self->name; } -sub IsFile() { 0 } +sub IsFile($) { 0 } -sub is_a_library() { 0 } -sub NoDuplicateNames() { 0 } +sub is_a_library($) { 0 } +sub NoDuplicateNames($) { 0 } -sub copy_shallow_if +sub copy_shallow_if($self, $copy, $h) { - my ($self, $copy, $h) = @_; $self->add_object($copy) if defined $h->{$self}; } -sub copy_deep_if +sub copy_deep_if($self, $copy, $h) { - my ($self, $copy, $h) = @_; $self->clone->add_object($copy) if defined $h->{$self}; } -sub finish +sub finish($class, $state) { - my ($class, $state) = @_; OpenBSD::PackingElement::Fontdir->finish($state); OpenBSD::PackingElement::RcScript->report($state); if (defined $state->{readmes}) { @@ -213,25 +187,24 @@ sub finish # this class doesn't have real objects: no valid new nor clone... package OpenBSD::PackingElement::Annotation; our @ISA=qw(OpenBSD::PackingElement); -sub new { die "Can't create annotation objects" } +sub new($) { die "Can't create annotation objects" } # concrete objects package OpenBSD::PackingElement::Object; our @ISA=qw(OpenBSD::PackingElement); -sub cwd +sub cwd($self) { - return ${$_[0]->{cwd}}; + return ${$self->{cwd}}; } # most objects should be fs relative, but there are # exceptions, such as sample files that will get installed # under /etc, or rc files ! -sub absolute_okay() { 0 } -sub compute_fullname -{ - my ($self, $state) = @_; +sub absolute_okay($) { 0 } +sub compute_fullname($self, $state) +{ $self->{cwd} = $state->{cwd}; $self->set_name(File::Spec->canonpath($self->name)); if ($self->name =~ m|^/|) { @@ -241,9 +214,8 @@ sub compute_fullname } } -sub make_full +sub make_full($self, $path) { - my ($self, $path) = @_; if ($path !~ m|^/|o && $self->cwd ne '.') { $path = $self->cwd."/".$path; $path =~ s,^//,/,; @@ -251,15 +223,13 @@ sub make_full return $path; } -sub fullname +sub fullname($self) { - my $self = shift; return $self->make_full($self->name); } -sub compute_modes +sub compute_modes($self, $state) { - my ($self, $state) = @_; if (defined $state->{mode}) { $self->{mode} = $state->{mode}; } @@ -281,13 +251,12 @@ sub compute_modes package OpenBSD::PackingElement::FileObject; our @ISA=qw(OpenBSD::PackingElement::Object); -sub NoDuplicateNames() { 1 } +sub NoDuplicateNames($) { 1 } -sub dirclass() { undef } +sub dirclass($) { undef } -sub new +sub new($class, $args) { - my ($class, $args) = @_; if ($args =~ m/^(.*?)\/+$/o and defined $class->dirclass) { bless { name => $1 }, $class->dirclass; } else { @@ -295,23 +264,19 @@ sub new } } -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $state->{lastfileobject} = $self; $self->compute_fullname($state); } -sub set_tempname +sub set_tempname($self, $tempname) { - my ($self, $tempname) = @_; $self->{tempname} = $tempname; } -sub realname +sub realname($self, $state) { - my ($self, $state) = @_; - my $name = $self->fullname; if (defined $self->{tempname}) { $name = $self->{tempname}; @@ -319,11 +284,9 @@ sub realname return $state->{destdir}.$name; } -sub compute_digest +sub compute_digest($self, $filename, $class = 'OpenBSD::sha') { - my ($self, $filename, $class) = @_; require OpenBSD::md5; - $class = 'OpenBSD::sha' if !defined $class; return $class->new($filename); } @@ -343,24 +306,21 @@ our @ISA=qw(OpenBSD::PackingElement); package OpenBSD::PackingElement::Unique; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub add_object +sub add_object($self, $plist) { - my ($self, $plist) = @_; - $self->destate($plist->{state}); $plist->addunique($self); return $self; } -sub remove +sub remove($self, $plist) { - my ($self, $plist) = @_; delete $plist->{$self->category}; } -sub category +sub category($self) { - return ref(shift); + return ref($self); } # all the stuff that ends up in signatures @@ -377,9 +337,8 @@ our @ISA=qw(OpenBSD::PackingElement::FileObject); use File::Basename; -sub write +sub write($self, $fh) { - my ($self, $fh) = @_; print $fh "\@comment no checksum\n" if defined $self->{nochecksum}; print $fh "\@comment no debug\n" if defined $self->{nodebug}; $self->SUPER::write($fh); @@ -387,25 +346,24 @@ sub write $self->{d}->write($fh); } if (defined $self->{size}) { - print $fh "\@size ", $self->{size}, "\n"; + say $fh "\@size ", $self->{size}; } if (defined $self->{ts}) { - print $fh "\@ts ", $self->{ts}, "\n"; + say $fh "\@ts ", $self->{ts}; } if (defined $self->{symlink}) { - print $fh "\@symlink ", $self->{symlink}, "\n"; + say $fh "\@symlink ", $self->{symlink}; } if (defined $self->{link}) { - print $fh "\@link ", $self->{link}, "\n"; + say $fh "\@link ", $self->{link}; } if (defined $self->{tempname}) { - print $fh "\@temp ", $self->{tempname}, "\n"; + say $fh "\@temp ", $self->{tempname}; } } -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->SUPER::destate($state); $state->{lastfile} = $self; $state->{lastchecksummable} = $self; @@ -420,49 +378,43 @@ sub destate } } -sub add_digest +sub add_digest($self, $d) { - my ($self, $d) = @_; $self->{d} = $d; } -sub add_size + +sub add_size($self, $sz) { - my ($self, $sz) = @_; $self->{size} = $sz; } -sub add_timestamp +sub add_timestamp($self, $ts) { - my ($self, $ts) = @_; $self->{ts} = $ts; } # XXX symlink/hardlinks are properties of File, # because we want to use inheritance for other stuff. -sub make_symlink +sub make_symlink($self, $linkname) { - my ($self, $linkname) = @_; $self->{symlink} = $linkname; } -sub make_hardlink +sub make_hardlink($self, $linkname) { - my ($self, $linkname) = @_; $self->{link} = $linkname; } -sub may_check_digest +sub may_check_digest($self, $path, $state) { - my ($self, $path, $state) = @_; if ($state->{check_digest}) { $self->check_digest($path, $state); } } -sub check_digest +sub check_digest($self, $path, $state) { - my ($self, $path, $state) = @_; return if $self->{link} or $self->{symlink}; if (!defined $self->{d}) { $state->log->fatal($state->f("#1 does not have a signature", @@ -478,7 +430,7 @@ sub check_digest } } -sub IsFile() { 1 } +sub IsFile($) { 1 } package OpenBSD::PackingElement::FileWithDebugInfo; our @ISA=qw(OpenBSD::PackingElement::FileBase); @@ -487,21 +439,19 @@ package OpenBSD::PackingElement::File; our @ISA=qw(OpenBSD::PackingElement::FileBase); use OpenBSD::PackageInfo qw(is_info_name); -sub keyword() { "file" } +sub keyword($) { "file" } __PACKAGE__->register_with_factory; -sub dirclass() { "OpenBSD::PackingElement::Dir" } +sub dirclass($) { "OpenBSD::PackingElement::Dir" } -sub needs_keyword +sub needs_keyword($self) { - my $self = shift; + # files/dirnames that starts with an @ will require a keyword return $self->stringize =~ m/\^@/; } -sub add_object +sub add_object($self, $plist) { - my ($self, $plist) = @_; - $self->destate($plist->{state}); my $j = is_info_name($self->name); if ($j && $self->cwd eq '.') { @@ -516,14 +466,13 @@ sub add_object package OpenBSD::PackingElement::Sample; our @ISA=qw(OpenBSD::PackingElement::FileObject); -sub keyword() { "sample" } -sub absolute_okay() { 1 } +sub keyword($) { "sample" } +sub absolute_okay($) { 1 } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; - if ($state->{lastfile}->isa("OpenBSD::PackingElement::SpecialFile")) { + if ($state->{lastfile} isa OpenBSD::PackingElement::SpecialFile) { die "Can't \@sample a specialfile: ", $state->{lastfile}->stringize; } @@ -532,7 +481,13 @@ sub destate $self->compute_modes($state); } -sub dirclass() { "OpenBSD::PackingElement::Sampledir" } +sub dirclass($) { "OpenBSD::PackingElement::Sampledir" } + +# TODO @ghost data is not yet used +# it's meant for files that used to be "registered" but are +# somewhat autogenerated or something, and should vanish in a transparent way. +# +# the keyword was introduced very early but is (still) not used # TODO @ghost data is not yet used # it's meant for files that used to be "registered" but are @@ -543,13 +498,12 @@ sub dirclass() { "OpenBSD::PackingElement::Sampledir" } package OpenBSD::PackingElement::Ghost; our @ISA = qw(OpenBSD::PackingElement::FileObject); -sub keyword() { "ghost" } -sub absolute_okay() { 1 } +sub keyword($) { "ghost" } +sub absolute_okay($) { 1 } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->compute_fullname($state); $self->compute_modes($state); } @@ -557,11 +511,10 @@ sub destate package OpenBSD::PackingElement::Sampledir; our @ISA=qw(OpenBSD::PackingElement::DirBase OpenBSD::PackingElement::Sample); -sub absolute_okay() { 1 } +sub absolute_okay($) { 1 } -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->compute_fullname($state); $self->compute_modes($state); } @@ -570,23 +523,20 @@ package OpenBSD::PackingElement::RcScript; use File::Basename; our @ISA = qw(OpenBSD::PackingElement::FileBase); -sub keyword() { "rcscript" } -sub absolute_okay() { 1 } +sub keyword($) { "rcscript" } +sub absolute_okay($) { 1 } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->compute_fullname($state); $state->{lastfile} = $self; $state->{lastchecksummable} = $self; $self->compute_modes($state); } -sub report +sub report($class, $state) { - my ($class, $state) = @_; - my @l; for my $script (sort keys %{$state->{add_rcscripts}}) { next if $state->{delete_rcscripts}{$script}; @@ -602,26 +552,25 @@ sub report package OpenBSD::PackingElement::InfoFile; our @ISA=qw(OpenBSD::PackingElement::FileBase); -sub keyword() { "info" } +sub keyword($) { "info" } __PACKAGE__->register_with_factory; -sub dirclass() { "OpenBSD::PackingElement::Infodir" } +sub dirclass($) { "OpenBSD::PackingElement::Infodir" } package OpenBSD::PackingElement::Shell; our @ISA=qw(OpenBSD::PackingElement::FileWithDebugInfo); -sub keyword() { "shell" } +sub keyword($) { "shell" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::Manpage; use File::Basename; our @ISA=qw(OpenBSD::PackingElement::FileBase); -sub keyword() { "man" } +sub keyword($) { "man" } __PACKAGE__->register_with_factory; -sub register_manpage +sub register_manpage($self, $state, $key) { - my ($self, $state, $key) = @_; # optimization: don't bother registering stuff from partial packages # (makewhatis will complain that the names don't match anyway) return if defined $self->{tempname}; @@ -631,25 +580,21 @@ sub register_manpage } } -sub is_source +sub is_source($self) { - my $self = shift; return $self->name =~ m/man\/man[^\/]+\/[^\/]+\.[\dln][^\/]?$/o; } -sub source_to_dest +sub source_to_dest($self) { - my $self = shift; my $v = $self->name; $v =~ s/(man\/)man([^\/]+\/[^\/]+)\.[\dln][^\/]?$/$1cat$2.0/; return $v; } # assumes the source is nroff, launches nroff -sub format +sub format($self, $state, $dest, $destfh) { - my ($self, $state, $dest, $destfh) = @_; - my $base = $state->{base}; my $fname = $base.$self->fullname; if (-z $fname) { @@ -675,11 +620,12 @@ sub format mkdir($d); } if (my ($dir, $file) = $fname =~ m/^(.*)\/([^\/]+\/[^\/]+)$/) { - my $r = $state->system(sub { - open STDOUT, '>&', $destfh or - die "Can't write to $dest: $!"; - close $destfh; - chdir($dir) or die "Can't chdir to $dir: $!"; + my $r = $state->system( + sub() { + open STDOUT, '>&', $destfh or + die "Can't write to $dest: $!"; + close $destfh; + chdir($dir) or die "Can't chdir to $dir: $!"; }, $state->{groff} // OpenBSD::Paths->groff, qw(-mandoc -mtty-char -E -Ww -Tascii -P -c), @@ -700,18 +646,16 @@ our @ISA=qw(OpenBSD::PackingElement::FileWithDebugInfo); our $todo = 0; -sub keyword() { "lib" } +sub keyword($) { "lib" } __PACKAGE__->register_with_factory; -sub mark_ldconfig_directory +sub mark_ldconfig_directory($self, $state) { - my ($self, $state) = @_; $state->ldconfig->mark_directory($self->fullname); } -sub parse +sub parse($self, $filename) { - my ($self, $filename) = @_; if ($filename =~ m/^(.*?)\/?lib([^\/]+)\.so\.(\d+)\.(\d+)$/o) { return ($2, $3, $4, $1); } else { @@ -719,36 +663,36 @@ sub parse } } -sub is_a_library() { 1 } +sub is_a_library($) { 1 } package OpenBSD::PackingElement::Binary; our @ISA=qw(OpenBSD::PackingElement::FileWithDebugInfo); -sub keyword() { "bin" } +sub keyword($) { "bin" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::StaticLib; our @ISA=qw(OpenBSD::PackingElement::FileWithDebugInfo); -sub keyword() { "static-lib" } +sub keyword($) { "static-lib" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::SharedObject; our @ISA=qw(OpenBSD::PackingElement::FileWithDebugInfo); -sub keyword() { "so" } +sub keyword($) { "so" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::PkgConfig; our @ISA=qw(OpenBSD::PackingElement::FileBase); -sub keyword() { "pkgconfig" } +sub keyword($) { "pkgconfig" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::LibtoolLib; our @ISA=qw(OpenBSD::PackingElement::FileBase); -sub keyword() { "ltlib" } +sub keyword($) { "ltlib" } __PACKAGE__->register_with_factory; # Comment is very special: @@ -759,19 +703,16 @@ __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::Comment; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub keyword() { "comment" } +sub keyword($) { "comment" } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->{cwd} = $state->{cwd}; } -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; - if ($args =~ m/^\$OpenBSD.*\$\s*$/o) { return OpenBSD::PackingElement::CVSTag->add($plist, $args); } elsif ($args =~ m/^(?:subdir|pkgpath)\=(.*?)\s+cdrom\=(.*?)\s+ftp\=(.*?)\s*$/o) { @@ -792,12 +733,12 @@ sub add package OpenBSD::PackingElement::CVSTag; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub keyword() { 'comment' } +sub keyword($) { 'comment' } -sub category() { 'cvstags'} +sub category($) { 'cvstags'} # don't incorporate this into compared signatures -sub write_without_variation +sub write_without_variation($, $) { } @@ -806,10 +747,8 @@ our @ISA=qw(OpenBSD::PackingElement::Annotation); __PACKAGE__->register_with_factory('sha'); -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; - require OpenBSD::md5; $plist->{state}->{lastchecksummable}->add_digest(OpenBSD::sha->fromstring($args)); @@ -821,10 +760,8 @@ our @ISA=qw(OpenBSD::PackingElement::Annotation); __PACKAGE__->register_with_factory('symlink'); -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; - $plist->{state}->{lastfile}->make_symlink($args); return; } @@ -834,10 +771,8 @@ our @ISA=qw(OpenBSD::PackingElement::Annotation); __PACKAGE__->register_with_factory('link'); -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; - $plist->{state}->{lastfile}->make_hardlink($args); return; } @@ -847,9 +782,8 @@ our @ISA=qw(OpenBSD::PackingElement::Annotation); __PACKAGE__->register_with_factory('temp'); -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; $plist->{state}->{lastfile}->set_tempname($args); return; } @@ -859,10 +793,8 @@ our @ISA=qw(OpenBSD::PackingElement::Annotation); __PACKAGE__->register_with_factory('size'); -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; - $plist->{state}->{lastfile}->add_size($args); return; } @@ -872,10 +804,8 @@ our @ISA=qw(OpenBSD::PackingElement::Annotation); __PACKAGE__->register_with_factory('ts'); -sub add +sub add($class, $plist, $args) { - my ($class, $plist, $args) = @_; - $plist->{state}->{lastfile}->add_timestamp($args); return; } @@ -883,12 +813,11 @@ sub add package OpenBSD::PackingElement::Option; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub keyword() { 'option' } +sub keyword($) { 'option' } __PACKAGE__->register_with_factory; -sub new +sub new($class, $args) { - my ($class, $args) = @_; if ($args eq 'no-default-conflict') { return OpenBSD::PackingElement::NoDefaultConflict->new; } elsif ($args eq 'manual-installation') { @@ -909,48 +838,45 @@ sub new package OpenBSD::PackingElement::UniqueOption; our @ISA=qw(OpenBSD::PackingElement::Unique OpenBSD::PackingElement::Option); -sub stringize +sub stringize($self) { - my $self = shift; return $self->category; } -sub new +sub new($class, @) { - my ($class, @args) = @_; bless {}, $class; } package OpenBSD::PackingElement::NoDefaultConflict; our @ISA=qw(OpenBSD::PackingElement::UniqueOption); -sub category() { 'no-default-conflict' } +sub category($) { 'no-default-conflict' } package OpenBSD::PackingElement::ManualInstallation; our @ISA=qw(OpenBSD::PackingElement::UniqueOption); -sub category() { 'manual-installation' } +sub category($) { 'manual-installation' } # don't incorporate this in signatures for obvious reasons -sub write_no_sig() +sub write_no_sig($, $) { } package OpenBSD::PackingElement::Firmware; our @ISA=qw(OpenBSD::PackingElement::ManualInstallation); -sub category() { 'firmware' } +sub category($) { 'firmware' } package OpenBSD::PackingElement::AlwaysUpdate; our @ISA=qw(OpenBSD::PackingElement::UniqueOption); -sub category() +sub category($) { 'always-update'; } -sub stringize +sub stringize($self) { - my $self = shift; my @l = ($self->category); if (defined $self->{hash}) { push(@l, $self->{hash}); @@ -958,9 +884,8 @@ sub stringize return join(' ', @l); } -sub hash_plist +sub hash_plist($self, $plist) { - my ($self, $plist) = @_; delete $self->{hash}; my $content; open my $fh, '>', \$content; @@ -970,16 +895,15 @@ sub hash_plist $self->{hash} = $digest; } -sub new_with_hash +sub new_with_hash($class, $hash) { - my ($class, $hash) = @_; bless { hash => $hash}, $class; } package OpenBSD::PackingElement::IsBranch; our @ISA=qw(OpenBSD::PackingElement::UniqueOption); -sub category() +sub category($) { 'is-branch'; } @@ -987,12 +911,11 @@ sub category() package OpenBSD::PackingElement::ExtraInfo; our @ISA=qw(OpenBSD::PackingElement::Unique OpenBSD::PackingElement::Comment); -sub category() { 'extrainfo' } +sub category($) { 'extrainfo' } -sub new +# TODO gc cdromn +sub new($class, $subdir, $cdrom, $ftp) { - my ($class, $subdir, $cdrom, $ftp) = @_; - $ftp =~ s/^\"(.*)\"$/$1/; $ftp =~ s/^\'(.*)\'$/$1/; my $o = bless { subdir => $subdir, @@ -1006,14 +929,14 @@ sub new return $o; } -sub subdir + +sub subdir($self) { - return shift->{subdir}; + return $self->{subdir}; } -sub may_quote +sub _may_quote($s) { - my $s = shift; if ($s =~ m/\s/) { return '"'.$s.'"'; } else { @@ -1021,15 +944,14 @@ sub may_quote } } -sub stringize +sub stringize($self) { - my $self = shift; my @l = ( "pkgpath=".$self->{subdir}); if (defined $self->{cdrom}) { - push @l, "cdrom=".may_quote($self->{cdrom}); + push @l, "cdrom="._may_quote($self->{cdrom}); } - push(@l, "ftp=".may_quote($self->{ftp})); + push(@l, "ftp="._may_quote($self->{ftp})); return join(' ', @l); } @@ -1037,49 +959,47 @@ package OpenBSD::PackingElement::Name; use File::Spec; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub keyword() { "name" } +sub keyword($) { "name" } __PACKAGE__->register_with_factory; -sub category() { "name" } +sub category($) { "name" } package OpenBSD::PackingElement::LocalBase; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub keyword() { "localbase" } +sub keyword($) { "localbase" } __PACKAGE__->register_with_factory; -sub category() { "localbase" } +sub category($) { "localbase" } # meta-info: where the package was downloaded/installed from # (TODO not as useful as could be, because the workflow isn't effective!) package OpenBSD::PackingElement::Url; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub keyword() { "url" } +sub keyword($) { "url" } __PACKAGE__->register_with_factory; -sub category() { "url" } +sub category($) { "url" } # don't incorporate this in signatures for obvious reasons -sub write_no_sig() +sub write_no_sig($, $) { } package OpenBSD::PackingElement::Version; our @ISA=qw(OpenBSD::PackingElement::Unique OpenBSD::PackingElement::VersionElement); -sub keyword() { "version" } +sub keyword($) { "version" } __PACKAGE__->register_with_factory; -sub category() { "version" } +sub category($) { "version" } package OpenBSD::PackingElement::Conflict; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub keyword() { "conflict" } +sub keyword($) { "conflict" } __PACKAGE__->register_with_factory; -sub category() { "conflict" } +sub category($) { "conflict" } -sub spec +sub spec($self) { - my $self =shift; - require OpenBSD::Search; return OpenBSD::Search::PkgSpec->new($self->name); } @@ -1088,30 +1008,27 @@ package OpenBSD::PackingElement::Dependency; our @ISA=qw(OpenBSD::PackingElement::Depend); use OpenBSD::Error; -sub keyword() { "depend" } +sub keyword($) { "depend" } __PACKAGE__->register_with_factory; -sub category() { "depend" } +sub category($) { "depend" } -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($pkgpath, $pattern, $def) = split /\:/o, $args; bless { name => $def, pkgpath => $pkgpath, pattern => $pattern, def => $def }, $class; } -sub stringize +sub stringize($self) { - my $self = shift; return join(':', map { $self->{$_}} (qw(pkgpath pattern def))); } OpenBSD::Auto::cache(spec, - sub { + sub($self) { require OpenBSD::Search; - my $self = shift; my $src; if ($self->{pattern} eq '=') { $src = $self->{def}; @@ -1125,14 +1042,12 @@ OpenBSD::Auto::cache(spec, package OpenBSD::PackingElement::Wantlib; our @ISA=qw(OpenBSD::PackingElement::Depend); -sub category() { "wantlib" } -sub keyword() { "wantlib" } +sub category($) { "wantlib" } +sub keyword($) { "wantlib" } __PACKAGE__->register_with_factory; OpenBSD::Auto::cache(spec, - sub { - my $self = shift; - + sub($self) { require OpenBSD::LibSpec; return OpenBSD::LibSpec->from_string($self->name); }); @@ -1140,13 +1055,12 @@ OpenBSD::Auto::cache(spec, package OpenBSD::PackingElement::Libset; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub category() { "libset" } -sub keyword() { "libset" } +sub category($) { "libset" } +sub keyword($) { "libset" } __PACKAGE__->register_with_factory; -sub new +sub new($class, $args) { - my ($class, $args) = @_; if ($args =~ m/(.*)\:(.*)/) { return bless {name => $1, libs => [split(/\,/, $2)]}, $class; } else { @@ -1154,57 +1068,52 @@ sub new } } -sub stringize +sub stringize($self) { - my $self = shift; return $self->{name}.':'.join(',', @{$self->{libs}}); } package OpenBSD::PackingElement::PkgPath; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub keyword() { "pkgpath" } +sub keyword($) { "pkgpath" } __PACKAGE__->register_with_factory; -sub category() { "pkgpath" } +sub category($) { "pkgpath" } -sub new +sub new($class, $fullpkgpath) { - my ($class, $fullpkgpath) = @_; bless {name => $fullpkgpath, path => OpenBSD::PkgPath::WithOpts->new($fullpkgpath)}, $class; } -sub subdir +sub subdir($self) { - return shift->{name}; + return $self->{name}; } package OpenBSD::PackingElement::AskUpdate; our @ISA=qw(OpenBSD::PackingElement::Meta); -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($pattern, $message) = split /\s+/o, $args, 2; bless { pattern => $pattern, message => $message}, $class; } -sub stringize +sub stringize($self) { - my $self = shift; return join(' ', map { $self->{$_}} (qw(pattern message))); } -sub keyword() { "ask-update" } +sub keyword($) { "ask-update" } __PACKAGE__->register_with_factory; -sub category() { "ask-update" } +sub category($) { "ask-update" } OpenBSD::Auto::cache(spec, - sub { + sub($self) { require OpenBSD::PkgSpec; - my $self = shift; return OpenBSD::PkgSpec->new($self->{pattern}) }); @@ -1214,14 +1123,13 @@ our @ISA=qw(OpenBSD::PackingElement::Action); package OpenBSD::PackingElement::NewUser; our @ISA=qw(OpenBSD::PackingElement::NewAuth); -sub type() { "user" } -sub category() { "users" } -sub keyword() { "newuser" } +sub type($) { "user" } +sub category($) { "users" } +sub keyword($) { "newuser" } __PACKAGE__->register_with_factory; -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($name, $uid, $group, $loginclass, $comment, $home, $shell) = split /\:/o, $args; bless { name => $name, uid => $uid, group => $group, @@ -1229,9 +1137,8 @@ sub new comment => $comment, home => $home, shell => $shell }, $class; } -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; my $uid = $self->{uid}; $uid =~ s/^\!//; $state->{owners}{$self->{name}} = $uid; @@ -1242,9 +1149,8 @@ sub destate # - undef: nothing to check, user/group was not there # - 0: does not match # - 1: exists and matches -sub check +sub check($self) { - my $self = shift; my ($name, $passwd, $uid, $gid, $quota, $class, $gcos, $dir, $shell, $expire) = getpwnam($self->name); return undef unless defined $name; @@ -1274,9 +1180,8 @@ sub check return 1; } -sub stringize +sub stringize($self) { - my $self = shift; return join(':', map { $self->{$_}} (qw(name uid group class comment home shell))); } @@ -1285,29 +1190,26 @@ package OpenBSD::PackingElement::NewGroup; our @ISA=qw(OpenBSD::PackingElement::NewAuth); -sub type() { "group" } -sub category() { "groups" } -sub keyword() { "newgroup" } +sub type($) { "group" } +sub category($) { "groups" } +sub keyword($) { "newgroup" } __PACKAGE__->register_with_factory; -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($name, $gid) = split /\:/o, $args; bless { name => $name, gid => $gid }, $class; } -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; my $gid = $self->{gid}; $gid =~ s/^\!//; $state->{groups}{$self->{name}} = $gid; } -sub check +sub check($self) { - my $self = shift; my ($name, $passwd, $gid, $members) = getgrnam($self->name); return undef unless defined $name; if ($self->{gid} =~ m/^\!(.*)$/o) { @@ -1316,9 +1218,8 @@ sub check return 1; } -sub stringize($) +sub stringize($self) { - my $self = $_[0]; return join(':', map { $self->{$_}} (qw(name gid))); } @@ -1328,25 +1229,22 @@ use File::Spec; our @ISA=qw(OpenBSD::PackingElement::State); -sub keyword() { 'cwd' } +sub keyword($) { 'cwd' } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $state->set_cwd($self->name); } package OpenBSD::PackingElement::Owner; our @ISA=qw(OpenBSD::PackingElement::State); -sub keyword() { 'owner' } +sub keyword($) { 'owner' } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; - delete $state->{uid}; if ($self->name eq '') { undef $state->{owner}; @@ -1361,13 +1259,11 @@ sub destate package OpenBSD::PackingElement::Group; our @ISA=qw(OpenBSD::PackingElement::State); -sub keyword() { 'group' } +sub keyword($) { 'group' } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; - delete $state->{gid}; if ($self->name eq '') { undef $state->{group}; @@ -1382,13 +1278,11 @@ sub destate package OpenBSD::PackingElement::Mode; our @ISA=qw(OpenBSD::PackingElement::State); -sub keyword() { 'mode' } +sub keyword($) { 'mode' } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; - if ($self->name eq '') { undef $state->{mode}; } else { @@ -1401,15 +1295,13 @@ use File::Basename; use OpenBSD::Error; our @ISA=qw(OpenBSD::PackingElement::Action); -sub command +sub command($self) { - my $self = shift; return $self->name; } -sub expand +sub expand($self, $state) { - my ($self, $state) = @_; my $e = $self->command; if ($e =~ m/\%F/o) { die "Bad expand" unless defined $state->{lastfile}; @@ -1430,17 +1322,13 @@ sub expand return $e; } -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->{expanded} = $self->expand($state); } -sub run +sub run($self, $state, $v = $self->{expanded}) { - my ($self, $state, $v) = @_; - - $v //= $self->{expanded}; $state->ldconfig->ensure; $state->say("#1 #2", $self->keyword, $v) if $state->verbose >= 2; $state->log->system(OpenBSD::Paths->sh, '-c', $v) unless $state->{not}; @@ -1453,21 +1341,19 @@ sub run package OpenBSD::PackingElement::TagBase; our @ISA=qw(OpenBSD::PackingElement::ExeclikeAction); -sub command +sub command($self) { - my $self = shift; return $self->{params}; } package OpenBSD::PackingElement::Tag; our @ISA=qw(OpenBSD::PackingElement::TagBase); -sub keyword() { 'tag' } +sub keyword($) { 'tag' } __PACKAGE__->register_with_factory; -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($tag, $params) = split(/\s+/, $args, 2); bless { name => $tag, @@ -1475,9 +1361,8 @@ sub new }, $class; } -sub stringize +sub stringize($self) { - my $self = shift; if ($self->{params} ne '') { return join(' ', $self->name, $self->{params}); } else { @@ -1487,9 +1372,8 @@ sub stringize # tags are a kind of dependency, we have a special list for them, BUT # they're still part of the normal packing-list -sub add_object +sub add_object($self, $plist) { - my ($self, $plist) = @_; push(@{$plist->{tags}}, $self); $self->SUPER::add_object($plist); } @@ -1499,8 +1383,8 @@ sub add_object package OpenBSD::PackingElement::DefineTag; our @ISA=qw(OpenBSD::PackingElement::TagBase); -sub category() {'define-tag'} -sub keyword() { 'define-tag' } +sub category($) {'define-tag'} +sub keyword($) { 'define-tag' } __PACKAGE__->register_with_factory; # define-tag may be parsed several times, but these objects must be @@ -1512,9 +1396,8 @@ my $subclass = { 'supersedes' => 'Supersedes', 'cleanup' => 'Cleanup' }; -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($tag, $mode, $params) = split(/\s+/, $args, 3); $cache->{$args} //= bless { name => $tag, @@ -1523,15 +1406,13 @@ sub new }, $class; } -sub stringize +sub stringize($self) { - my $self = shift; return join(' ', $self->name, $self->{mode}, $self->{params}); } -sub add_object +sub add_object($self, $plist) { - my ($self, $plist) = @_; my $sub = $subclass->{$self->{mode}}; if (!defined $sub) { die "unknown mode for \@define-tag"; @@ -1541,16 +1422,15 @@ sub add_object $self->SUPER::add_object($plist); } -sub destate +sub destate($, $) { } package OpenBSD::PackingElement::DefineTag::Atend; our @ISA = qw(OpenBSD::PackingElement::DefineTag); -sub add_tag +sub add_tag($self, $tag, $mode, $state) { - my ($self, $tag, $mode, $state) = @_; # add the tag contents if they exist # they're stored in a hash because the order doesn't matter if ($tag->{params} ne '') { @@ -1567,9 +1447,8 @@ sub add_tag } } -sub run_tag +sub run_tag($self, $state) { - my ($self, $state) = @_; my $command = $self->command; if ($command =~ m/\%D/) { $command =~ s/\%D/$state->{localbase}/g; @@ -1594,18 +1473,16 @@ sub run_tag } } -sub need_params +sub need_params($self) { - my $self = shift; return $self->{params} =~ m/\%[lu]/; } package OpenBSD::PackingElement::DefineTag::Cleanup; our @ISA = qw(OpenBSD::PackingElement::DefineTag); -sub add_tag +sub add_tag($self, $tag, $mode, $state) { - my ($self, $tag, $mode, $state) = @_; # okay, we don't need to look at directories if we're not deleting return unless $mode eq 'delete'; # this does not work at all like 'at-end' @@ -1613,7 +1490,7 @@ sub add_tag push(@{$state->{tag_cleanup}{$tag->{expanded}}}, $self); } -sub need_params +sub need_params($) { 1 } @@ -1621,13 +1498,12 @@ sub need_params package OpenBSD::PackingElement::DefineTag::Supersedes; our @ISA = qw(OpenBSD::PackingElement::DefineTag); -sub add_tag +sub add_tag($self, $tag, $, $state) { - my ($self, $tag, $mode, $state) = @_; $state->{tags}{superseded}{$self->{params}} = 1; } -sub need_params +sub need_params($) { 0 } @@ -1635,133 +1511,125 @@ sub need_params package OpenBSD::PackingElement::Exec; our @ISA=qw(OpenBSD::PackingElement::ExeclikeAction); -sub keyword() { "exec" } +sub keyword($) { "exec" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::ExecAlways; our @ISA=qw(OpenBSD::PackingElement::Exec); -sub keyword() { "exec-always" } +sub keyword($) { "exec-always" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::ExecAdd; our @ISA=qw(OpenBSD::PackingElement::Exec); -sub keyword() { "exec-add" } +sub keyword($) { "exec-add" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::ExecUpdate; our @ISA=qw(OpenBSD::PackingElement::Exec); -sub keyword() { "exec-update" } +sub keyword($) { "exec-update" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::Unexec; our @ISA=qw(OpenBSD::PackingElement::ExeclikeAction); -sub keyword() { "unexec" } +sub keyword($) { "unexec" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::UnexecAlways; our @ISA=qw(OpenBSD::PackingElement::Unexec); -sub keyword() { "unexec-always" } +sub keyword($) { "unexec-always" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::UnexecUpdate; our @ISA=qw(OpenBSD::PackingElement::Unexec); -sub keyword() { "unexec-update" } +sub keyword($) { "unexec-update" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::UnexecDelete; our @ISA=qw(OpenBSD::PackingElement::Unexec); -sub keyword() { "unexec-delete" } +sub keyword($) { "unexec-delete" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::ExtraUnexec; our @ISA=qw(OpenBSD::PackingElement::ExeclikeAction); -sub keyword() { "extraunexec" } +sub keyword($) { "extraunexec" } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::DirlikeObject; our @ISA=qw(OpenBSD::PackingElement::FileObject); +# XXX mix-in class, see comment at top of file package OpenBSD::PackingElement::DirBase; our @ISA=qw(OpenBSD::PackingElement::DirlikeObject); -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $state->{lastdir} = $self; $self->SUPER::destate($state); } -sub stringize +sub stringize($self) { - my $self = shift; return $self->name."/"; } -sub write +sub write($self, $fh) { - my ($self, $fh) = @_; $self->SUPER::write($fh); } package OpenBSD::PackingElement::Dir; our @ISA=qw(OpenBSD::PackingElement::DirBase); -sub keyword() { "dir" } +sub keyword($) { "dir" } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->SUPER::destate($state); $self->compute_modes($state); } -sub needs_keyword +sub needs_keyword($self) { - my $self = shift; return $self->stringize =~ m/\^@/o; } package OpenBSD::PackingElement::Infodir; our @ISA=qw(OpenBSD::PackingElement::Dir); -sub keyword() { "info" } -sub needs_keyword() { 1 } +sub keyword($) { "info" } +sub needs_keyword($) { 1 } package OpenBSD::PackingElement::Fontdir; our @ISA=qw(OpenBSD::PackingElement::Dir); -sub keyword() { "fontdir" } +sub keyword($) { "fontdir" } __PACKAGE__->register_with_factory; -sub needs_keyword() { 1 } -sub dirclass() { "OpenBSD::PackingElement::Fontdir" } +sub needs_keyword($) { 1 } +sub dirclass($) { "OpenBSD::PackingElement::Fontdir" } -sub install +sub install($self, $state) { - my ($self, $state) = @_; $self->SUPER::install($state); $state->log("You may wish to update your font path for #1", $self->fullname) unless $self->fullname =~ /^\/usr\/local\/share\/fonts/; $state->{recorder}{fonts_todo}{$state->{destdir}.$self->fullname} = 1; } -sub reload +sub reload($self, $state) { - my ($self, $state) = @_; $state->{recorder}{fonts_todo}{$state->{destdir}.$self->fullname} = 1; } -sub update_fontalias +sub _update_fontalias($state, $dirname) { - my ($state, $dirname) = @_; - my $alias_name = "$dirname/fonts.alias"; if ($state->verbose > 1) { $state->say("Assembling #1 from #2", @@ -1784,9 +1652,8 @@ sub update_fontalias } } -sub restore_fontdir +sub _restore_fontdir($state, $dirname) { - my ($state, $dirname) = @_; if (-f "$dirname/fonts.dir.dist") { unlink("$dirname/fonts.dir"); @@ -1795,10 +1662,8 @@ sub restore_fontdir } } -sub run_if_exists +sub _run_if_exists($state, $cmd, @l) { - my ($state, $cmd, @l) = @_; - if (-x $cmd) { $state->vsystem($cmd, @l); } else { @@ -1806,9 +1671,8 @@ sub run_if_exists } } -sub finish +sub finish($class, $state) { - my ($class, $state) = @_; return if $state->{not}; my @l = keys %{$state->{recorder}->{fonts_todo}}; @@ -1818,12 +1682,12 @@ sub finish $state->print("Updating font cache: ") if $state->verbose < 2; require OpenBSD::Error; - map { update_fontalias($state, $_) } @l; - run_if_exists($state, OpenBSD::Paths->mkfontscale, '--', @l); - run_if_exists($state, OpenBSD::Paths->mkfontdir, '--', @l); - map { restore_fontdir($state, $_) } @l; + map { _update_fontalias($state, $_) } @l; + _run_if_exists($state, OpenBSD::Paths->mkfontscale, '--', @l); + _run_if_exists($state, OpenBSD::Paths->mkfontdir, '--', @l); + map { _restore_fontdir($state, $_) } @l; - run_if_exists($state, OpenBSD::Paths->fc_cache, '--', @l); + _run_if_exists($state, OpenBSD::Paths->fc_cache, '--', @l); $state->say("ok") if $state->verbose < 2; } } @@ -1832,31 +1696,30 @@ sub finish package OpenBSD::PackingElement::Mandir; our @ISA=qw(OpenBSD::PackingElement::Dir); -sub keyword() { "mandir" } +sub keyword($) { "mandir" } __PACKAGE__->register_with_factory; -sub needs_keyword() { 1 } -sub dirclass() { "OpenBSD::PackingElement::Mandir" } +sub needs_keyword($) { 1 } +sub dirclass($) { "OpenBSD::PackingElement::Mandir" } package OpenBSD::PackingElement::Extra; our @ISA=qw(OpenBSD::PackingElement::FileObject); -sub keyword() { 'extra' } -sub absolute_okay() { 1 } +sub keyword($) { 'extra' } +sub absolute_okay($) { 1 } __PACKAGE__->register_with_factory; -sub destate +sub destate($self, $state) { - my ($self, $state) = @_; $self->compute_fullname($state); } -sub dirclass() { "OpenBSD::PackingElement::Extradir" } +sub dirclass($) { "OpenBSD::PackingElement::Extradir" } package OpenBSD::PackingElement::Extradir; our @ISA=qw(OpenBSD::PackingElement::DirBase OpenBSD::PackingElement::Extra); -sub absolute_okay() { 1 } +sub absolute_okay($) { 1 } -sub destate +sub destate # forwarder { &OpenBSD::PackingElement::Extra::destate; } @@ -1864,62 +1727,58 @@ sub destate package OpenBSD::PackingElement::ExtraGlob; our @ISA=qw(OpenBSD::PackingElement::FileObject); -sub keyword() { 'extraglob' } -sub absolute_okay() { 1 } +sub keyword($) { 'extraglob' } +sub absolute_okay($) { 1 } __PACKAGE__->register_with_factory; package OpenBSD::PackingElement::SpecialFile; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub add_digest +sub add_digest # forwarder { &OpenBSD::PackingElement::FileBase::add_digest; } -sub add_size +sub add_size # forwarder { &OpenBSD::PackingElement::FileBase::add_size; } -sub add_timestamp +sub add_timestamp($, $) { # just don't } -sub compute_digest +sub compute_digest # forwarder { &OpenBSD::PackingElement::FileObject::compute_digest; } -sub write +sub write # forwarder { &OpenBSD::PackingElement::FileBase::write; } -sub needs_keyword { 0 } +sub needs_keyword($) { 0 } -sub add_object +sub add_object($self, $plist) { - my ($self, $plist) = @_; $self->{infodir} = $plist->{infodir}; $self->SUPER::add_object($plist); } -sub infodir +sub infodir($self) { - my $self = shift; return ${$self->{infodir}}; } -sub stringize +sub stringize($self) { - my $self = shift; return $self->category; } -sub fullname +sub fullname($self) { - my $self = shift; my $d = $self->infodir; if (defined $d) { return $d.$self->name; @@ -1928,21 +1787,18 @@ sub fullname } } -sub category +sub category($self) { - my $self = shift; - return $self->name; } -sub new +sub new # forwarder { &OpenBSD::PackingElement::UniqueOption::new; } -sub may_verify_digest +sub may_verify_digest($self, $state) { - my ($self, $state) = @_; if (!$state->{check_digest}) { return; } @@ -1962,35 +1818,34 @@ sub may_verify_digest package OpenBSD::PackingElement::FCONTENTS; our @ISA=qw(OpenBSD::PackingElement::SpecialFile); -sub name() { OpenBSD::PackageInfo::CONTENTS } +sub name($) { OpenBSD::PackageInfo::CONTENTS } # XXX we don't write `self' -sub write +sub write($, $) {} -sub copy_shallow_if +sub copy_shallow_if($, $, $) { } -sub copy_deep_if +sub copy_deep_if($, $, $) { } # CONTENTS doesn't have a checksum -sub may_verify_digest +sub may_verify_digest($, $) { } package OpenBSD::PackingElement::FDESC; our @ISA=qw(OpenBSD::PackingElement::SpecialFile); -sub name() { OpenBSD::PackageInfo::DESC } +sub name($) { OpenBSD::PackageInfo::DESC } package OpenBSD::PackingElement::DisplayFile; our @ISA=qw(OpenBSD::PackingElement::SpecialFile); use OpenBSD::Error; -sub prepare +sub prepare($self, $state) { - my ($self, $state) = @_; my $fname = $self->fullname; if (open(my $src, '<', $fname)) { while (<$src>) { @@ -2006,36 +1861,32 @@ sub prepare package OpenBSD::PackingElement::FDISPLAY; our @ISA=qw(OpenBSD::PackingElement::DisplayFile); -sub name() { OpenBSD::PackageInfo::DISPLAY } +sub name($) { OpenBSD::PackageInfo::DISPLAY } package OpenBSD::PackingElement::FUNDISPLAY; our @ISA=qw(OpenBSD::PackingElement::DisplayFile); -sub name() { OpenBSD::PackageInfo::UNDISPLAY } +sub name($) { OpenBSD::PackageInfo::UNDISPLAY } package OpenBSD::PackingElement::Arch; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub category() { 'arch' } -sub keyword() { 'arch' } +sub category($) { 'arch' } +sub keyword($) { 'arch' } __PACKAGE__->register_with_factory; -sub new +sub new($class, $args) { - my ($class, $args) = @_; my @arches= split(/\,/o, $args); bless { arches => \@arches }, $class; } -sub stringize($) +sub stringize($self) { - my $self = $_[0]; return join(',', @{$self->{arches}}); } -sub check +sub check($self, $forced_arch = undef) { - my ($self, $forced_arch) = @_; - for my $ok (@{$self->{arches}}) { return 1 if $ok eq '*'; if (defined $forced_arch) { @@ -2048,17 +1899,16 @@ sub check return 1 if $ok eq OpenBSD::Paths->machine_architecture; return 1 if $ok eq OpenBSD::Paths->architecture; } - return; + return 0; } package OpenBSD::PackingElement::Signer; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub keyword() { 'signer' } +sub keyword($) { 'signer' } __PACKAGE__->register_with_factory; -sub category() { "signer" } -sub new +sub category($) { "signer" } +sub new($class, $args) { - my ($class, $args) = @_; unless ($args =~ m/^[\w\d\.\-\+\@]+$/) { die "Invalid characters in signer $args"; } @@ -2066,7 +1916,7 @@ sub new } # don't incorporate this into compared signatures -sub write_without_variation +sub write_without_variation($, $) { } @@ -2076,31 +1926,29 @@ sub write_without_variation package OpenBSD::PackingElement::DigitalSignature; our @ISA=qw(OpenBSD::PackingElement::Unique); -sub keyword() { 'digital-signature' } +sub keyword($) { 'digital-signature' } __PACKAGE__->register_with_factory; -sub category() { "digital-signature" } +sub category($) { "digital-signature" } # parse to and from a subset of iso8601 # # allows us to represent timestamps in a human readable format without # any ambiguity -sub time_to_iso8601 +sub _time_to_iso8601($time) { - my $time = shift; my ($sec, $min, $hour, $day, $month, $year, @rest) = gmtime($time); return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $year+1900, $month+1, $day, $hour, $min, $sec); } -sub iso8601 +sub iso8601($self) { - my $self = shift; - return time_to_iso8601($self->{timestamp}); + return _time_to_iso8601($self->{timestamp}); } -sub iso8601_to_time +sub _iso8601_to_time($s) { - if ($_[0] =~ m/^(\d{4})\-(\d{2})\-(\d{2})T(\d{2})\:(\d{2})\:(\d{2})Z$/) { + if ($s =~ m/^(\d{4})\-(\d{2})\-(\d{2})T(\d{2})\:(\d{2})\:(\d{2})Z$/) { my ($year, $month, $day, $hour, $min, $sec) = ($1 - 1900, $2-1, $3, $4, $5, $6); require POSIX; @@ -2114,41 +1962,37 @@ sub iso8601_to_time } return $t; } else { - die "Incorrect ISO8601 timestamp: $_[0]"; + die "Incorrect ISO8601 timestamp: $s"; } } -sub new +sub new($class, $args) { - my ($class, $args) = @_; my ($key, $tsbase, $tsmin, $tssec, $signature) = split(/\:/, $args); - my $timestamp = iso8601_to_time("$tsbase:$tsmin:$tssec"); + my $timestamp = _iso8601_to_time("$tsbase:$tsmin:$tssec"); bless { key => $key, timestamp => $timestamp, b64sig => $signature }, $class; } -sub blank +sub blank($class, $type) { - my ($class, $type) = @_; bless { key => $type, timestamp => time, b64sig => '' }, $class; } -sub stringize +sub stringize($self) { - my $self = shift; - return join(':', $self->{key}, time_to_iso8601($self->{timestamp}), + return join(':', $self->{key}, _time_to_iso8601($self->{timestamp}), $self->{b64sig}); } -sub write_no_sig +sub write_no_sig($self, $fh) { - my ($self, $fh) = @_; - print $fh "\@", $self->keyword, " ", $self->{key}, ":", - time_to_iso8601($self->{timestamp}), "\n"; + say $fh "\@", $self->keyword, " ", $self->{key}, ":", + _time_to_iso8601($self->{timestamp}); } # don't incorporate this into compared signatures -sub write_without_variation +sub write_without_variation($, $) { } @@ -2157,18 +2001,16 @@ our @ISA=qw(OpenBSD::PackingElement); my $warned; -sub new +sub new($class, $k, $args) { - my ($class, $k, $args) = @_; bless { keyword => $k, name => $args }, $class; } -sub add +sub add($o, $plist, $args) { - my ($o, $plist, $args) = @_; my $keyword = $$o; if (!$warned->{$keyword}) { - print STDERR "Warning: obsolete construct: \@$keyword $args\n"; + say STDERR "Warning: obsolete construct: \@$keyword $args"; $warned->{$keyword} = 1; } my $o2 = OpenBSD::PackingElement::Old->new($keyword, $args); @@ -2177,15 +2019,13 @@ sub add return undef; } -sub keyword +sub keyword($self) { - my $self = shift; return $self->{keyword}; } -sub register_old_keyword +sub register_old_keyword($class, $k) { - my ($class, $k) = @_; $class->register_with_factory($k, bless \$k, $class); } @@ -2197,9 +2037,8 @@ for my $k (qw(src display mtree ignore_inst dirrm pkgcfl pkgdep newdepend # pkgpath objects are parsed in extrainfo and pkgpath objects # so that erroneous pkgpaths will be flagged early package OpenBSD::PkgPath; -sub new +sub new($class, $fullpkgpath) { - my ($class, $fullpkgpath) = @_; my ($dir, @mandatory) = split(/\,/, $fullpkgpath); my $o = bless {dir => $dir, @@ -2207,7 +2046,7 @@ sub new }, $class; my @sub = grep {/^\-/} @mandatory; if (@sub > 1) { - print STDERR "Invalid $fullpkgpath (multiple subpackages)\n"; + say STDERR "Invalid $fullpkgpath (multiple subpackages)"; exit 1; } if (@sub == 1) { @@ -2216,9 +2055,8 @@ sub new return $o; } -sub fullpkgpath +sub fullpkgpath($self) { - my ($self) = @_; if(%{$self->{mandatory}}) { my $m = join(",", keys %{$self->{mandatory}}); return "$self->{dir},$m"; @@ -2231,9 +2069,8 @@ sub fullpkgpath # remove them all. So, keep a full hash of everything we have (has), and # when stuff $to_rm matches, remove them from $from. # We match when we're left with nothing. -sub trim +sub trim($self, $has, $from, $to_rm) { - my ($self, $has, $from, $to_rm) = @_; for my $f (keys %$to_rm) { if ($has->{$f}) { delete $from->{$f}; @@ -2245,9 +2082,8 @@ sub trim } # basic match: after mandatory, nothing left -sub match2 +sub match2($self, $has, $h) { - my ($self, $has, $h) = @_; if (keys %$h) { return 0; } else { @@ -2256,9 +2092,8 @@ sub match2 } # zap mandatory, check that what's left is okay. -sub match +sub match($self, $other) { - my ($self, $other) = @_; # make a copy of options my %h = %{$other->{mandatory}}; if (!$self->trim($other->{mandatory}, \%h, $self->{mandatory})) { @@ -2274,9 +2109,8 @@ sub match package OpenBSD::PkgPath::WithOpts; our @ISA = qw(OpenBSD::PkgPath); -sub new +sub new($class, $fullpkgpath) { - my ($class, $fullpkgpath) = @_; my @opts = (); while ($fullpkgpath =~ s/\[\,(.*?)\]//) { push(@opts, {map {($_, 1)} split(/\,/, $1) }); @@ -2292,9 +2126,8 @@ sub new # match with options: systematically trim any optional part that fully # matches, until we're left with nothing, or some options keep happening. -sub match2 +sub match2($self, $has, $h) { - my ($self, $has, $h) = @_; if (!keys %$h) { return 1; } diff --git a/usr.sbin/pkg_add/OpenBSD/PackingList.pm b/usr.sbin/pkg_add/OpenBSD/PackingList.pm index 6d38e284d44..50ab0008c19 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackingList.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackingList.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackingList.pm,v 1.151 2023/05/17 21:15:03 espie Exp $ +# $OpenBSD: PackingList.pm,v 1.152 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -15,15 +15,13 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackingList::State; my $dot = '.'; -sub new +sub new($class) { - my $class = shift; bless { default_owner=>'root', default_group=>'bin', default_mode=> 0444, @@ -32,15 +30,13 @@ sub new cwd=>\$dot}, $class; } -sub cwd +sub cwd($self) { - return ${$_[0]->{cwd}}; + return ${$self->{cwd}}; } -sub set_cwd +sub set_cwd($self, $p) { - my ($self, $p) = @_; - require File::Spec; $p = File::Spec->canonpath($p); @@ -48,9 +44,8 @@ sub set_cwd } package OpenBSD::PackingList::hashpath; -sub match +sub match($h, $plist) { - my ($h, $plist) = @_; my $f = $plist->fullpkgpath2; if (!defined $f) { return 0; @@ -63,9 +58,8 @@ sub match return 0; } -sub partial_match +sub partial_match($h, $subdir) { - my ($h, $subdir) = @_; for my $dir (keys %$h) { return 1 if $dir =~ m/\b\Q$subdir\E\b/; } @@ -103,53 +97,45 @@ our @ISA = qw(OpenBSD::Composite); use OpenBSD::PackingElement; use OpenBSD::PackageInfo; -sub element_class { "OpenBSD::PackingElement" } +sub element_class($) { "OpenBSD::PackingElement" } -sub new +sub new($class) { - my $class = shift; my $plist = bless {state => OpenBSD::PackingList::State->new, infodir => \(my $d)}, $class; OpenBSD::PackingElement::File->add($plist, CONTENTS); return $plist; } -sub set_infodir +sub set_infodir($self, $dir) { - my ($self, $dir) = @_; $dir .= '/' unless $dir =~ m/\/$/o; ${$self->{infodir}} = $dir; } -sub make_shallow_copy +sub make_shallow_copy($plist, $h) { - my ($plist, $h) = @_; - my $copy = ref($plist)->new; $copy->set_infodir($plist->infodir); $plist->copy_shallow_if($copy, $h); return $copy; } -sub make_deep_copy +sub make_deep_copy($plist, $h) { - my ($plist, $h) = @_; - my $copy = ref($plist)->new; $copy->set_infodir($plist->infodir); $plist->copy_deep_if($copy, $h); return $copy; } -sub infodir +sub infodir($self) { - my $self = shift; return ${$self->{infodir}}; } -sub zap_wrong_annotations +sub zap_wrong_annotations($self) { - my $self = shift; my $pkgname = $self->pkgname; if (defined $pkgname && $pkgname =~ m/^(?:\.libs\d*|partial)\-/) { delete $self->{'manual-installation'}; @@ -159,29 +145,24 @@ sub zap_wrong_annotations } } -sub conflict_list +sub conflict_list($self) { require OpenBSD::PkgCfl; - my $self = shift; return OpenBSD::PkgCfl->make_conflict_list($self); } -my $subclass; - -sub read +sub read($a, $u, $code = \&defaultCode) { - my ($a, $u, $code) = @_; + $code //= \&defaultCode; # XXX callers may pass undef for now my $plist; - $code = \&defaultCode if !defined $code; if (ref $a) { $plist = $a; } else { $plist = $a->new; } &$code($u, - sub { - my $line = shift; + sub($line) { return if $line =~ m/^\s*$/o; OpenBSD::PackingElement->create($line, $plist); }); @@ -189,67 +170,60 @@ sub read return $plist; } -sub defaultCode +sub defaultCode($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { &$cont($_); } } -sub SharedItemsOnly +sub SharedItemsOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { next unless m/^\@(?:cwd|dir|fontdir|ghost|mandir|newuser|newgroup|name)\b/o || m/^\@(?:sample|extra)\b.*\/$/o || m/^[^\@].*\/$/o; &$cont($_); } } -sub UpdatePlistOnly +sub UpdatePlistOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { next unless m/^\@(?:cwd|dir|fontdir|ghost|mandir|depend)\b/o || m/^\@(?:sample|extra)\b.*\/$/o || m/^[^\@].*\/$/o; &$cont($_); } } -sub DirrmOnly +sub DirrmOnly # forwarder { &OpenBSD::PackingList::SharedItemsOnly; } -sub LibraryOnly +sub LibraryOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { next unless m/^\@(?:cwd|lib|name|comment\s+subdir\=)\b/o; &$cont($_); } } -sub FilesOnly +sub FilesOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { next unless m/^\@(?:cwd|name|info|man|file|lib|shell|sample|bin|rcscript|so|static-lib)\b/o || !m/^\@/o; &$cont($_); } } -sub PrelinkStuffOnly +sub PrelinkStuffOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { next unless m/^\@(?:cwd|bin|lib|name|define-tag|libset|depend|wantlib|comment\s+ubdir\=)\b/o; &$cont($_); } } -sub DependOnly +sub DependOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { if (m/^\@(?:libset|depend|wantlib|define-tag)\b/o) { &$cont($_); @@ -260,9 +234,8 @@ sub DependOnly } } -sub ExtraInfoOnly +sub ExtraInfoOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { if (m/^\@(?:name|pkgpath|comment\s+(?:subdir|pkgpath)\=|option)\b/o) { &$cont($_); @@ -273,9 +246,8 @@ sub ExtraInfoOnly } } -sub UpdateInfoOnly +sub UpdateInfoOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { # if old alwaysupdate, all info is sig # if new, we don't need the rest @@ -295,9 +267,8 @@ sub UpdateInfoOnly } } -sub ConflictOnly +sub ConflictOnly($fh, $cont) { - my ($fh, $cont) = @_; while (<$fh>) { if (m/^\@(?:name|conflict|option)\b/o) { &$cont($_); @@ -308,9 +279,8 @@ sub ConflictOnly } } -sub fromfile +sub fromfile($a, $fname, $code = \&defaultCode) { - my ($a, $fname, $code) = @_; open(my $fh, '<', $fname) or return; my $plist; eval { @@ -325,9 +295,8 @@ sub fromfile return $plist; } -sub tofile +sub tofile($self, $fname) { - my ($self, $fname) = @_; open(my $fh, '>', $fname) or return; $self->zap_wrong_annotations; $self->write($fh); @@ -335,22 +304,19 @@ sub tofile return 1; } -sub save +sub save($self) { - my $self = shift; $self->tofile($self->infodir.CONTENTS); } -sub add2list +sub add2list($plist, $object) { - my ($plist, $object) = @_; my $category = $object->category; push @{$plist->{$category}}, $object; } -sub addunique +sub addunique($plist, $object) { - my ($plist, $object) = @_; my $category = $object->category; if (defined $plist->{$category}) { die "Duplicate $category in plist ".($plist->pkgname // "?"); @@ -358,21 +324,18 @@ sub addunique $plist->{$category} = $object; } -sub has +sub has($plist, $name) { - my ($plist, $name) = @_; return defined $plist->{$name}; } -sub get +sub get($plist, $name) { - my ($plist, $name) = @_; return $plist->{$name}; } -sub set_pkgname +sub set_pkgname($self, $name) { - my ($self, $name) = @_; if (defined $self->{name}) { $self->{name}->set_name($name); } else { @@ -380,9 +343,8 @@ sub set_pkgname } } -sub pkgname +sub pkgname($self) { - my $self = shift; if (defined $self->{name}) { return $self->{name}->name; } else { @@ -390,10 +352,8 @@ sub pkgname } } -sub localbase +sub localbase($self) { - my $self = shift; - if (defined $self->{localbase}) { return $self->{localbase}->name; } else { @@ -401,15 +361,13 @@ sub localbase } } -sub is_signed +sub is_signed($self) { - my $self = shift; return defined $self->{'digital-signature'}; } -sub fullpkgpath +sub fullpkgpath($self) { - my $self = shift; if (defined $self->{extrainfo} && $self->{extrainfo}{subdir} ne '') { return $self->{extrainfo}{subdir}; } else { @@ -417,9 +375,8 @@ sub fullpkgpath } } -sub fullpkgpath2 +sub fullpkgpath2($self) { - my $self = shift; if (defined $self->{extrainfo} && $self->{extrainfo}{subdir} ne '') { return $self->{extrainfo}{path}; } else { @@ -427,9 +384,8 @@ sub fullpkgpath2 } } -sub pkgpath +sub pkgpath($self) { - my $self = shift; if (!defined $self->{_hashpath}) { my $h = $self->{_hashpath} = bless {}, "OpenBSD::PackingList::hashpath"; @@ -446,9 +402,8 @@ sub pkgpath return $self->{_hashpath}; } -sub match_pkgpath +sub match_pkgpath($self, $plist2) { - my ($self, $plist2) = @_; return $self->pkgpath->match($plist2) || $plist2->pkgpath->match($self); } @@ -463,10 +418,8 @@ our @list_categories = our @cache_categories = (qw(libset depend wantlib)); -sub visit +sub visit($self, $method, @l) { - my ($self, $method, @l) = @_; - if (defined $self->{cvstags}) { for my $item (@{$self->{cvstags}}) { $item->$method(@l) unless $item->{deleted}; @@ -495,14 +448,11 @@ sub visit my $plist_cache = {}; -sub from_installation +sub from_installation($o, $pkgname, $code = \&defaultCode) { - my ($o, $pkgname, $code) = @_; - require OpenBSD::PackageInfo; $code //= \&defaultCode; - if ($code == \&DependOnly && defined $plist_cache->{$pkgname}) { return $plist_cache->{$pkgname}; } @@ -523,9 +473,8 @@ sub from_installation return $plist; } -sub to_cache +sub to_cache($self) { - my ($self) = @_; return if defined $plist_cache->{$self->pkgname}; my $plist = OpenBSD::PackingList->new; for my $c (@cache_categories) { @@ -536,10 +485,8 @@ sub to_cache $plist_cache->{$self->pkgname} = $plist; } -sub to_installation +sub to_installation($self) { - my ($self) = @_; - require OpenBSD::PackageInfo; return if $main::not; @@ -547,14 +494,8 @@ sub to_installation $self->tofile(OpenBSD::PackageInfo::installed_contents($self->pkgname)); } -sub forget -{ -} - -sub signature +sub signature($self) { - my $self = shift; - require OpenBSD::Signature; return OpenBSD::Signature->from_plist($self); } diff --git a/usr.sbin/pkg_add/OpenBSD/Paths.pm b/usr.sbin/pkg_add/OpenBSD/Paths.pm index 6f5b7e6ad77..291d38bb459 100644 --- a/usr.sbin/pkg_add/OpenBSD/Paths.pm +++ b/usr.sbin/pkg_add/OpenBSD/Paths.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Paths.pm,v 1.39 2023/05/19 07:37:11 espie Exp $ +# $OpenBSD: Paths.pm,v 1.40 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2014 Marc Espie # @@ -15,76 +15,74 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::Paths; # Commands -sub ldconfig { '/sbin/ldconfig' } -sub chroot { '/usr/sbin/chroot' } -sub mkfontscale { '/usr/X11R6/bin/mkfontscale' } -sub mkfontdir { '/usr/X11R6/bin/mkfontdir' } -sub fc_cache { '/usr/X11R6/bin/fc-cache' } -sub install_info { '/usr/bin/install-info' } -sub useradd { '/usr/sbin/useradd' } -sub groupadd { '/usr/sbin/groupadd' } -sub sysctl { '/sbin/sysctl' } -sub openssl { '/usr/bin/openssl' } -sub pkgca { '/etc/ssl/pkgca.pem' } -sub signify { '/usr/bin/signify' } -sub signifykey { my $s = $_[1]; "/etc/signify/$s.pub" } -sub pkg_add { '/usr/sbin/pkg_add' } -sub chmod { '/bin/chmod' } # external command is used for symbolic modes. -sub gzip { '/usr/bin/gzip' } -sub ftp { $ENV{'FETCH_CMD'} || '/usr/bin/ftp' } -sub groff { '/usr/local/bin/groff' } -sub sh { '/bin/sh' } -sub arch { '/usr/bin/arch' } -sub uname { '/usr/bin/uname' } -sub userdel { '/usr/sbin/userdel' } -sub groupdel { '/usr/sbin/groupdel' } -sub makewhatis { '/usr/sbin/makewhatis' } -sub mknod { '/sbin/mknod' } -sub mount { '/sbin/mount' } -sub df { '/bin/df' } -sub ssh { '/usr/bin/ssh' } -sub make { '/usr/bin/make' } -sub mklocatedb { '/usr/libexec/locate.mklocatedb' } -sub locate { '/usr/bin/locate' } -sub hostname { '/bin/hostname' } -sub doas { '/usr/bin/doas' } -sub env { '/usr/bin/env' } -sub du { '/usr/bin/du' } -sub diff { '/usr/bin/diff' } -sub sha256 { '/bin/sha256' } +sub ldconfig($) { '/sbin/ldconfig' } +sub chroot($) { '/usr/sbin/chroot' } +sub mkfontscale($) { '/usr/X11R6/bin/mkfontscale' } +sub mkfontdir($) { '/usr/X11R6/bin/mkfontdir' } +sub fc_cache($) { '/usr/X11R6/bin/fc-cache' } +sub install_info($) { '/usr/bin/install-info' } +sub useradd($) { '/usr/sbin/useradd' } +sub groupadd($) { '/usr/sbin/groupadd' } +sub sysctl($) { '/sbin/sysctl' } +sub openssl($) { '/usr/bin/openssl' } +sub pkgca($) { '/etc/ssl/pkgca.pem' } +sub signify($) { '/usr/bin/signify' } +sub signifykey($,$k) { "/etc/signify/$k.pub" } +sub pkg_add($) { '/usr/sbin/pkg_add' } +sub chmod($) { '/bin/chmod' } # external command is used for symbolic modes. +sub gzip($) { '/usr/bin/gzip' } +sub ftp($) { $ENV{'FETCH_CMD'} || '/usr/bin/ftp' } +sub groff($) { '/usr/local/bin/groff' } +sub sh($) { '/bin/sh' } +sub arch($) { '/usr/bin/arch' } +sub uname($) { '/usr/bin/uname' } +sub userdel($) { '/usr/sbin/userdel' } +sub groupdel($) { '/usr/sbin/groupdel' } +sub makewhatis($) { '/usr/sbin/makewhatis' } +sub mknod($) { '/sbin/mknod' } +sub mount($) { '/sbin/mount' } +sub df($) { '/bin/df' } +sub ssh($) { '/usr/bin/ssh' } +sub make($) { '/usr/bin/make' } +sub mklocatedb($) { '/usr/libexec/locate.mklocatedb' } +sub locate($) { '/usr/bin/locate' } +sub hostname($) { '/bin/hostname' } +sub doas($) { '/usr/bin/doas' } +sub env($) { '/usr/bin/env' } +sub du($) { '/usr/bin/du' } +sub diff($) { '/usr/bin/diff' } +sub sha256($) { '/bin/sha256' } # Various paths -sub shells { '/etc/shells' } -sub pkgdb { '/var/db/pkg' } -sub localbase { '/usr/local' } -sub vartmp { '/tmp' } -sub portsdir { '/usr/ports' } +sub shells($) { '/etc/shells' } +sub pkgdb($) { '/var/db/pkg' } +sub localbase($) { '/usr/local' } +sub vartmp($) { '/tmp' } +sub portsdir($) { '/usr/ports' } -sub library_dirs { ("/usr", "/usr/X11R6") } -sub master_keys { ("/etc/master_key") } -sub installurl { "/etc/installurl" } -sub srclocatedb { "/usr/lib/locate/src.db" } -sub xlocatedb { "/usr/X11R6/lib/locate/xorg.db" } -sub updateinfodb { '/usr/local/share/update.db' } +sub library_dirs($) { ("/usr", "/usr/X11R6") } +sub master_keys($) { ("/etc/master_key") } +sub installurl($) { "/etc/installurl" } +sub srclocatedb($) { "/usr/lib/locate/src.db" } +sub xlocatedb($) { "/usr/X11R6/lib/locate/xorg.db" } +sub updateinfodb($) { '/usr/local/share/update.db' } -sub font_cruft { ("fonts.alias", "fonts.dir", "fonts.cache-1", "fonts.scale") } -sub man_cruft { ("whatis.db", "mandoc.db", "mandoc.index") } -sub info_cruft { ("dir") } +sub font_cruft($) { ("fonts.alias", "fonts.dir", "fonts.cache-1", "fonts.scale") } +sub man_cruft($) { ("whatis.db", "mandoc.db", "mandoc.index") } +sub info_cruft($) { ("dir") } # a bit of code, OS-dependent stuff that's run-time detected and has no # home yet. my ($machine_arch, $arch, $osversion, $osdirectory); -sub architecture +sub architecture($self) { - my $self = shift; if (!defined $arch) { my $cmd = $self->uname." -m"; chomp($arch = `$cmd`); @@ -92,9 +90,8 @@ sub architecture return $arch; } -sub machine_architecture +sub machine_architecture($self) { - my $self = shift; if (!defined $machine_arch) { my $cmd = $self->arch." -s"; chomp($machine_arch = `$cmd`); @@ -102,9 +99,8 @@ sub machine_architecture return $machine_arch; } -sub compute_osversion +sub compute_osversion($self) { - my $self = shift; open my $cmd, '-|', $self->sysctl, '-n', 'kern.version'; my $line = <$cmd>; close($cmd); @@ -118,18 +114,16 @@ sub compute_osversion } } -sub os_version +sub os_version($self) { - my $self = shift; if (!defined $osversion) { $self->compute_osversion; } return $osversion; } -sub os_directory +sub os_directory($self) { - my $self = shift; if (!defined $osversion) { $self->compute_osversion; } diff --git a/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm b/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm index da35e24e521..b21e7a21526 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm @@ -1,7 +1,7 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: PkgAdd.pm,v 1.140 2023/05/21 16:07:35 espie Exp $ +# $OpenBSD: PkgAdd.pm,v 1.141 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -17,16 +17,14 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::AddDelete; package OpenBSD::PackingList; -sub uses_old_libs +sub uses_old_libs($plist, $state) { - my ($plist, $state) = @_; require OpenBSD::RequiredBy; if (grep {/^\.libs\d*\-/o} @@ -39,9 +37,8 @@ sub uses_old_libs } } -sub has_different_sig +sub has_different_sig($plist, $state) { - my ($plist, $state) = @_; if (!defined $plist->{different_sig}) { my $n = OpenBSD::PackingList->from_installation($plist->pkgname, @@ -71,26 +68,24 @@ sub has_different_sig } package OpenBSD::PackingElement; -sub hash_files +sub hash_files($, $, $) { } -sub tie_files +sub tie_files($, $, $) { } package OpenBSD::PackingElement::FileBase; -sub hash_files +sub hash_files($self, $state, $sha) { - my ($self, $state, $sha) = @_; return if $self->{link} or $self->{symlink} or $self->{nochecksum}; if (defined $self->{d}) { $sha->{$self->{d}->key}{$self->name} = $self; } } -sub tie_files +sub tie_files($self, $state, $sha) { - my ($self, $state, $sha) = @_; return if $self->{link} or $self->{symlink} or $self->{nochecksum}; # XXX python doesn't like this, overreliance on timestamps @@ -141,9 +136,8 @@ sub tie_files package OpenBSD::PkgAdd::State; our @ISA = qw(OpenBSD::AddDelete::State); -sub handle_options +sub handle_options($state) { - my $state = shift; $state->SUPER::handle_options('druUzl:A:P:', '[-adcinqrsUuVvxz] [-A arch] [-B pkg-destdir] [-D name[=value]]', '[-L localbase] [-l file] [-P type] pkg-name ...'); @@ -176,8 +170,7 @@ sub handle_options } OpenBSD::Auto::cache(cache_directory, - sub { - my $self = shift; + sub($) { if (defined $ENV{PKG_CACHE}) { return $ENV{PKG_CACHE}; } else { @@ -186,8 +179,7 @@ OpenBSD::Auto::cache(cache_directory, }); OpenBSD::Auto::cache(debug_cache_directory, - sub { - my $self = shift; + sub($) { if (defined $ENV{DEBUG_PKG_CACHE}) { return $ENV{DEBUG_PKG_CACHE}; } else { @@ -195,58 +187,49 @@ OpenBSD::Auto::cache(debug_cache_directory, } }); -sub set_name_from_handle +sub set_name_from_handle($state, $h, $extra = '') { - my ($state, $h, $extra) = @_; - $extra //= ''; $state->log->set_context($extra.$h->pkgname); } -sub updateset +sub updateset($self) { - my $self = shift; require OpenBSD::UpdateSet; return OpenBSD::UpdateSet->new($self); } -sub updateset_with_new +sub updateset_with_new($self, $pkgname) { - my ($self, $pkgname) = @_; - return $self->updateset->add_newer( OpenBSD::Handle->create_new($pkgname)); } -sub updateset_from_location +sub updateset_from_location($self, $location) { - my ($self, $location) = @_; - return $self->updateset->add_newer( OpenBSD::Handle->from_location($location)); } -sub display_timestamp +sub display_timestamp($state, $pkgname, $timestamp) { - my ($state, $pkgname, $timestamp) = @_; $state->say("#1 signed on #2", $pkgname, $timestamp); } OpenBSD::Auto::cache(updater, - sub { + sub($) { require OpenBSD::Update; return OpenBSD::Update->new; }); OpenBSD::Auto::cache(tracker, - sub { + sub($) { require OpenBSD::Tracker; return OpenBSD::Tracker->new; }); -sub tweak_header +sub tweak_header($state, $info = undef) { - my ($state, $info) = @_; my $header = $state->{setheader}; if (defined $info) { @@ -271,15 +254,13 @@ sub tweak_header package OpenBSD::ConflictCache; our @ISA = (qw(OpenBSD::Cloner)); -sub new +sub new($class) { - my $class = shift; bless {done => {}, c => {}}, $class; } -sub add +sub add($self, $handle, $state) { - my ($self, $handle, $state) = @_; return if $self->{done}{$handle}; $self->{done}{$handle} = 1; for my $conflict (OpenBSD::PkgCfl::find_all($handle, $state)) { @@ -287,15 +268,13 @@ sub add } } -sub list +sub list($self) { - my $self = shift; return keys %{$self->{c}}; } -sub merge +sub merge($self, @extra) { - my ($self, @extra) = @_; $self->clone('c', @extra); $self->clone('done', @extra); } @@ -304,10 +283,8 @@ package OpenBSD::UpdateSet; use OpenBSD::PackageInfo; use OpenBSD::Handle; -sub setup_header +sub setup_header($set, $state, $handle = undef, $info = undef) { - my ($set, $state, $handle, $info) = @_; - my $header = $state->deptree_header($set); if (defined $handle) { $header .= $handle->pkgname; @@ -322,16 +299,14 @@ sub setup_header my $checked = {}; -sub check_security +sub check_security($set, $state, $plist, $h) { - my ($set, $state, $plist, $h) = @_; return if $checked->{$plist->fullpkgpath}; $checked->{$plist->fullpkgpath} = 1; return if $set->{quirks}; my ($error, $bad); $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { return unless $quirks->can("check_security"); $bad = $quirks->check_security($plist->fullpkgpath); if (defined $bad) { @@ -349,18 +324,15 @@ sub check_security } } -sub display_timestamp +sub display_timestamp($pkgname, $plist, $state) { - my ($pkgname, $plist, $state) = @_; - return unless $plist->is_signed; $state->display_timestamp($pkgname, $plist->get('digital-signature')->iso8601); } -sub find_kept_handle +sub find_kept_handle($set, $n, $state) { - my ($set, $n, $state) = @_; my $plist = $n->dependency_info; return if !defined $plist; my $pkgname = $plist->pkgname; @@ -404,36 +376,29 @@ sub find_kept_handle $n->cleanup; } -sub figure_out_kept +sub figure_out_kept($set, $state) { - my ($set, $state) = @_; - for my $n ($set->newer) { $set->find_kept_handle($n, $state); } } -sub precomplete_handle +sub precomplete_handle($set, $n, $state) { - my ($set, $n, $state) = @_; unless (defined $n->{location} && defined $n->{location}{update_info}) { $n->complete($state); } } -sub precomplete +sub precomplete($set, $state) { - my ($set, $state) = @_; - for my $n ($set->newer) { $set->precomplete_handle($n, $state); } } -sub complete +sub complete($set, $state) { - my ($set, $state) = @_; - for my $n ($set->newer) { $n->complete($state); my $plist = $n->plist; @@ -446,6 +411,7 @@ sub complete $o->complete_old; } + $set->propagate_manual_install; my $check = $set->install_issues($state); return 0 if !defined $check; @@ -457,10 +423,8 @@ sub complete return 1; } -sub find_conflicts +sub find_conflicts($set, $state) { - my ($set, $state) = @_; - my $c = $set->conflict_cache; for my $handle ($set->newer) { @@ -469,10 +433,8 @@ sub find_conflicts return $c->list; } -sub mark_as_manual_install +sub mark_as_manual_install($set) { - my $set = shift; - for my $handle ($set->newer) { my $plist = $handle->plist; $plist->has('manual-installation') or @@ -480,9 +442,25 @@ sub mark_as_manual_install } } -sub updates +# during complex updates, we don't really know which of the older set updates +# to the newer one (well, we have a bit more information, but it is complicated +# thanks to quirks), so better safe than sorry. +sub propagate_manual_install($set) +{ + my $manual_install = 0; + + for my $old ($set->older) { + if ($old->plist->has('manual-installation')) { + $manual_install = 1; + } + } + if ($manual_install) { + $set->mark_as_manual_install; + } +} + +sub updates($n, $plist) { - my ($n, $plist) = @_; if (!$n->location->update_info->match_pkgpath($plist)) { return 0; } @@ -497,9 +475,8 @@ sub updates return 1; } -sub is_an_update_from +sub is_an_update_from($set, @conflicts) { - my ($set, @conflicts) = @_; LOOP: for my $c (@conflicts) { next if $c =~ m/^\.libs\d*\-/; next if $c =~ m/^partial\-/; @@ -515,10 +492,8 @@ LOOP: for my $c (@conflicts) { return 1; } -sub install_issues +sub install_issues($set, $state) { - my ($set, $state) = @_; - my @conflicts = $set->find_conflicts($state); if (@conflicts == 0) { @@ -562,9 +537,6 @@ sub install_issues return if $later; - - my $manual_install = 0; - for my $old ($set->older) { my $name = $old->pkgname; @@ -576,20 +548,12 @@ sub install_issues $name); } - if ($old->plist->has('manual-installation')) { - $manual_install = 1; - } } - - $set->mark_as_manual_install if $manual_install; - return 0; } -sub try_merging +sub try_merging($set, $m, $state) { - my ($set, $m, $state) = @_; - my $s = $state->tracker->is_to_update($m); if (!defined $s) { $s = $state->updateset->add_older( @@ -606,10 +570,8 @@ sub try_merging } } -sub check_forward_dependencies +sub check_forward_dependencies($set, $state) { - my ($set, $state) = @_; - require OpenBSD::ForwardDependencies; $set->{forward} = OpenBSD::ForwardDependencies->find($set); my $bad = $set->{forward}->check($state); @@ -644,10 +606,8 @@ sub check_forward_dependencies return 1; } -sub recheck_conflicts +sub recheck_conflicts($set, $state) { - my ($set, $state) = @_; - # no conflicts between newer sets nor kept sets for my $h ($set->newer, $set->kept) { for my $h2 ($set->newer, $set->kept) { @@ -674,9 +634,8 @@ use OpenBSD::Add; use OpenBSD::UpdateSet; use OpenBSD::Error; -sub failed_message +sub failed_message($base_msg, $received = undef, @l) { - my ($base_msg, $received, @l) = @_; my $msg = $base_msg; if ($received) { $msg = "Caught SIG$received. $msg"; @@ -687,10 +646,8 @@ sub failed_message return $msg; } -sub save_partial_set +sub save_partial_set($set, $state) { - my ($set, $state) = @_; - return () if $state->{not}; my @l = (); for my $h ($set->newer) { @@ -700,45 +657,42 @@ sub save_partial_set return @l; } -sub partial_install +sub partial_install($base_msg, $set, $state) { - my ($base_msg, $set, $state) = @_; return failed_message($base_msg, $state->{received}, save_partial_set($set, $state)); } # quick sub to build the dependency arcs for older packages # newer packages are handled by Dependencies.pm -sub build_before +sub build_before(@p) { - my %known = map {($_->pkgname, 1)} @_; + my %known = map {($_->pkgname, 1)} @p; require OpenBSD::RequiredBy; - for my $c (@_) { + for my $c (@p) { for my $d (OpenBSD::RequiredBy->new($c->pkgname)->list) { push(@{$c->{before}}, $d) if $known{$d}; } } } -sub okay +sub okay($h, $c) { - my ($h, $c) = @_; - for my $d (@{$c->{before}}) { return 0 if !$h->{$d}; } return 1; } -sub iterate +sub iterate(@p) { - my $sub = pop @_; + my $sub = pop @p; my $done = {}; my $something_done; do { $something_done = 0; - for my $c (@_) { + for my $c (@p) { next if $done->{$c->pkgname}; if (okay($done, $c)) { &$sub($c); @@ -748,20 +702,17 @@ sub iterate } } while ($something_done); # if we can't do stuff in order, do it anyway - for my $c (@_) { + for my $c (@p) { next if $done->{$c->pkgname}; &$sub($c); } } -sub delete_old_packages +sub delete_old_packages($set, $state) { - my ($set, $state) = @_; - build_before($set->older_to_do); - iterate($set->older_to_do, sub { + iterate($set->older_to_do, sub($o) { return if $state->{size_only}; - my $o = shift; $set->setup_header($state, $o, "deleting"); my $oldname = $o->pkgname; $state->set_name_from_handle($o, '-'); @@ -784,9 +735,8 @@ sub delete_old_packages # Here there should be code to handle old libs } -sub delayed_delete +sub delayed_delete($state) { - my $state = shift; for my $realname (@{$state->{delayed}}) { if (!unlink $realname) { $state->errsay("Problem deleting #1: #2", $realname, @@ -797,10 +747,8 @@ sub delayed_delete delete $state->{delayed}; } -sub really_add +sub really_add($set, $state) { - my ($set, $state) = @_; - my $errors = 0; # XXX in `combined' updates, some dependencies may remove extra @@ -812,7 +760,7 @@ sub really_add } $state->{replacing} = $replacing; - my $handler = sub { + my $handler = sub { # SIGHANDLER $state->{received} = shift; $state->errsay("Interrupted"); if ($state->{hardkill}) { @@ -862,9 +810,8 @@ sub really_add delete_old_packages($set, $state); } - iterate($set->newer, sub { + iterate($set->newer, sub($handle) { return if $state->{size_only}; - my $handle = shift; my $pkgname = $handle->pkgname; my $plist = $handle->plist; @@ -916,10 +863,8 @@ sub really_add } } -sub newer_has_errors +sub newer_has_errors($set, $state) { - my ($set, $state) = @_; - for my $handle ($set->newer) { if ($handle->has_error(OpenBSD::Handle::ALREADY_INSTALLED)) { $set->cleanup(OpenBSD::Handle::ALREADY_INSTALLED); @@ -939,10 +884,8 @@ sub newer_has_errors return 0; } -sub newer_is_bad_arch +sub newer_is_bad_arch($set, $state) { - my ($set, $state) = @_; - for my $handle ($set->newer) { if ($handle->plist->has('arch')) { unless ($handle->plist->{arch}->check($state->{arch})) { @@ -961,9 +904,8 @@ sub newer_is_bad_arch return 0; } -sub may_tie_files +sub may_tie_files($set, $state) { - my ($set, $state) = @_; if ($set->newer > 0 && $set->older_to_do > 0 && !$state->defines('donttie')) { my $sha = {}; @@ -981,10 +923,8 @@ sub may_tie_files } } -sub process_set +sub process_set($self, $set, $state) { - my ($self, $set, $state) = @_; - $state->{current_set} = $set; if (!$state->updater->process_set($set, $state)) { @@ -1125,9 +1065,8 @@ sub process_set return (); } -sub may_grab_debug_for +sub may_grab_debug_for($class, $orig, $kept, $state) { - my ($class, $orig, $kept, $state) = @_; return if $orig =~ m/^debug\-/; my $dbg = "debug-$orig"; return if $state->tracker->is_known($dbg); @@ -1137,10 +1076,8 @@ sub may_grab_debug_for $class->grab_debug_package($d, $dbg, $state); } -sub grab_debug_package +sub grab_debug_package($class, $d, $dbg, $state) { - my ($class, $d, $dbg, $state) = @_; - my $o = $state->locator->find($dbg); return if !defined $o; require OpenBSD::Temp; @@ -1172,14 +1109,12 @@ sub grab_debug_package } } -sub inform_user_of_problems +sub inform_user_of_problems($state) { - my $state = shift; my @cantupdate = $state->tracker->cant_list; if (@cantupdate > 0) { $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $quirks->filter_obsolete(\@cantupdate, $state); }); @@ -1202,9 +1137,8 @@ sub inform_user_of_problems } # if we already have quirks, we update it. If not, we try to install it. -sub quirk_set +sub quirk_set($state) { - my $state = shift; require OpenBSD::Search; my $set = $state->updateset; @@ -1218,17 +1152,15 @@ sub quirk_set return $set; } -sub do_quirks +sub do_quirks($self, $state) { - my ($self, $state) = @_; my $set = quirk_set($state); $self->process_set($set, $state); } -sub process_parameters +sub process_parameters($self, $state) { - my ($self, $state) = @_; my $add_hints = $state->{fuzzy} ? "add_hints" : "add_hints2"; # match against a list @@ -1279,9 +1211,8 @@ sub process_parameters } } -sub finish_display +sub finish_display($self, $state) { - my ($self, $state) = @_; OpenBSD::Add::manpages_index($state); # and display delayed thingies. @@ -1293,21 +1224,16 @@ sub finish_display inform_user_of_problems($state); } -sub tweak_list +sub tweak_list($self, $state) { - my ($self, $state) = @_; - $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $quirks->tweak_list($state->{setlist}, $state); }); } -sub main +sub main($self, $state) { - my ($self, $state) = @_; - $state->progress->set_header(''); $self->do_quirks($state); @@ -1315,9 +1241,8 @@ sub main } -sub new_state +sub new_state($self, $cmd) { - my ($self, $cmd) = @_; return OpenBSD::PkgAdd::State->new($cmd); } diff --git a/usr.sbin/pkg_add/OpenBSD/PkgCfl.pm b/usr.sbin/pkg_add/OpenBSD/PkgCfl.pm index 19b8c0958a4..8d5dfe4c485 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgCfl.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgCfl.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PkgCfl.pm,v 1.40 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: PkgCfl.pm,v 1.41 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2005 Marc Espie # @@ -15,7 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; +use v5.36; use warnings; package OpenBSD::PkgCfl; @@ -23,9 +23,8 @@ use OpenBSD::PackageName; use OpenBSD::Search; use OpenBSD::PackageInfo; -sub make_conflict_list +sub make_conflict_list($class, $plist) { - my ($class, $plist) = @_; my $l = []; my $pkgname = $plist->pkgname; my $stem = OpenBSD::PackageName::splitstem($pkgname); @@ -43,9 +42,8 @@ sub make_conflict_list bless $l, $class; } -sub conflicts_with +sub conflicts_with($self, @pkgnames) { - my ($self, @pkgnames) = @_; my @libs = grep {/^\.libs\d*\-/} @pkgnames; @pkgnames = grep {!/^\.libs\d*\-/} @pkgnames; if (wantarray) { @@ -68,22 +66,18 @@ sub conflicts_with } } -sub register +sub register($plist, $state) { - my ($plist, $state) = @_; - $state->{conflict_list}{$plist->pkgname} = $plist->conflict_list; } -sub unregister +sub unregister($plist, $state) { - my ($plist, $state) = @_; delete $state->{conflict_list}{$plist->pkgname}; } -sub fill_conflict_lists +sub fill_conflict_lists($state) { - my $state = shift; for my $pkg (installed_packages()) { my $plist = OpenBSD::PackingList->from_installation($pkg, \&OpenBSD::PackingList::ConflictOnly); @@ -96,9 +90,8 @@ sub fill_conflict_lists } } -sub find +sub find($pkgname, $state) { - my ($pkgname, $state) = @_; my @bad = (); if (is_installed $pkgname) { push(@bad, $pkgname); @@ -118,10 +111,8 @@ sub find return @bad; } -sub find_all +sub find_all($plist, $state) { - my ($plist, $state) = @_; - my @first = $plist->conflict_list->conflicts_with(installed_packages()); # XXX optimization if (@first > 0 && !$state->{allow_replacing}) { diff --git a/usr.sbin/pkg_add/OpenBSD/PkgCheck.pm b/usr.sbin/pkg_add/OpenBSD/PkgCheck.pm index c64ae758a1f..f8b67640da3 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgCheck.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgCheck.pm @@ -1,7 +1,7 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: PkgCheck.pm,v 1.78 2023/05/22 12:05:57 espie Exp $ +# $OpenBSD: PkgCheck.pm,v 1.79 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -17,16 +17,14 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::AddCreateDelete; package Installer::State; our @ISA = qw(OpenBSD::PkgAdd::State); -sub new +sub new($class, $cmd) { - my ($class, $cmd) = @_; my $state = $class->SUPER::new($cmd); $state->{localbase} = OpenBSD::Paths->localbase; return $state; @@ -35,9 +33,8 @@ sub new package Installer; our @ISA = qw(OpenBSD::PkgAdd); -sub new +sub new($class, $mystate) { - my ($class, $mystate) = @_; my $state = Installer::State->new("pkg_check"); $state->{v} = $mystate->{v}; $state->{subst} = $mystate->{subst}; @@ -48,9 +45,8 @@ sub new bless { state => $state}, $class; } -sub install +sub install($self, $pkg) { - my ($self, $pkg) = @_; my $state = $self->{state}; push(@{$state->{setlist}}, $state->updateset->add_hints2($pkg)); @@ -59,46 +55,45 @@ sub install } package OpenBSD::PackingElement; -sub thorough_check +sub thorough_check($self, $state) { - my ($self, $state) = @_; $self->basic_check($state); } -sub basic_check +sub basic_check($, $) { 1 } -sub find_dependencies +# $self->find_dpendencies($state, $l, $checker, $pkgname) +sub find_dependencies($, $, $, $, $) { } -sub mark_indirect_depends +# XXX this is a snag for ShareLibs OO-ness +# $self->mark_indirect_depends($pkgname, $state) +sub mark_indirect_depends($self, $pkgname, $state) { - my ($self, $pkgname, $state) = @_; $self->mark_available_lib($pkgname, $state->shlibs); } -sub cache_depends +# $self->cache_depends($copy) +sub cache_depends($, $) { } package OpenBSD::PackingElement::DefineTag; -sub mark_indirect_depends +sub mark_indirect_depends($self, $pkgname, $state) { - my ($self, $pkgname, $state) = @_; $state->{tagdefinition}{$self->name} = $pkgname; } package OpenBSD::PackingElement::FileBase; use File::Basename; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; - my $name = $state->destdir($self->fullname); $state->{known}{dirname($name)}{basename($name)} = 1; if ($self->{symlink}) { @@ -151,9 +146,8 @@ sub basic_check return 1; } -sub thorough_check +sub thorough_check($self, $state) { - my ($self, $state) = @_; my $name = $state->destdir($self->fullname); if (!$self->basic_check($state)) { return; @@ -174,20 +168,19 @@ sub thorough_check } package OpenBSD::PackingElement::SpecialFile; -sub basic_check +sub basic_check # forwarder { &OpenBSD::PackingElement::FileBase::basic_check; } -sub thorough_check +sub thorough_check # forwarder { &OpenBSD::PackingElement::FileBase::basic_check; } package OpenBSD::PackingElement::DirlikeObject; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; my $name = $state->destdir($self->fullname); $state->{known}{$name} //= {}; if (!-e $name) { @@ -200,27 +193,24 @@ sub basic_check package OpenBSD::PackingElement::Sample; use File::Basename; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; my $name = $state->destdir($self->fullname); $state->{known}{dirname($name)}{basename($name)} = 1; return 1; } package OpenBSD::PackingElement::Sampledir; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; my $name = $state->destdir($self->fullname); $state->{known}{$name} //= {}; return 1; } package OpenBSD::PackingElement::Mandir; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; $self->SUPER::basic_check($state); my $name = $state->destdir($self->fullname); for my $file (OpenBSD::Paths::man_cruft()) { @@ -230,9 +220,8 @@ sub basic_check } package OpenBSD::PackingElement::Fontdir; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; $self->SUPER::basic_check($state); my $name = $state->destdir($self->fullname); for my $i (qw(fonts.alias fonts.scale fonts.dir)) { @@ -242,9 +231,8 @@ sub basic_check } package OpenBSD::PackingElement::Infodir; -sub basic_check +sub basic_check($self, $state) { - my ($self, $state) = @_; $self->SUPER::basic_check($state); my $name = $state->destdir($self->fullname); $state->{known}{$name}{'dir'} = 1; @@ -252,16 +240,14 @@ sub basic_check } package OpenBSD::PackingElement::Depend; -sub cache_depends +sub cache_depends($self, $copy) { - my ($self, $copy) = @_; $self->add_object($copy); } package OpenBSD::PackingElement::Dependency; -sub find_dependencies +sub find_dependencies($self, $state, $l, $checker, $pkgname) { - my ($self, $state, $l, $checker, $pkgname) = @_; # several ways to failure if (!$self->spec->is_valid) { $state->log("invalid \@", $self->keyword, " ", @@ -286,9 +272,8 @@ sub find_dependencies } package OpenBSD::PackingElement::Wantlib; -sub find_dependencies +sub find_dependencies($self, $state, $l, $checker, $pkgname) { - my ($self, $state, $l, $checker, $pkgname) = @_; my $r = $state->shlibs->lookup_libspec($state->{localbase}, $self->spec); if (defined $r && @$r != 0) { @@ -313,9 +298,8 @@ sub find_dependencies } package OpenBSD::PackingElement::Tag; -sub find_dependencies +sub find_dependencies($self, $state, $l, $checker, $pkgname) { - my ($self, $state, $l, $checker, $pkgname) = @_; my $location = $state->{tagdefinition}{$self->name}; if (defined $location) { if ($location eq $pkgname) { @@ -329,7 +313,7 @@ sub find_dependencies } } -sub cache_depends +sub cache_depends # forwarder { &OpenBSD::PackingElement::Depend::cache_depends; } @@ -341,26 +325,23 @@ use File::Spec; use OpenBSD::Log; use File::Basename; -sub init +sub init($self) { - my $self = shift; $self->{l} = OpenBSD::Log->new($self); $self->SUPER::init; } -sub log +sub log($self, @p) { - my $self = shift; - if (@_ == 0) { + if (@p == 0) { return $self->{l}; } else { - $self->{l}->say(@_); + $self->{l}->say(@p); } } -sub handle_options +sub handle_options($self) { - my $self = shift; $self->{no_exports} = 1; $self->add_interactive_options; @@ -379,24 +360,21 @@ sub handle_options } } -sub destdir +sub destdir($self, $path) { - my ($self, $path) = @_; return File::Spec->canonpath($self->{destdir}.$path); } -sub process_entry +sub process_entry($self, $entry) { - my ($self, $entry) = @_; my $name = $self->destdir($entry); $self->{known}{dirname($name)}{basename($name)} = 1; } package OpenBSD::DependencyCheck; -sub new +sub new($class, $state, $name, $req) { - my ($class, $state, $name, $req) = @_; my $o = bless { not_yet => {}, possible => {}, @@ -415,9 +393,8 @@ sub new return $o; } -sub find +sub find($self, $name) { - my ($self, $name) = @_; if ($self->{possible}{$name}) { delete $self->{not_yet}{$name}; return 1; @@ -426,15 +403,13 @@ sub find } } -sub not_found +sub not_found($self, $name) { - my ($self, $name) = @_; $self->{others}{$name} = 1; } -sub ask_delete_deps +sub ask_delete_deps($self, $state, $l) { - my ($self, $state, $l) = @_; if ($state->{force}) { $self->{req}->delete(@$l); } elsif ($state->confirm_defaults_to_no( @@ -443,9 +418,8 @@ sub ask_delete_deps } } -sub ask_add_deps +sub ask_add_deps($self, $state, $l) { - my ($self, $state, $l) = @_; if ($state->{force}) { $self->{req}->add(@$l); } elsif ($state->confirm_defaults_to_no( @@ -454,9 +428,8 @@ sub ask_add_deps } } -sub adjust +sub adjust($self, $state) { - my ($self, $state) = @_; if (keys %{$self->{not_yet}} > 0) { my @todo = sort keys %{$self->{not_yet}}; unless ($state->{subst}->value("weed_libs")) { @@ -483,15 +456,13 @@ sub adjust package OpenBSD::DirectDependencyCheck; our @ISA = qw(OpenBSD::DependencyCheck); use OpenBSD::RequiredBy; -sub string +sub string($self, @p) { - my $self = shift; - return "dependencies: ". join(' ', @_); + return "dependencies: ". join(' ', @p); } -sub new +sub new($class, $state, $name) { - my ($class, $state, $name) = @_; return $class->SUPER::new($state, $name, OpenBSD::Requiring->new($name)); } @@ -499,40 +470,34 @@ sub new package OpenBSD::ReverseDependencyCheck; our @ISA = qw(OpenBSD::DependencyCheck); use OpenBSD::RequiredBy; -sub string +sub string($self, @p) { - my $self = shift; - return "reverse dependencies: ". join(' ', @_); + return "reverse dependencies: ". join(' ', @p); } -sub new +sub new($class, $state, $name) { - my ($class, $state, $name) = @_; return $class->SUPER::new($state, $name, OpenBSD::RequiredBy->new($name)); } package OpenBSD::Pkglocate; -sub new +sub new($class, $state) { - my ($class, $state) = @_; bless {state => $state, result => {unknown => []}, params => []}, $class; } -sub add_param +sub add_param($self, @p) { - my ($self, @p) = @_; push(@{$self->{params}}, @p); while (@{$self->{params}} > 200) { $self->run_command; } } -sub run_command +sub run_command($self) { - my $self = shift; - if (@{$self->{params}} == 0) { return; } @@ -556,9 +521,8 @@ sub run_command $self->{params} = []; } -sub result +sub result($self) { - my $self = shift; while (@{$self->{params}} > 0) { $self->run_command; } @@ -589,9 +553,8 @@ use File::Find; use OpenBSD::Paths; use OpenBSD::Mtree; -sub fill_base_system +sub fill_base_system($self, $state) { - my ($self, $state) = @_; open(my $cmd, '-|', 'locate', '-d', OpenBSD::Paths->srclocatedb, '-d', OpenBSD::Paths->xlocatedb, ':'); @@ -603,9 +566,8 @@ sub fill_base_system close($cmd); } -sub remove +sub remove($self, $state, $name) { - my ($self, $state, $name) = @_; $state->{removed}{$name} = 1; my $dir = installed_info($name); for my $i (@OpenBSD::PackageInfo::info) { @@ -641,9 +603,8 @@ sub remove } } -sub may_remove +sub may_remove($self, $state, $name) { - my ($self, $state, $name) = @_; if ($state->{force}) { $self->remove($state, $name); } elsif ($state->confirm_defaults_to_no( @@ -653,9 +614,8 @@ sub may_remove $state->{bogus}{$name} = 1; } -sub may_unlink +sub may_unlink($self, $state, $path) { - my ($self, $state, $path) = @_; if (!$state->{force} && !$state->confirm_defaults_to_no("Remove #1", $path)) { return; @@ -668,9 +628,8 @@ sub may_unlink $state->errsay("Couldn't delete #1: #2", $path, $!); } -sub may_fix_ownership +sub may_fix_ownership($self, $state, $path) { - my ($self, $state, $path) = @_; if (!$state->{force} && !$state->confirm_defaults_to_no("Give #1 to root:wheel", $path)) { return; @@ -683,10 +642,8 @@ sub may_fix_ownership $state->errsay("Couldn't fix ownership for #1: #2", $path, $!); } -sub may_fix_perms +sub may_fix_perms($self, $state, $path, $perm, $readable) { - my ($self, $state, $path, $perm, $readable) = @_; - if (!$state->{force} && !$state->confirm_defaults_to_no("Make #1 #2", $path, ($readable ? "not world/group-writable" : "world readable"))) { @@ -700,24 +657,21 @@ sub may_fix_perms $state->errsay("Couldn't fix perms for #1: #2", $path, $!); } -sub for_all_packages +sub for_all_packages($self, $state, $l, $msg, $code) { - my ($self, $state, $l, $msg, $code) = @_; - $state->progress->for_list($msg, $l, - sub { - return if $state->{removed}{$_[0]}; - if ($state->{bogus}{$_[0]}) { - $state->errsay("skipping #1", $_[0]); + sub($name) { + return if $state->{removed}{$name}; + if ($state->{bogus}{$name}) { + $state->errsay("skipping #1", $name); return; } - &$code; + &$code($name); }); } -sub check_dir_permissions +sub check_dir_permissions($self, $state, $dir) { - my ($self, $state, $dir) = @_; my ($perm, $uid, $gid) = (stat $dir)[2, 4, 5]; $perm &= 0777; @@ -738,10 +692,8 @@ sub check_dir_permissions } } -sub check_permissions +sub check_permissions($self, $state, $dir) { - my ($self, $state, $dir) = @_; - $self->check_dir_permissions($state, $dir); opendir(my $d, $dir) or return; for my $name (readdir $d) { @@ -781,17 +733,14 @@ sub check_permissions } -sub sanity_check +sub sanity_check($self, $state, $l) { - my ($self, $state, $l) = @_; - # let's find /var/db/pkg or its equivalent my $base = installed_info(""); $base =~ s,/*$,,; $self->check_dir_permissions($state, $base); - $self->for_all_packages($state, $l, "Packing-list sanity", sub { - my $name = shift; + $self->for_all_packages($state, $l, "Packing-list sanity", sub($name) { if ($name ne $state->safe($name)) { $state->errsay("#1: bogus pkgname", $name); $self->may_remove($state, $name); @@ -846,12 +795,10 @@ sub sanity_check }); } -sub dependencies_check +sub dependencies_check($self, $state, $l) { - my ($self, $state, $l) = @_; $state->shlibs->add_libs_from_system($state->{destdir}); - $self->for_all_packages($state, $l, "Direct dependencies", sub { - my $name = shift; + $self->for_all_packages($state, $l, "Direct dependencies", sub($name) { $state->log->set_context($name); my $plist = $state->{plist_cache}{$name}; my $checker = OpenBSD::DirectDependencyCheck->new($state, @@ -866,11 +813,9 @@ sub dependencies_check delete $state->{plist_cache}; } -sub reverse_dependencies_check +sub reverse_dependencies_check($self, $state, $l) { - my ($self, $state, $l) = @_; - $self->for_all_packages($state, $l, "Reverse dependencies", sub { - my $name = shift; + $self->for_all_packages($state, $l, "Reverse dependencies", sub($name) { my $checker = OpenBSD::ReverseDependencyCheck->new($state, $name); for my $i (@{$state->{reverse}{$name}}) { @@ -880,11 +825,9 @@ sub reverse_dependencies_check }); } -sub package_files_check +sub package_files_check($self, $state, $l) { - my ($self, $state, $l) = @_; - $self->for_all_packages($state, $l, "Files from packages", sub { - my $name = shift; + $self->for_all_packages($state, $l, "Files from packages", sub($name) { my $plist = OpenBSD::PackingList->from_installation($name); $state->log->set_context($name); if ($state->{quick}) { @@ -896,10 +839,8 @@ sub package_files_check }); } -sub install_pkglocate +sub install_pkglocate($self, $state) { - my ($self, $state) = @_; - my $spec = 'pkglocatedb->=1.1'; my @l = installed_stems()->find('pkglocatedb'); @@ -924,9 +865,8 @@ sub install_pkglocate } # non fancy display of unknown objects -sub display_unknown +sub display_unknown($self, $state) { - my ($self, $state) = @_; if (defined $state->{unknown}{file}) { $state->say("Unknown files:"); for my $e (sort @{$state->{unknown}{file}}) { @@ -941,9 +881,8 @@ sub display_unknown } } -sub display_tmps +sub display_tmps($self, $state) { - my ($self, $state) = @_; $state->say("Unregistered temporary files:"); for my $e (sort @{$state->{tmps}}) { $state->say("\t#1", $e); @@ -955,39 +894,36 @@ sub display_tmps } } -sub display_unregs +sub display_unregs($self, $state) { - my ($self, $state) = @_; $state->say("System libs NOT in locate dbs:"); for my $e (sort @{$state->{unreg_libs}}) { $state->say("\t#1", $e); } } -sub locate_unknown +sub locate_unknown($self, $state) { - my ($self, $state) = @_; my $locator = OpenBSD::Pkglocate->new($state); if (defined $state->{unknown}{file}) { $state->progress->for_list("Locating unknown files", $state->{unknown}{file}, - sub { - $locator->add_param($_[0]); + sub($p) { + $locator->add_param($p); }); } if (defined $state->{unknown}{dir}) { $state->progress->for_list("Locating unknown directories", $state->{unknown}{dir}, - sub { - $locator->add_param($_[0]); + sub($p) { + $locator->add_param($p); }); } $locator->result($state); } -sub fill_localbase +sub fill_localbase($self, $state, $base) { - my ($self, $state, $base) = @_; for my $file (OpenBSD::Paths::man_cruft()) { $state->{known}{$base."/man"}{$file} = 1; } @@ -997,18 +933,16 @@ sub fill_localbase $state->{known}{$base."/libdata/perl5"} = {}; } -sub fill_root +sub fill_root($self, $state, $root) { - my ($self, $state, $root) = @_; OpenBSD::Mtree::parse($state->{known}, $root, '/etc/mtree/4.4BSD.dist', 1); OpenBSD::Mtree::parse($state->{known}, $root, '/etc/mtree/BSD.x11.dist', 1); } -sub filesystem_check +sub filesystem_check($self, $state) { - my ($self, $state) = @_; $state->{known} //= {}; $self->fill_localbase($state, $state->destdir(OpenBSD::Paths->localbase)); @@ -1017,7 +951,7 @@ sub filesystem_check $self->fill_base_system($state); $state->progress->set_header("Checking file system"); - find(sub { + find(sub() { $state->progress->working(1024); if (-d $_) { for my $i ('/dev', '/home', OpenBSD::Paths->pkgdb, '/var/log', '/var/backups', '/var/cron', '/var/run', '/tmp', '/var/tmp') { @@ -1078,10 +1012,8 @@ sub filesystem_check } } -sub run +sub run($self, $state) { - my ($self, $state) = @_; - my $list = [installed_packages()]; my $list2; @@ -1105,10 +1037,8 @@ sub run } } -sub parse_and_run +sub parse_and_run($self, $cmd) { - my ($self, $cmd) = @_; - my $state = OpenBSD::PkgCheck::State->new($cmd); $state->handle_options; lock_db(0, $state) unless $state->{subst}->value('nolock'); diff --git a/usr.sbin/pkg_add/OpenBSD/PkgCreate.pm b/usr.sbin/pkg_add/OpenBSD/PkgCreate.pm index 2b586a0ddad..a3954a504a2 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgCreate.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgCreate.pm @@ -1,6 +1,6 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: PkgCreate.pm,v 1.190 2023/05/23 10:02:46 espie Exp $ +# $OpenBSD: PkgCreate.pm,v 1.191 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -16,8 +16,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::AddCreateDelete; use OpenBSD::Dependencies::SolverBase; @@ -26,34 +25,28 @@ use OpenBSD::Signer; package OpenBSD::PkgCreate::State; our @ISA = qw(OpenBSD::CreateSign::State); -sub init +sub init($self, @p) { - my $self = shift; - $self->{stash} = {}; - $self->SUPER::init(@_); + $self->SUPER::init(@p); $self->{simple_status} = 0; } -sub stash +sub stash($self, $key) { - my ($self, $key) = @_; return $self->{stash}{$key}; } -sub error +sub error($self, $msg, @p) { - my $self = shift; - my $msg = shift; $self->{bad}++; $self->progress->disable; # XXX the actual format is $msg. - $self->errsay("Error: $msg", @_); + $self->errsay("Error: $msg", @p); } -sub set_status +sub set_status($self, $status) { - my ($self, $status) = @_; if ($self->{simple_status}) { print "\n$status"; } else { @@ -67,10 +60,8 @@ sub set_status } } -sub end_status +sub end_status($self) { - my $self = shift; - if ($self->{simple_status}) { print "\n"; } else { @@ -78,38 +69,32 @@ sub end_status } } -sub handle_options +sub handle_options($state) { - my $state = shift; - $state->{system_version} = 0; $state->{opt} = { 'f' => - sub { - push(@{$state->{contents}}, shift); + sub($opt) { + push(@{$state->{contents}}, $opt); }, 'p' => - sub { - $state->{prefix} = shift; + sub($opt) { + $state->{prefix} = $opt; }, - 'P' => sub { - my $d = shift; - $state->{dependencies}{$d} = 1; + 'P' => sub($opt) { + $state->{dependencies}{$opt} = 1; }, - 'V' => sub { - my $d = shift; - if ($d !~ m/^\d+$/) { + 'V' => sub($opt) { + if ($opt !~ m/^\d+$/) { $state->usage("-V option requires a number"); } - $state->{system_version} += $d; + $state->{system_version} += $opt; }, - 'w' => sub { - my $w = shift; - $state->{libset}{$w} = 1; + 'w' => sub($opt) { + $state->{libset}{$opt} = 1; }, - 'W' => sub { - my $w = shift; - $state->{wantlib}{$w} = 1; + 'W' => sub($opt) { + $state->{wantlib}{$opt} = 1; }, }; $state->{no_exports} = 1; @@ -137,9 +122,8 @@ sub handle_options $state->{no_ts_in_plist} = $state->defines('NO_TS_IN_PLIST'); } -sub parse_userdb +sub parse_userdb($self, $fname) { - my ($self, $fname) = @_; my $result = {}; my $bad = 0; open(my $fh, '<', $fname) or $bad = 1; @@ -195,34 +179,37 @@ use File::Basename; # Extra stuff needed to archive files package OpenBSD::PackingElement; -sub create_package +sub create_package($self, $state) { - my ($self, $state) = @_; - $self->archive($state); if ($state->verbose) { $self->comment_create_package($state); } } -sub pretend_to_archive +sub pretend_to_archive($self,$state) { - my ($self, $state) = @_; $self->comment_create_package($state); } -sub record_digest {} -sub stub_digest {} -sub archive {} -sub comment_create_package {} -sub grab_manpages {} -sub register_for_archival {} +# $self->record_digest($original, $entries, $new, $tail) +sub record_digest($, $, $, $, $) {} +# $self->stub_digest($ordered) +sub stub_digest($, $) {} +# $self->archive($state) +sub archive($, $) {} +# $self->comment_create_package($state) +sub comment_create_package($, $) {} +# $self->grab_manpages($state) +sub grab_manpages($, $) {} +# $self->register_for_archival($state) +sub register_for_archival($, $) {} -sub print_file {} +# $self->print_file +sub print_file($) {} -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - my ($self, $state) = @_; return unless $self->NoDuplicateNames; my $n = $self->fullname; if (defined $state->stash($n)) { @@ -231,29 +218,26 @@ sub avert_duplicates_and_other_checks $state->{stash}{$n} = 1; } -sub makesum_plist +sub makesum_plist($self, $state, $plist) { - my ($self, $state, $plist) = @_; $self->add_object($plist); } -sub verify_checksum +# $self->verify_checksum($state) +sub verify_checksum($, $) { } -sub register_forbidden +sub register_forbidden($self, $state) { - my ($self, $state) = @_; if ($self->is_forbidden) { push(@{$state->{forbidden}}, $self); } } -sub is_forbidden { 0 } -sub resolve_link +sub is_forbidden($) { 0 } +sub resolve_link($filename, $base, $level = 0) { - my ($filename, $base, $level) = @_; - $level //= 0; if (-l $filename) { my $l = readlink($filename); if ($level++ > 14) { @@ -269,9 +253,8 @@ sub resolve_link } } -sub compute_checksum +sub compute_checksum($self, $result, $state, $base) { - my ($self, $result, $state, $base) = @_; my $name = $self->fullname; my $fname = $name; my $okay = 1; @@ -337,17 +320,15 @@ sub compute_checksum return $okay; } -sub makesum_plist_with_base +sub makesum_plist_with_base($self, $plist, $state, $base) { - my ($self, $plist, $state, $base) = @_; if ($self->compute_checksum($self, $state, $base)) { $self->add_object($plist); } } -sub verify_checksum_with_base +sub verify_checksum_with_base($self, $state, $base) { - my ($self, $state, $base) = @_; my $check = ref($self)->new($self->name); if (!$self->compute_checksum($check, $state, $base)) { return; @@ -370,10 +351,8 @@ sub verify_checksum_with_base } -sub prepare_for_archival +sub prepare_for_archival($self, $state) { - my ($self, $state) = @_; - my $o = $state->{archive}->prepare_long($self); if (!$o->verify_modes($self)) { $state->error("modes don't match for #1", $self->fullname); @@ -384,54 +363,50 @@ sub prepare_for_archival return $o; } -sub discover_directories +# $self->discover_directories($state) +sub discover_directories($, $) { } -sub check_version +# $self->check_version($state, $unsubst) +sub check_version($, $, $) { } package OpenBSD::PackingElement::StreamMarker; our @ISA = qw(OpenBSD::PackingElement::Meta); -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub comment_create_package +sub comment_create_package($self, $state) { - my ($self, $state) = @_; $self->SUPER::comment_create_package($state); $state->say("Gzip: next chunk"); } -sub archive +sub archive($self, $state) { - my ($self, $state) = @_; $state->new_gstream; } package OpenBSD::PackingElement::LRUFrontier; our @ISA = qw(OpenBSD::PackingElement::Meta); -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub comment_create_package +sub comment_create_package($self, $state) { - my ($self, $state) = @_; $self->SUPER::comment_create_package($state); $state->say("LRU: end of modified files"); } package OpenBSD::PackingElement::RcScript; -sub set_destdir +sub set_destdir($self, $state) { - my ($self, $state) = @_; if ($self->name =~ m/^\//) { $state->{archive}->set_destdir($state->{base}); } else { @@ -440,63 +415,55 @@ sub set_destdir } package OpenBSD::PackingElement::SpecialFile; -sub record_digest +sub record_digest($self, $, $, $new, $) { - my ($self, $original, $entries, $new, $tail) = @_; push(@$new, $self); } -sub stub_digest +sub stub_digest($self, $ordered) { - my ($self, $ordered) = @_; push(@$ordered, $self); } -sub archive +sub archive # forwarder { &OpenBSD::PackingElement::FileBase::archive; } -sub pretend_to_archive +sub pretend_to_archive # forwarder { &OpenBSD::PackingElement::FileBase::pretend_to_archive; } -sub set_destdir +sub set_destdir($, $) { } -sub may_add +sub may_add($class, $subst, $plist, $opt) { - my ($class, $subst, $plist, $opt) = @_; if (defined $opt) { my $o = $class->add($plist); $subst->copy($opt, $o->fullname) if defined $o->fullname; } } -sub comment_create_package +sub comment_create_package($self, $state) { - my ($self, $state) = @_; $state->say("Adding #1", $self->name); } -sub makesum_plist +sub makesum_plist($self, $state, $plist) { - my ($self, $state, $plist) = @_; $self->makesum_plist_with_base($plist, $state, undef); } -sub verify_checksum +sub verify_checksum($self, $state) { - my ($self, $state) = @_; $self->verify_checksum_with_base($state, undef); } -sub prepare_for_archival +sub prepare_for_archival($self, $state) { - my ($self, $state) = @_; - my $o = $state->{archive}->prepare_long($self); $o->{uname} = 'root'; $o->{gname} = 'wheel'; @@ -506,65 +473,57 @@ sub prepare_for_archival return $o; } -sub forbidden { 1 } +sub forbidden($) { 1 } -sub register_for_archival +sub register_for_archival($self, $ordered) { - my ($self, $ordered) = @_; push(@$ordered, $self); } # override for CONTENTS: we cannot checksum this. package OpenBSD::PackingElement::FCONTENTS; -sub makesum_plist +sub makesum_plist($, $, $) { } -sub verify_checksum +sub verify_checksum($, $) { } -sub archive +sub archive($self, $state) { - my ($self, $state) = @_; $self->SUPER::archive($state); } -sub comment_create_package +sub comment_create_package($self, $state) { - my ($self, $state) = @_; $self->SUPER::comment_create_package($state); } -sub stub_digest +sub stub_digest($self, $ordered) { - my ($self, $ordered) = @_; push(@$ordered, $self); } package OpenBSD::PackingElement::Cwd; -sub archive +sub archive($, $) { - my ($self, $state) = @_; } -sub pretend_to_archive +sub pretend_to_archive($self, $state) { - my ($self, $state) = @_; $self->comment_create_package($state); } -sub comment_create_package +sub comment_create_package($self, $state) { - my ($self, $state) = @_; $state->say("Cwd: #1", $self->name); } package OpenBSD::PackingElement::FileBase; -sub record_digest +sub record_digest($self, $original, $entries, $new, $tail) { - my ($self, $original, $entries, $new, $tail) = @_; if (defined $self->{d}) { my $k = $self->{d}->stringize; push(@{$entries->{$k}}, $self); @@ -574,73 +533,60 @@ sub record_digest } } -sub register_for_archival +sub register_for_archival($self, $ordered) { - my ($self, $ordered) = @_; push(@$ordered, $self); } -sub set_destdir +sub set_destdir($self, $state) { - my ($self, $state) = @_; - $state->{archive}->set_destdir($state->{base}."/".$self->cwd); } -sub archive +sub archive($self, $state) { - my ($self, $state) = @_; - $self->set_destdir($state); my $o = $self->prepare_for_archival($state); $o->write unless $state->{bad}; } -sub pretend_to_archive +sub pretend_to_archive($self, $state) { - my ($self, $state) = @_; - $self->set_destdir($state); $self->prepare_for_archival($state); $self->comment_create_package($state); } -sub comment_create_package +sub comment_create_package($self, $state) { - my ($self, $state) = @_; $state->say("Adding #1", $self->name); } -sub print_file +sub print_file($item) { - my ($item) = @_; - print '@', $item->keyword, " ", $item->fullname, "\n"; + say '@', $item->keyword, " ", $item->fullname; } -sub makesum_plist +sub makesum_plist($self, $state, $plist) { - my ($self, $state, $plist) = @_; $self->makesum_plist_with_base($plist, $state, $state->{base}); } -sub verify_checksum +sub verify_checksum($self, $state) { - my ($self, $state) = @_; $self->verify_checksum_with_base($state, $state->{base}); } package OpenBSD::PackingElement::Dir; -sub discover_directories +sub discover_directories($self, $state) { - my ($self, $state) = @_; $state->{known_dirs}->{$self->fullname} = 1; } package OpenBSD::PackingElement::InfoFile; -sub makesum_plist +sub makesum_plist($self, $state, $plist) { - my ($self, $state, $plist) = @_; $self->SUPER::makesum_plist($state, $plist); my $fname = $self->fullname; for (my $i = 1; ; $i++) { @@ -656,9 +602,8 @@ sub makesum_plist package OpenBSD::PackingElement::Manpage; use File::Basename; -sub grab_manpages +sub grab_manpages($self, $state) { - my ($self, $state) = @_; my $filename; if ($self->{wtempname}) { $filename = $self->{wtempname}; @@ -668,10 +613,8 @@ sub grab_manpages push(@{$state->{manpages}}, $filename); } -sub format_source_page +sub format_source_page($self, $state, $plist) { - my ($self, $state, $plist) = @_; - if ($state->{subst}->empty("USE_GROFF") || !$self->is_source) { return 0; } @@ -712,9 +655,8 @@ sub format_source_page return 1; } -sub makesum_plist +sub makesum_plist($self, $state, $plist) { - my ($self, $state, $plist) = @_; if (!$self->format_source_page($state, $plist)) { $self->SUPER::makesum_plist($state, $plist); } @@ -722,9 +664,8 @@ sub makesum_plist package OpenBSD::PackingElement::Depend; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - my ($self, $state) = @_; if (!$self->spec->is_valid) { $state->error("invalid \@#1 #2 in packing-list", $self->keyword, $self->stringize); @@ -732,26 +673,24 @@ sub avert_duplicates_and_other_checks $self->SUPER::avert_duplicates_and_other_checks($state); } -sub forbidden() { 1 } +sub forbidden($) { 1 } package OpenBSD::PackingElement::Conflict; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - $_[1]->{has_conflict}++; - &OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks; + $state->{has_conflict}++; + OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks($self, $state); } package OpenBSD::PackingElement::AskUpdate; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks # forwarder { &OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks; } package OpenBSD::PackingElement::Dependency; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - my ($self, $state) = @_; - $self->SUPER::avert_duplicates_and_other_checks($state); my @issues = OpenBSD::PackageName->from_string($self->{def})->has_issues; @@ -770,10 +709,8 @@ sub avert_duplicates_and_other_checks } package OpenBSD::PackingElement::Name; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - my ($self, $state) = @_; - my @issues = OpenBSD::PackageName->from_string($self->name)->has_issues; if (@issues > 0) { $state->error("bad package name #1: ", $self->name, @@ -782,19 +719,17 @@ sub avert_duplicates_and_other_checks $self->SUPER::avert_duplicates_and_other_checks($state); } -sub forbidden() { 1 } +sub forbidden($) { 1 } package OpenBSD::PackingElement::NoDefaultConflict; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - my ($self, $state) = @_; $state->{has_no_default_conflict}++; } package OpenBSD::PackingElement::NewAuth; -sub avert_duplicates_and_other_checks +sub avert_duplicates_and_other_checks($self, $state) { - my ($self, $state) = @_; my $userlist = $state->{userlist}; if (defined $userlist) { my $entry = $userlist->{$self->{name}}; @@ -814,21 +749,20 @@ sub avert_duplicates_and_other_checks } package OpenBSD::PackingElement::NewUser; -sub id +sub id($self) { - return shift->{uid}; + return $self->{uid}; } package OpenBSD::PackingElement::NewGroup; -sub id +sub id($self) { - return shift->{gid}; + return $self->{gid}; } package OpenBSD::PackingElement::Lib; -sub check_version +sub check_version($self, $state, $unsubst) { - my ($self, $state, $unsubst) = @_; my @l = $self->parse($self->name); if (defined $l[0]) { if (!$unsubst =~ m/\$\{LIB$l[0]_VERSION\}/) { @@ -841,65 +775,58 @@ sub check_version } package OpenBSD::PackingElement::DigitalSignature; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::Signer; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::ExtraInfo; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::ManualInstallation; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::Firmware; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::Url; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::Arch; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::LocalBase; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } package OpenBSD::PackingElement::Version; -sub is_forbidden { 1 } +sub is_forbidden($) { 1 } # put together file and filename, in order to handle fragments simply package MyFile; -sub new +sub new($class, $filename) { - my ($class, $filename) = @_; - open(my $fh, '<', $filename) or return undef; bless { fh => $fh, name => $filename }, (ref($class) || $class); } -sub readline +sub readline($self) { - my $self = shift; return readline $self->{fh}; } -sub name +sub name($self) { - my $self = shift; return $self->{name}; } -sub close +sub close($self) { - my $self = shift; close($self->{fh}); } -sub deduce_name +sub deduce_name($self, $frag, $not, $p, $state) { - my ($self, $frag, $not, $p, $state) = @_; - my $o = $self->name; my $noto = $o; my $nofrag = "no-$frag"; @@ -926,17 +853,14 @@ package OpenBSD::Dependencies::CreateSolver; our @ISA = qw(OpenBSD::Dependencies::SolverBase); # we need to "hack" a special set -sub new +sub new($class, $plist) { - my ($class, $plist) = @_; bless { set => OpenBSD::PseudoSet->new($plist), old_dependencies => {}, bad => [] }, $class; } -sub solve_all_depends +sub solve_all_depends($solver, $state) { - my ($solver, $state) = @_; - $solver->{tag_finder} = OpenBSD::lookup::tag->new($solver, $state); while (1) { my @todo = $solver->solve_depends($state); @@ -950,10 +874,8 @@ sub solve_all_depends } } -sub solve_wantlibs +sub solve_wantlibs($solver, $state, $final) { - my ($solver, $state, $final) = @_; - my $okay = 1; my $lib_finder = OpenBSD::lookup::library->new($solver); my $h = $solver->{set}{new}[0]; @@ -972,10 +894,8 @@ sub solve_wantlibs return $okay; } -sub really_solve_dependency +sub really_solve_dependency($self, $state, $dep, $package) { - my ($self, $state, $dep, $package) = @_; - $state->progress->message($dep->{pkgpath}); my $v; @@ -1001,10 +921,8 @@ sub really_solve_dependency return $v; } -sub diskcachename +sub diskcachename($self, $dep) { - my ($self, $dep) = @_; - if ($ENV{_DEPENDS_CACHE}) { my $diskcache = $dep->{pkgpath}; $diskcache =~ s/\//--/g; @@ -1014,9 +932,8 @@ sub diskcachename } } -sub to_cache +sub to_cache($self, $plist, $final) { - my ($self, $plist, $final) = @_; # try to cache atomically. # no error if it doesn't work require OpenBSD::MkTemp; @@ -1029,10 +946,8 @@ sub to_cache unlink($tmp); } -sub ask_tree +sub ask_tree($self, $state, $pkgpath, $portsdir, $data, @action) { - my ($self, $state, $pkgpath, $portsdir, $data, @action) = @_; - my $make = OpenBSD::Paths->make; my $errors = OpenBSD::Temp->file; if (!defined $errors) { @@ -1081,10 +996,8 @@ sub ask_tree return $plist; } -sub really_solve_from_ports +sub really_solve_from_ports($self, $state, $dep, $portsdir) { - my ($self, $state, $dep, $portsdir) = @_; - my $diskcache = $self->diskcachename($dep); my $plist; @@ -1110,10 +1023,8 @@ sub really_solve_from_ports my $cache = {}; -sub solve_from_ports +sub solve_from_ports($self, $state, $dep, $package) { - my ($self, $state, $dep, $package) = @_; - my $portsdir = $state->defines('PORTSDIR'); return undef unless defined $portsdir; my $pkgname; @@ -1139,92 +1050,83 @@ sub solve_from_ports } # we don't want old libs -sub find_old_lib +sub find_old_lib($, $, $, $, $) { return undef; } package OpenBSD::PseudoHandle; -sub new +sub new($class, $plist) { - my ($class, $plist) = @_; bless { plist => $plist}, $class; } -sub pkgname +sub pkgname($self) { - my $self = shift; - return $self->{plist}->pkgname; } -sub dependency_info +sub dependency_info($self) { - my $self = shift; return $self->{plist}; } package OpenBSD::PseudoSet; -sub new +sub new($class, @elements) { - my ($class, @elements) = @_; - my $o = bless {}, $class; $o->add_new(@elements); } -sub add_new +sub add_new($self, @elements) { - my ($self, @elements) = @_; for my $i (@elements) { push(@{$self->{new}}, OpenBSD::PseudoHandle->new($i)); } return $self; } -sub newer +sub newer($self) { - return @{shift->{new}}; + return @{$self->{new}}; } -sub newer_names +sub newer_names($self) { - return map {$_->pkgname} @{shift->{new}}; + return map {$_->pkgname} @{$self->{new}}; } -sub older +sub older($) { return (); } -sub older_names +sub older_names($) { return (); } -sub kept +sub kept($) { return (); } -sub kept_names +sub kept_names($) { return (); } -sub print +sub print($self) { - my $self = shift; return $self->{new}[0]->pkgname; } package OpenBSD::PkgCreate; our @ISA = qw(OpenBSD::AddCreateDelete); -sub handle_fragment +sub handle_fragment($self, $state, $old, $not, $frag, $, $, $msg) { - my ($self, $state, $old, $not, $frag, undef, $cont, $msg) = @_; my $def = $frag; if ($state->{subst}->has_fragment($def, $frag, $msg)) { return undef if defined $not; @@ -1245,25 +1147,23 @@ sub handle_fragment return undef; } -sub FileClass +sub FileClass($) { return "MyFile"; } # hook for update-plist, which wants to record fragment positions -sub record_fragment +sub record_fragment($, $, $, $, $) { } # hook for update-plist, which wants to record original file info -sub annotate +sub annotate($, $, $, $) { } -sub read_fragments +sub read_fragments($self, $state, $plist, $filename) { - my ($self, $state, $plist, $filename) = @_; - my $stack = []; my $subst = $state->{subst}; my $main = $self->FileClass->new($filename); @@ -1272,8 +1172,7 @@ sub read_fragments my $fast = $subst->value("LIBS_ONLY"); return $plist->read($stack, - sub { - my ($stack, $cont) = @_; + sub($stack, $cont) { while(my $file = pop @$stack) { while (my $l = $file->readline) { $state->progress->working(2048) @@ -1307,9 +1206,8 @@ sub read_fragments }); } -sub add_description +sub add_description($state, $plist, $name, $opt_d) { - my ($state, $plist, $name, $opt_d) = @_; my $o = OpenBSD::PackingElement::FDESC->add($plist, $name); my $subst = $state->{subst}; my $comment = $subst->value('COMMENT'); @@ -1363,10 +1261,8 @@ sub add_description close($fh); } -sub add_extra_info +sub add_extra_info($self, $plist, $state) { - my ($self, $plist, $state) = @_; - my $subst = $state->{subst}; my $fullpkgpath = $state->{fullpkgpath}; my $cdrom = $subst->value('PERMIT_PACKAGE_CDROM') || @@ -1381,10 +1277,8 @@ sub add_extra_info $fullpkgpath, $cdrom, $ftp); } -sub add_elements +sub add_elements($self, $plist, $state) { - my ($self, $plist, $state) = @_; - my $subst = $state->{subst}; add_description($state, $plist, DESC, $state->opt('d')); OpenBSD::PackingElement::FDISPLAY->may_add($subst, $plist, @@ -1417,23 +1311,19 @@ sub add_elements } } -sub cant_read_fragment +sub cant_read_fragment($self, $state, $frag) { - my ($self, $state, $frag) = @_; $state->fatal("can't read packing-list #1", $frag); } -sub missing_fragments +sub missing_fragments($self, $state, $frag, $o, $noto) { - my ($self, $state, $frag, $o, $noto) = @_; $state->fatal("Missing fragments for #1: #2 and #3 don't exist", $frag, $o, $noto); } -sub read_all_fragments +sub read_all_fragments($self, $state, $plist) { - my ($self, $state, $plist) = @_; - if (defined $state->{prefix}) { OpenBSD::PackingElement::Cwd->add($plist, $state->{prefix}); } else { @@ -1453,10 +1343,8 @@ sub read_all_fragments } } -sub create_plist +sub create_plist($self, $state, $pkgname) { - my ($self, $state, $pkgname) = @_; - my $plist = OpenBSD::PackingList->new; if ($pkgname =~ m|([^/]+)$|o) { @@ -1485,19 +1373,16 @@ sub create_plist return $plist; } -sub make_plist_with_sum +sub make_plist_with_sum($self, $state, $plist) { - my ($self, $state, $plist) = @_; my $p2 = OpenBSD::PackingList->new; $state->progress->visit_with_count($plist, 'makesum_plist', $p2); $p2->set_infodir($plist->infodir); return $p2; } -sub read_existing_plist +sub read_existing_plist($self, $state, $contents) { - my ($self, $state, $contents) = @_; - my $plist = OpenBSD::PackingList->new; if (-d $contents && -f $contents.'/'.CONTENTS) { $plist->set_infodir($contents); @@ -1510,13 +1395,11 @@ sub read_existing_plist return $plist; } -sub create_package +sub create_package($self, $state, $plist, $ordered, $wname) { - my ($self, $state, $plist, $ordered, $wname) = @_; - $state->say("Creating gzip'd tar ball in '#1'", $wname) if $state->opt('v'); - my $h = sub { + my $h = sub { # SIGHANDLER unlink $wname; my $caught = shift; $SIG{$caught} = 'DEFAULT'; @@ -1543,9 +1426,8 @@ sub create_package } } -sub show_bad_symlinks +sub show_bad_symlinks($self, $state) { - my ($self, $state) = @_; for my $dest (sort keys %{$state->{bad_symlinks}}) { $state->errsay("Warning: symlink(s) point to non-existent #1", $dest); @@ -1555,10 +1437,8 @@ sub show_bad_symlinks } } -sub check_dependencies +sub check_dependencies($self, $plist, $state) { - my ($self, $plist, $state) = @_; - my $solver = OpenBSD::Dependencies::CreateSolver->new($plist); # look for libraries in the "real" tree @@ -1570,9 +1450,8 @@ sub check_dependencies } } -sub finish_manpages +sub finish_manpages($self, $state, $plist) { - my ($self, $state, $plist) = @_; $plist->grab_manpages($state); if (defined $state->{manpages}) { $state->run_makewhatis(['-t'], $state->{manpages}); @@ -1586,10 +1465,8 @@ sub finish_manpages # we maintain an LRU cache of files (by checksum) to speed-up # pkg_add -u -sub save_history +sub save_history($self, $plist, $state, $dir) { - my ($self, $plist, $state, $dir) = @_; - unless (-d $dir) { require File::Path; @@ -1673,10 +1550,8 @@ sub save_history return $l; } -sub validate_pkgname +sub validate_pkgname($self, $state, $pkgname) { - my ($self, $state, $pkgname) = @_; - my $revision = $state->defines('REVISION_CHECK'); my $epoch = $state->defines('EPOCH_CHECK'); my $flavor_list = $state->defines('FLAVOR_LIST_CHECK'); @@ -1709,9 +1584,8 @@ sub validate_pkgname } } -sub run_command +sub run_command($self, $state) { - my ($self, $state) = @_; if (defined $state->opt('Q')) { $state->{opt}{q} = 1; } @@ -1819,10 +1693,8 @@ sub run_command } } -sub parse_and_run +sub parse_and_run($self, $cmd) { - my ($self, $cmd) = @_; - my $state = OpenBSD::PkgCreate::State->new($cmd); $state->handle_options; diff --git a/usr.sbin/pkg_add/OpenBSD/PkgDelete.pm b/usr.sbin/pkg_add/OpenBSD/PkgDelete.pm index 268d5587310..dc1eaed32ea 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgDelete.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgDelete.pm @@ -1,6 +1,6 @@ #!/usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: PkgDelete.pm,v 1.48 2022/02/01 16:54:09 dv Exp $ +# $OpenBSD: PkgDelete.pm,v 1.49 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2010 Marc Espie # @@ -16,39 +16,34 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::AddDelete; package OpenBSD::PkgDelete::Tracker; -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub sets_todo +sub sets_todo($self, $offset = 0) { - my ($self, $offset) = @_; return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset, scalar keys %{$self->{total}}); } -sub handle_set +sub handle_set($self, $set) { - my ($self, $set) = @_; $self->{total}{$set} = 1; if ($set->{finished}) { $self->{done}{$set} = 1; } } -sub todo +sub todo($self, @list) { - my ($self, @list) = @_; for my $set (@list) { for my $pkgname ($set->older_names) { $self->{todo}{$pkgname} = $set; @@ -58,9 +53,8 @@ sub todo } -sub done +sub done($self, $set) { - my ($self, $set) = @_; $set->{finished} = 1; for my $pkgname ($set->older_names) { delete $self->{todo}{$pkgname}; @@ -68,13 +62,13 @@ sub done $self->handle_set($set); } -sub cant +sub cant # forwarder { &done; } -sub find + +sub find($self, $pkgname) { - my ($self, $pkgname) = @_; return $self->{todo}{$pkgname}; } @@ -83,32 +77,28 @@ sub find package OpenBSD::PkgDelete::State; our @ISA = qw(OpenBSD::AddDelete::State); -sub new +sub new($class, @p) { - my $class = shift; - my $self = $class->SUPER::new(@_); + my $self = $class->SUPER::new(@p); $self->{tracker} = OpenBSD::PkgDelete::Tracker->new; return $self; } -sub tracker +sub tracker($self) { - my $self = shift; return $self->{tracker}; } -sub handle_options +sub handle_options($state) { - my $state = shift; $state->SUPER::handle_options('X', '[-acimnqsVvXx] [-B pkg-destdir] [-D name[=value]] [pkg-name ...]'); $state->{exclude} = $state->opt('X'); } -sub stem2location +sub stem2location($self, $locator, $name, $state) { - my ($self, $locator, $name, $state) = @_; require OpenBSD::Search; my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name)); if (@$l > 1 && !$state->defines('allversions')) { @@ -117,31 +107,27 @@ sub stem2location return $state->choose_location($name, $l); } -sub deleteset +sub deleteset($self) { - my $self = shift; require OpenBSD::UpdateSet; return OpenBSD::DeleteSet->new($self); } -sub deleteset_from_location +sub deleteset_from_location($self, $location) { - my ($self, $location) = @_; return $self->deleteset->add_older(OpenBSD::Handle->from_location($location)); } -sub solve_dependency +sub solve_dependency($self, $solver, $dep, $package) { - my ($self, $solver, $dep, $package) = @_; # simpler dependency solving return $solver->find_dep_in_installed($self, $dep); } package OpenBSD::DeleteSet; -sub setup_header +sub setup_header($set, $state, $handle = undef) { - my ($set, $state, $handle) = @_; my $header = $state->deptree_header($set); if (defined $handle) { $header .= $handle->pkgname; @@ -173,16 +159,14 @@ use OpenBSD::UpdateSet; use OpenBSD::Handle; -sub add_location +sub add_location($self, $state, $l) { - my ($self, $state, $l) = @_; push(@{$state->{setlist}}, $state->deleteset_from_location($l)); } -sub create_locations +sub create_locations($state, @l) { - my ($state, @l) = @_; my $inst = $state->repo->installed; my $result = []; for my $name (@l) { @@ -198,10 +182,8 @@ sub create_locations return $result; } -sub process_parameters +sub process_parameters($self, $state) { - my ($self, $state) = @_; - my $inst = $state->repo->installed; if (@ARGV == 0) { @@ -231,13 +213,12 @@ sub process_parameters } } -sub finish_display +sub finish_display($, $) { } -sub really_remove +sub really_remove($set, $state) { - my ($set, $state) = @_; if ($state->{not}) { $state->status->what("Pretending to delete"); } else { @@ -253,30 +234,24 @@ sub really_remove $state->syslog("Removed #1", $set->print); } -sub delete_dependencies +sub delete_dependencies($state) { - my $state = shift; - if ($state->defines("dependencies")) { return 1; } return $state->confirm_defaults_to_no("Delete them as well"); } -sub fix_bad_dependencies +sub fix_bad_dependencies($state) { - my $state = shift; - if ($state->defines("baddepend")) { return 1; } return $state->confirm_defaults_to_no("Delete anyway"); } -sub process_set +sub process_set($self, $set, $state) { - my ($self, $set, $state) = @_; - my $todo = {}; my $bad = {}; for my $pkgname ($set->older_names) { @@ -379,10 +354,8 @@ sub process_set return (); } -sub main +sub main($self, $state) { - my ($self, $state) = @_; - if ($state->{exclude}) { my $names = {}; for my $l (@{$state->{setlist}}) { @@ -410,9 +383,8 @@ sub main } } -sub new_state +sub new_state($self, $cmd) { - my ($self, $cmd) = @_; return OpenBSD::PkgDelete::State->new($cmd); } diff --git a/usr.sbin/pkg_add/OpenBSD/PkgInfo.pm b/usr.sbin/pkg_add/OpenBSD/PkgInfo.pm index 81001083ee9..f88def39378 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgInfo.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgInfo.pm @@ -1,6 +1,6 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: PkgInfo.pm,v 1.50 2020/02/19 14:23:26 espie Exp $ +# $OpenBSD: PkgInfo.pm,v 1.51 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -16,32 +16,29 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::State; package OpenBSD::PackingElement; -sub dump_file +sub dump_file($, $) { } -sub hunt_file +sub hunt_file($, $, $, $) { } -sub sum_up +sub sum_up($self, $rsize) { - my ($self, $rsize) = @_; if (defined $self->{size}) { $$rsize += $self->{size}; } } package OpenBSD::PackingElement::FileBase; -sub dump_file +sub dump_file($item, $opt_K) { - my ($item, $opt_K) = @_; if ($opt_K) { print '@', $item->keyword, " "; } @@ -49,9 +46,8 @@ sub dump_file } package OpenBSD::PackingElement::FileObject; -sub hunt_file +sub hunt_file($item, $h, $pkgname, $l) { - my ($item, $h, $pkgname, $l) = @_; my $fname = $item->fullname; if (defined $h->{$fname}) { push(@{$h->{$fname}}, $pkgname); @@ -64,26 +60,23 @@ our @ISA = qw(OpenBSD::State); use OpenBSD::PackageInfo; -sub lock +sub lock($state) { - my $state = shift; return if $state->{locked}; return if $state->{subst}->value('nolock'); lock_db(1, $state->opt('q') ? undef : $state); $state->{locked} = 1; } -sub banner +sub banner($state, @args) { - my ($state, @args) = @_; return if $state->opt('q'); $state->print("#1", $state->opt('l')) if $state->opt('l'); $state->say(@args); } -sub header +sub header($state, $handle) { - my ($state, $handle) = @_; return if $state->{terse} || $state->opt('q'); my $url = $handle->url; return if $state->{header_done}{$url}; @@ -91,9 +84,8 @@ sub header $state->banner("Information for #1\n", $url); } -sub footer +sub footer($state, $handle) { - my ($state, $handle) = @_; return if $state->opt('q') || $state->{terse}; return unless $state->{header_done}{$handle->url}; if ($state->opt('l')) { @@ -103,10 +95,8 @@ sub footer } } -sub printfile +sub printfile($state, $filename) { - my ($state, $filename) = @_; - open my $fh, '<', $filename or return; while(<$fh>) { chomp; @@ -116,10 +106,8 @@ sub printfile $state->say; } -sub printfile_sorted +sub printfile_sorted($state, $filename) { - my ($state, $filename) = @_; - open my $fh, '<', $filename or return; my @lines = (<$fh>); close $fh; @@ -130,10 +118,8 @@ sub printfile_sorted $state->say; } -sub print_description +sub print_description($state, $dir) { - my ($state, $dir) = @_; - open my $fh, '<', $dir.DESC or return; $_ = <$fh>; # zap COMMENT while(<$fh>) { @@ -144,9 +130,8 @@ sub print_description $state->say; } -sub hasanyopt +sub hasanyopt($self, $string) { - my ($self, $string) = @_; for my $i (split //, $string) { if ($self->opt($i)) { return 1; @@ -155,21 +140,19 @@ sub hasanyopt return 0; } -sub setopts +sub setopts($self, $string) { - my ($self, $string) = @_; for my $i (split //, $string) { $self->{opt}{$i} = 1; } } -sub log +sub log($self, @p) { - my $self = shift; - if (@_ == 0) { + if (@p == 0) { return $self; } else { - $self->say(@_); + $self->say(@p); } } @@ -183,9 +166,8 @@ use OpenBSD::Error; my $total_size = 0; my $pkgs = 0; -sub find_pkg_in +sub find_pkg_in($self, $state, $repo, $pkgname, $code) { - my ($self, $state, $repo, $pkgname, $code) = @_; if (OpenBSD::PackageName::is_stem($pkgname)) { require OpenBSD::Search; @@ -230,9 +212,8 @@ sub find_pkg_in } } -sub find_pkg +sub find_pkg($self, $state, $pkgname, $code) { - my ($self, $state, $pkgname, $code) = @_; if ($self->find_pkg_in($state, $state->repo->installed, $pkgname, $code)) { @@ -249,25 +230,22 @@ sub find_pkg return $self->find_pkg_in($state, $repo, $pkgname, $code); } -sub get_line +sub get_line($name) { - open my $fh, '<', shift or return ""; + open my $fh, '<', $name or return ""; my $c = <$fh>; chomp($c); close $fh; return $c; } -sub get_comment +sub get_comment($d) { - my $d = shift; return get_line($d.DESC); } -sub find_by_spec +sub find_by_spec($pat, $state) { - my ($pat, $state) = @_; - require OpenBSD::Search; my $s = OpenBSD::Search::PkgSpec->new($pat); @@ -281,9 +259,8 @@ sub find_by_spec } } -sub filter_files +sub filter_files($self, $state, $search, @args) { - my ($self, $state, $search, @args) = @_; require OpenBSD::PackingList; my @k = (); @@ -299,9 +276,7 @@ sub filter_files my @result = (); for my $arg (@args) { $self->find_pkg($state, $arg, - sub { - my ($pkgname, $handle) = @_; - + sub($pkgname, $handle) { if (-f $handle->info.CONTENTS) { my $maybe = 0; open(my $fh, '<', $handle->info.CONTENTS); @@ -322,17 +297,14 @@ sub filter_files return @result; } -sub manual_filter +sub manual_filter($self, $state, @args) { - my ($self, $state, @args) = @_; require OpenBSD::PackingList; my @result = (); for my $arg (@args) { $self->find_pkg($state, $arg, - sub { - my ($pkgname, $handle) = @_; - + sub($pkgname, $handle) { my $plist = $handle->plist(\&OpenBSD::PackingList::ConflictOnly); push(@result, $pkgname) if $plist->has('manual-installation'); @@ -343,17 +315,13 @@ sub manual_filter my $path_info; -sub add_to_path_info +sub add_to_path_info($path, $pkgname) { - my ($path, $pkgname) = @_; - push(@{$path_info->{$path}}, $pkgname); } -sub find_by_path +sub find_by_path($pat) { - my $pat = shift; - if (!defined $path_info) { require OpenBSD::PackingList; @@ -382,9 +350,8 @@ sub find_by_path } } -sub print_info +sub print_info($self, $state, $pkg, $handle) { - my ($self, $state, $pkg, $handle) = @_; unless (defined $handle) { $state->errsay("Error printing info for #1: no info ?", $pkg); return; @@ -513,10 +480,8 @@ sub print_info } } -sub handle_query +sub handle_query($self, $state) { - my ($self, $state) = @_; - require OpenBSD::Search; $state->say("PKG_PATH=#1", $ENV{PKG_PATH} // "") @@ -538,9 +503,8 @@ sub handle_query } } -sub parse_and_run +sub parse_and_run($self, $cmd) { - my ($self, $cmd) = @_; my $exit_code = 0; my @sought_files; my $error_e = 0; @@ -549,8 +513,7 @@ sub parse_and_run $state->{opt} = { 'e' => - sub { - my $pat = shift; + sub($pat) { my @list; if ($pat =~ m/\//o) { $state->lock; @@ -567,10 +530,10 @@ sub parse_and_run $state->{terse} = 1; }, 'E' => - sub { + sub($name) { require File::Spec; - push(@sought_files, File::Spec->rel2abs(shift)); + push(@sought_files, File::Spec->rel2abs($name)); } }; @@ -675,8 +638,8 @@ sub parse_and_run $state->banner('#1', $pkg); } if (!$self->find_pkg($state, $pkg, - sub { - $self->print_info($state, @_); + sub($pkgname, $handle) { + $self->print_info($state, $pkgname, $handle); })) { $exit_code = 1; } diff --git a/usr.sbin/pkg_add/OpenBSD/PkgSign.pm b/usr.sbin/pkg_add/OpenBSD/PkgSign.pm index ce340b88ddb..af4ca25758f 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgSign.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgSign.pm @@ -1,6 +1,6 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: PkgSign.pm,v 1.17 2019/07/08 10:55:39 espie Exp $ +# $OpenBSD: PkgSign.pm,v 1.18 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -16,8 +16,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use OpenBSD::AddCreateDelete; use OpenBSD::Signer; @@ -25,26 +24,24 @@ use OpenBSD::Signer; package OpenBSD::PkgSign::State; our @ISA = qw(OpenBSD::CreateSign::State); -sub handle_options +sub handle_options($state) { - my $state = shift; - $state->{extra_stats} = 0; $state->{opt} = { 'o' => - sub { - $state->{output_dir} = shift; + sub($opt) { + $state->{output_dir} = $opt; }, 'S' => - sub { - $state->{source} = shift; + sub($opt) { + $state->{source} = $opt; }, 's' => - sub { - push(@{$state->{signature_params}}, shift); + sub($opt) { + push(@{$state->{signature_params}}, $opt); }, 'V' => - sub { + sub() { $state->{extra_stats}++; }, }; @@ -73,9 +70,8 @@ use OpenBSD::Temp; use OpenBSD::PackingList; use OpenBSD::PackageInfo; -sub sign_existing_package +sub sign_existing_package($self, $state, $pkg) { - my ($self, $state, $pkg) = @_; my $output = $state->{output_dir}; my $dest = $output.'/'.$pkg->name.".tgz"; if ($state->opt('i')) { @@ -91,21 +87,20 @@ sub sign_existing_package rename($tmp, $dest) or $state->fatal("Can't create final signed package: #1", $!); if ($state->opt('C')) { - $state->system(sub { - chdir($output); - open(STDOUT, '>>', 'SHA256'); + $state->system( + sub() { + chdir($output); + open(STDOUT, '>>', 'SHA256'); }, OpenBSD::Paths->sha256, '-b', $pkg->name.".tgz"); } } -sub sign_list +sub sign_list($self, $l, $repo, $maxjobs, $state) { - my ($self, $l, $repo, $maxjobs, $state) = @_; $state->{total} = scalar @$l; $maxjobs //= 1; - my $code = sub { - my $name = shift; + my $code = sub($name) { my $pkg = $repo->find($name); if (!defined $pkg) { $state->errsay("#1 not found", $name); @@ -114,17 +109,17 @@ sub sign_list } }; my $display = $state->verbose ? - sub { - $state->progress->set_header("Signed ".shift); + sub($name) { + $state->progress->set_header("Signed ".$name); $state->{done}++; $state->progress->next($state->ntogo); } : - sub { + sub($) { }; if ($maxjobs > 1) { my $jobs = {}; my $n = 0; - my $reap_job = sub { + my $reap_job = sub() { my $pid = wait; if (!defined $jobs->{$pid}) { $state->fatal("Wait returned #1: unknown process", $pid); @@ -151,11 +146,11 @@ sub sign_list $n++; } if ($n >= $maxjobs) { - &$reap_job; + &$reap_job(); } } while ($n != 0) { - &$reap_job; + &$reap_job(); } } else { for my $name (@$l) { @@ -165,18 +160,18 @@ sub sign_list } } if ($state->opt('C')) { - $state->system(sub { - chdir($state->{output_dir}); - open(STDOUT, '>', 'SHA256.new'); + $state->system( + sub() { + chdir($state->{output_dir}); + open(STDOUT, '>', 'SHA256.new'); }, 'sort', 'SHA256'); rename($state->{output_dir}.'/SHA256.new', $state->{output_dir}.'/SHA256'); } } -sub sign_existing_repository +sub sign_existing_repository($self, $state, $source) { - my ($self, $state, $source) = @_; require OpenBSD::PackageRepository; my $repo = OpenBSD::PackageRepository->new($source, $state); if ($state->{signer}->want_local && !$repo->is_local_file) { @@ -190,9 +185,8 @@ sub sign_existing_repository } -sub parse_and_run +sub parse_and_run($self, $cmd) { - my ($self, $cmd) = @_; my $state = OpenBSD::PkgSign::State->new($cmd); $state->handle_options; if (!defined $state->{source} && @ARGV == 0) { diff --git a/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm b/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm index 20ed30f61b1..8cb3da6fd71 100644 --- a/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm +++ b/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PkgSpec.pm,v 1.50 2021/11/21 10:15:52 espie Exp $ +# $OpenBSD: PkgSpec.pm,v 1.51 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2007 Marc Espie # @@ -15,21 +15,16 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PkgSpec::flavorspec; -sub new +sub new($class, $spec) { - my ($class, $spec) = @_; - bless \$spec, $class; } -sub check_1flavor +sub check_1flavor($f, $spec) { - my ($f, $spec) = @_; - for my $flavor (split /\-/o, $spec) { # must not be here if ($flavor =~ m/^\!(.*)$/o) { @@ -42,10 +37,8 @@ sub check_1flavor return 1; } -sub match +sub match($self, $h) { - my ($self, $h) = @_; - # check each flavor constraint for my $c (split /\,/o, $$self) { if (check_1flavor($h->{flavors}, $c)) { @@ -57,21 +50,18 @@ sub match package OpenBSD::PkgSpec::exactflavor; our @ISA = qw(OpenBSD::PkgSpec::flavorspec); -sub new +sub new($class, $value) { - my ($class, $value) = @_; bless {map{($_, 1)} split(/\-/, $value)}, $class; } -sub flavor_string +sub flavor_string($self) { - my $self = shift; return join('-', sort keys %$self); } -sub match +sub match($self, $h) { - my ($self, $h) = @_; if ($self->flavor_string eq $h->flavor_string) { return 1; } else { @@ -89,9 +79,8 @@ my $ops = { '=' => 'eq' }; -sub new +sub new($class, $s) { - my ($class, $s) = @_; my ($op, $version) = ('=', $s); if ($s =~ m/^(\>\=|\>|\<\=|\<|\=)(.*)$/) { ($op, $version) = ($1, $2); @@ -99,9 +88,8 @@ sub new return "OpenBSD::PkgSpec::version::$ops->{$op}"->from_string($version); } -sub pnum_compare +sub pnum_compare($self, $b) { - my ($self, $b) = @_; if (!defined $self->{p}) { return 0; } else { @@ -109,79 +97,74 @@ sub pnum_compare } } -sub is_exact +sub is_exact($) { return 0; } package OpenBSD::PkgSpec::version::lt; our @ISA = qw(OpenBSD::PkgSpec::versionspec); -sub match +sub match($self, $b) { - my ($self, $b) = @_; -$self->compare($b->{version}) < 0 ? 1 : 0; } package OpenBSD::PkgSpec::version::le; our @ISA = qw(OpenBSD::PkgSpec::versionspec); -sub match +sub match($self, $b) { - my ($self, $b) = @_; -$self->compare($b->{version}) <= 0 ? 1 : 0; } package OpenBSD::PkgSpec::version::gt; our @ISA = qw(OpenBSD::PkgSpec::versionspec); -sub match +sub match($self, $b) { - my ($self, $b) = @_; -$self->compare($b->{version}) > 0 ? 1 : 0; } package OpenBSD::PkgSpec::version::ge; our @ISA = qw(OpenBSD::PkgSpec::versionspec); -sub match +sub match($self, $b) { - my ($self, $b) = @_; -$self->compare($b->{version}) >= 0 ? 1 : 0; } package OpenBSD::PkgSpec::version::eq; our @ISA = qw(OpenBSD::PkgSpec::versionspec); -sub match +sub match($self, $b) { - my ($self, $b) = @_; -$self->compare($b->{version}) == 0 ? 1 : 0; } -sub is_exact +sub is_exact($) { return 1; } package OpenBSD::PkgSpec::badspec; -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub match_ref +# $self->match*($list) +sub match_ref($, $) { return (); } -sub match_libs_ref +sub match_libs_ref($, $) { return (); } -sub match_locations +sub match_locations($, $) { return []; } -sub is_valid +sub is_valid($) { return 0; } @@ -189,10 +172,8 @@ sub is_valid package OpenBSD::PkgSpec::SubPattern; use OpenBSD::PackageName; -sub parse +sub parse($class, $p) { - my ($class, $p) = @_; - my $r = {}; # let's try really hard to find the stem and the flavors @@ -218,10 +199,8 @@ sub parse return $r; } -sub add_version_constraints +sub add_version_constraints($class, $constraints, $vspec) { - my ($class, $constraints, $vspec) = @_; - # turn the vspec into a list of constraints. if ($vspec eq '*') { # non constraint @@ -233,9 +212,8 @@ sub add_version_constraints } } -sub add_flavor_constraints +sub add_flavor_constraints($class, $constraints, $flavorspec) { - my ($class, $constraints, $flavorspec) = @_; # and likewise for flavors if ($flavorspec eq '') { # non constraint @@ -245,10 +223,8 @@ sub add_flavor_constraints } } -sub new +sub new($class, $p, $with_partial) { - my ($class, $p, $with_partial) = @_; - my $r = $class->parse($p); if (defined $r) { my $stemspec = $r->{stemspec}; @@ -277,9 +253,8 @@ sub new } } -sub match_ref +sub match_ref($o, $list) { - my ($o, $list) = @_; my @result = (); # Now, have to extract the version number, and the flavor... LOOP1: @@ -304,16 +279,14 @@ LOOP1: } } -sub match_libs_ref +sub match_libs_ref($o, $list) { - my ($o, $list) = @_; return grep(/$o->{libstem}/, @$list); } -sub match_locations +sub match_locations($o, $list) { - my ($o, $list) = @_; my $result = []; # Now, have to extract the version number, and the flavor... LOOP2: @@ -330,17 +303,16 @@ LOOP2: return $result; } -sub is_valid +sub is_valid($) { return 1; } package OpenBSD::PkgSpec; -sub subpattern_class +sub subpattern_class($) { "OpenBSD::PkgSpec::SubPattern" } -sub new +sub new($class, $pattern, $with_partial = 0) { - my ($class, $pattern, $with_partial) = @_; my @l = map { $class->subpattern_class->new($_, $with_partial) } (split /\|/o, $pattern); if (@l == 1) { @@ -350,9 +322,8 @@ sub new } } -sub match_ref +sub match_ref($self, $r) { - my ($self, $r) = @_; if (wantarray) { my @l = (); for my $subpattern (@$self) { @@ -369,9 +340,8 @@ sub match_ref } } -sub match_libs_ref +sub match_libs_ref($self, $r) { - my ($self, $r) = @_; if (wantarray) { my @l = (); for my $subpattern (@$self) { @@ -388,9 +358,8 @@ sub match_libs_ref } } -sub match_locations +sub match_locations($self, $r) { - my ($self, $r) = @_; my $l = []; for my $subpattern (@$self) { push(@$l, @{$subpattern->match_locations($r)}); @@ -398,9 +367,8 @@ sub match_locations return $l; } -sub is_valid +sub is_valid($self) { - my $self = shift; for my $subpattern (@$self) { return 0 unless $subpattern->is_valid; } @@ -410,9 +378,8 @@ sub is_valid package OpenBSD::PkgSpec::SubPattern::Exact; our @ISA = qw(OpenBSD::PkgSpec::SubPattern); -sub add_version_constraints +sub add_version_constraints($class, $constraints, $vspec) { - my ($class, $constraints, $vspec) = @_; return if $vspec eq '*'; # XXX my $v = OpenBSD::PkgSpec::versionspec->new($vspec); die "not a good exact spec" if !$v->is_exact; @@ -420,16 +387,15 @@ sub add_version_constraints push(@$constraints, $v); } -sub add_flavor_constraints +sub add_flavor_constraints($class, $constraints, $flavorspec) { - my ($class, $constraints, $flavorspec) = @_; push(@$constraints, OpenBSD::PkgSpec::exactflavor->new($flavorspec)); } package OpenBSD::PkgSpec::Exact; our @ISA = qw(OpenBSD::PkgSpec); -sub subpattern_class +sub subpattern_class($) { "OpenBSD::PkgSpec::SubPattern::Exact" } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/ProgressMeter.pm b/usr.sbin/pkg_add/OpenBSD/ProgressMeter.pm index ae6ec0424ef..1e7b6ef61b5 100644 --- a/usr.sbin/pkg_add/OpenBSD/ProgressMeter.pm +++ b/usr.sbin/pkg_add/OpenBSD/ProgressMeter.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: ProgressMeter.pm,v 1.53 2023/05/27 10:03:43 espie Exp $ +# $OpenBSD: ProgressMeter.pm,v 1.54 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2010 Marc Espie # @@ -15,35 +15,30 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::PackingElement; -sub compute_size +sub compute_size($self, $totsize) { - my ($self, $totsize) = @_; - $$totsize += $self->{size} if defined $self->{size}; } package OpenBSD::ProgressMeter; -sub new +sub new($) { bless {}, "OpenBSD::ProgressMeter::Stub"; } -sub compute_size +sub compute_size($self, $plist) { - my ($self, $plist) = @_; my $totsize = 0; $plist->compute_size(\$totsize); $totsize = 1 if $totsize == 0; return $totsize; } -sub setup +sub setup($self, $opt_x, $opt_m, $state) { - my ($self, $opt_x, $opt_m, $state) = @_; $self->{state} = $state; if ($opt_m || (!$opt_x && -t STDOUT)) { require OpenBSD::ProgressMeter::Term; @@ -52,22 +47,20 @@ sub setup } } -sub disable {} +sub disable($) {} -sub new_sizer +sub new_sizer($progress, $plist) { - my ($progress, $plist) = @_; return $progress->sizer_class->new($progress, $plist); } -sub sizer_class +sub sizer_class($) { "PureSizer" } -sub for_list +sub for_list($self, $msg, $l, $code) { - my ($self, $msg, $l, $code) = @_; if (defined $msg) { $self->set_header($msg); } @@ -80,19 +73,17 @@ sub for_list $self->next; } -sub compute_playfield +sub compute_playfield($) { } -sub handle_continue +sub handle_continue($self) { - my $self = shift; $self->{continued} = 1; } -sub can_output +sub can_output($self) { - my $self = shift; return $self->{state}->can_output; } @@ -101,41 +92,39 @@ sub can_output package OpenBSD::ProgressMeter::Stub; our @ISA = qw(OpenBSD::ProgressMeter); -sub forked {} +sub forked($) {} -sub clear {} +sub clear($) {} -sub show {} +sub show($, $, $) {} -sub working {} -sub message {} +sub working($, $) {} +sub message($, $) {} -sub next {} +sub next($, $ = undef) {} -sub set_header {} +sub set_header($, $) {} -sub ntogo +sub ntogo($, $, $ = undef) { return ""; } -sub visit_with_size +sub visit_with_size($progress, $plist, $method, @r) { - my ($progress, $plist, $method, @r) = @_; $plist->$method($progress->{state}, @r); } -sub visit_with_count +sub visit_with_count # forwarder { &OpenBSD::ProgressMeter::Stub::visit_with_size; } package PureSizer; -sub new +sub new($class, $progress, $plist) { - my ($class, $progress, $plist) = @_; $plist->{totsize} //= $progress->compute_size($plist); bless { progress => $progress, @@ -144,9 +133,8 @@ sub new }, $class; } -sub advance +sub advance($self, $e) { - my ($self, $e) = @_; if (defined $e->{size}) { $self->{donesize} += $e->{size}; } diff --git a/usr.sbin/pkg_add/OpenBSD/ProgressMeter/Term.pm b/usr.sbin/pkg_add/OpenBSD/ProgressMeter/Term.pm index 159822aa208..1eee1865321 100644 --- a/usr.sbin/pkg_add/OpenBSD/ProgressMeter/Term.pm +++ b/usr.sbin/pkg_add/OpenBSD/ProgressMeter/Term.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Term.pm,v 1.43 2022/05/13 15:39:14 espie Exp $ +# $OpenBSD: Term.pm,v 1.44 2023/06/13 09:07:18 espie Exp $ # # Copyright (c) 2004-2007 Marc Espie # @@ -14,27 +14,23 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; +use v5.36; use warnings; package OpenBSD::PackingElement; -sub size_and +sub size_and($self, $p, $method, @r) { - my ($self, $p, $method, @r) = @_; $p->advance($self); $self->$method(@r); } -sub compute_count +sub compute_count($self, $count) { - my ($self, $count) = @_; - - $$count ++; + $$count++; } -sub count_and +sub count_and($self, $progress, $done, $total, $method, @r) { - my ($self, $progress, $done, $total, $method, @r) = @_; $$done ++; $progress->show($$done, $total); $self->$method(@r); @@ -43,36 +39,32 @@ sub count_and package OpenBSD::ProgressMeter::Real; our @ISA = qw(OpenBSD::ProgressMeter); -sub ntogo +sub ntogo($self, $state, $offset = 0) { - my ($self, $state, $offset) = @_; - return $state->ntodo($offset // 0); + return $state->ntodo($offset); } -sub compute_count +sub compute_count($progress, $plist) { - my ($progres, $plist) = @_; my $total = 0; $plist->compute_count(\$total); $total = 1 if $total == 0; return $total; } -sub visit_with_size +sub visit_with_size($progress, $plist, $method, @r) { - my ($progress, $plist, $method, @r) = @_; my $p = $progress->new_sizer($plist); $plist->size_and($p, $method, $progress->{state}, @r); } -sub sizer_class +sub sizer_class($) { "ProgressSizer" } -sub visit_with_count +sub visit_with_count($progress, $plist, $method, @r) { - my ($progress, $plist, $method, @r) = @_; $plist->{total} //= $progress->compute_count($plist); my $count = 0; $progress->show($count, $plist->{total}); @@ -85,21 +77,18 @@ our @ISA = qw(OpenBSD::ProgressMeter::Real); use POSIX; use Term::Cap; -sub width +sub width($self) { - my $self = shift; return $self->{state}->width; } -sub forked +sub forked($self) { - my $self = shift; $self->{lastdisplay} = ' 'x($self->width-1); } -sub init +sub init($self) { - my $self = shift; my $oldfh = select(STDOUT); $| = 1; select($oldfh); @@ -134,26 +123,23 @@ sub init } } -sub compute_playfield +sub compute_playfield($self) { - my $self = shift; $self->{playfield} = $self->width - length($self->{header}) - 7; if ($self->{playfield} < 5) { $self->{playfield} = 0; } } -sub set_header +sub set_header($self, $header) { - my ($self, $header) = @_; $self->{header} = $header; $self->compute_playfield; return 1; } -sub hmove +sub hmove($self, $v) { - my ($self, $v) = @_; my $seq = $self->{hpa}; $seq =~ s/\%i// and $v++; $seq =~ s/\%n// and $v ^= 0140; @@ -168,9 +154,8 @@ sub hmove return $seq; } -sub _show +sub _show($self, $extra = undef, $stars = undef) { - my ($self, $extra, $stars) = @_; my $d = $self->{header}; my $prefix = length($d); if (defined $extra) { @@ -209,9 +194,8 @@ sub _show $self->{lastdisplay} = $d; } -sub message +sub message($self, $message) { - my ($self, $message) = @_; return unless $self->can_output; if ($self->{cleareol}) { $message .= $self->{cleareol}; @@ -225,10 +209,8 @@ sub message } } -sub show +sub show($self, $current, $total) { - my ($self, $current, $total) = @_; - return unless $self->can_output; if ($self->{playfield}) { @@ -245,17 +227,15 @@ sub show } } -sub working +sub working($self, $slowdown) { - my ($self, $slowdown) = @_; $self->{work}++; return if $self->{work} < $slowdown; $self->message(substr("/-\\|", ($self->{work}/$slowdown) % 4, 1)); } -sub clear +sub clear($self) { - my $self = shift; return unless length($self->{lastdisplay}) > 0; if ($self->can_output) { if ($self->{cleareol}) { @@ -268,17 +248,15 @@ sub clear delete $self->{stars}; } -sub disable +sub disable($self) { - my $self = shift; print "\n" if length($self->{lastdisplay}) > 0 and $self->can_output; bless $self, "OpenBSD::ProgressMeter::Stub"; } -sub next +sub next($self, $todo = 'ok') { - my ($self, $todo) = @_; $self->clear; $todo //= 'ok'; @@ -288,24 +266,21 @@ sub next package ProgressSizer; our @ISA = qw(PureSizer); -sub new +sub new($class, $progress, $plist) { - my ($class, $progress, $plist) = @_; my $p = $class->SUPER::new($progress, $plist); $progress->show(0, $p->{totsize}); if (defined $progress->{state}{archive}) { $progress->{state}{archive}->set_callback( - sub { - my $done = shift; + sub($done) { $progress->show($p->{donesize} + $done, $p->{totsize}); }); } return $p; } -sub advance +sub advance($self, $e) { - my ($self, $e) = @_; if (defined $e->{size}) { $self->{donesize} += $e->{size}; $self->{progress}->show($self->{donesize}, $self->{totsize}); diff --git a/usr.sbin/pkg_add/OpenBSD/Replace.pm b/usr.sbin/pkg_add/OpenBSD/Replace.pm index e1dddc78b3d..d0e2c1d5803 100644 --- a/usr.sbin/pkg_add/OpenBSD/Replace.pm +++ b/usr.sbin/pkg_add/OpenBSD/Replace.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Replace.pm,v 1.91 2021/06/28 11:25:14 espie Exp $ +# $OpenBSD: Replace.pm,v 1.92 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2004-2014 Marc Espie # @@ -14,50 +14,44 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; use OpenBSD::Delete; package OpenBSD::PackingElement; -sub scan_for_exec +sub scan_for_exec($, $, $) { } package OpenBSD::PackingElement::Exec; -sub scan_for_exec +sub scan_for_exec($self, $installing, $r) { - my ($self, $installing, $r) = @_; $$r = 1 if $installing; } package OpenBSD::PackingElement::ExecAdd; -sub scan_for_exec {} +sub scan_for_exec($, $, $) {} package OpenBSD::PackingElement::Unexec; -sub scan_for_exec +sub scan_for_exec($self, $installing, $r) { - my ($self, $installing, $r) = @_; $$r = 1 if !$installing; } package OpenBSD::PackingElement::UnexecDelete; -sub scan_for_exec { } +sub scan_for_exec($, $, $) { } package OpenBSD::Replace; -sub pkg_has_exec +sub pkg_has_exec($pkg, $new) { - my ($pkg, $new) = @_; - my $has_exec = 0; $pkg->plist->scan_for_exec($new, \$has_exec); return $has_exec; } -sub set_has_no_exec +sub set_has_no_exec($set, $state) { - my ($set, $state) = @_; for my $pkg ($set->older) { return 0 if pkg_has_exec($pkg, 0); } diff --git a/usr.sbin/pkg_add/OpenBSD/RequiredBy.pm b/usr.sbin/pkg_add/OpenBSD/RequiredBy.pm index e900bf5ceb3..8553c352b18 100644 --- a/usr.sbin/pkg_add/OpenBSD/RequiredBy.pm +++ b/usr.sbin/pkg_add/OpenBSD/RequiredBy.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: RequiredBy.pm,v 1.29 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: RequiredBy.pm,v 1.30 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2005 Marc Espie # @@ -15,24 +15,21 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::RequirementList; use OpenBSD::PackageInfo; use Carp; -sub fatal_error +sub fatal_error($self, $msg) { - my ($self, $msg) = @_; require OpenBSD::Tracker; OpenBSD::Tracker->dump; confess ref($self), ": $msg $self->{filename}: $!"; } -sub fill_entries +sub fill_entries($self) { - my $self = shift; if (!exists $self->{entries}) { my $l = $self->{entries} = {}; @@ -53,9 +50,8 @@ sub fill_entries } } -sub synch +sub synch($self) { - my $self = shift; return $self if $main::not; if (!unlink $self->{filename}) { @@ -78,10 +74,8 @@ sub synch return $self; } -sub list +sub list($self) { - my $self = shift; - if (wantarray) { $self->fill_entries; return keys %{$self->{entries}}; @@ -95,16 +89,14 @@ sub list } } -sub erase +sub erase($self) { - my $self = shift; $self->{entries} = {}; $self->synch; } -sub delete +sub delete($self, @pkgnames) { - my ($self, @pkgnames) = @_; $self->fill_entries; for my $pkg (@pkgnames) { delete $self->{entries}->{$pkg}; @@ -112,9 +104,8 @@ sub delete $self->synch; } -sub add +sub add($self, @pkgnames) { - my ($self, @pkgnames) = @_; $self->fill_entries; for my $pkg (@pkgnames) { $self->{entries}->{$pkg} = 1; @@ -124,9 +115,8 @@ sub add my $cache = {}; -sub new +sub new($class, $pkgname) { - my ($class, $pkgname) = @_; my $f = installed_info($pkgname).$class->filename; if (!exists $cache->{$f}) { return $cache->{$f} = bless { filename => $f }, $class; @@ -134,9 +124,8 @@ sub new return $cache->{$f}; } -sub forget +sub forget($class, $dir) { - my ($class, $dir) = @_; my $f = $dir.$class->filename; if (exists $cache->{$f}) { $cache->{$f}->{entries} = {}; @@ -144,10 +133,8 @@ sub forget } } -sub compute_closure +sub compute_closure($class, @seed) { - my ($class, @seed) = @_; - my @todo = @seed; my %done = (); @@ -166,12 +153,12 @@ package OpenBSD::RequiredBy; our @ISA=qw(OpenBSD::RequirementList); use OpenBSD::PackageInfo; -sub filename { REQUIRED_BY }; +sub filename($) { REQUIRED_BY }; package OpenBSD::Requiring; our @ISA=qw(OpenBSD::RequirementList); use OpenBSD::PackageInfo; -sub filename { REQUIRING }; +sub filename($) { REQUIRING }; 1; diff --git a/usr.sbin/pkg_add/OpenBSD/Search.pm b/usr.sbin/pkg_add/OpenBSD/Search.pm index 9c201100e0f..7e0a1f2805f 100644 --- a/usr.sbin/pkg_add/OpenBSD/Search.pm +++ b/usr.sbin/pkg_add/OpenBSD/Search.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Search.pm,v 1.32 2021/10/30 13:44:34 espie Exp $ +# $OpenBSD: Search.pm,v 1.33 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007 Marc Espie # @@ -15,22 +15,19 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::Search; -sub match_locations +sub match_locations($self, $o) { - my ($self, $o) = @_; require OpenBSD::PackageLocation; my @l = map {$o->new_location($_)} $self->match($o); return \@l; } -sub keep_all +sub keep_all($self) { - my $self = shift; $self->{keep_all} = 1; return $self; } @@ -38,66 +35,58 @@ sub keep_all package OpenBSD::Search::PkgSpec; our @ISA=(qw(OpenBSD::Search)); -sub filter +sub filter($self, @list) { - my ($self, @list) = @_; return $self->{spec}->match_ref(\@list); } -sub filter_libs +sub filter_libs($self, @list) { - my ($self, @list) = @_; return $self->{spec}->match_libs_ref(\@list); } -sub match_locations +sub match_locations($self, $o) { - my ($self, $o) = @_; return $self->{spec}->match_locations($o->locations_list); } -sub filter_locations +sub filter_locations($self, $l) { - my ($self, $l) = @_; return $self->{spec}->match_locations($l); } -sub new +sub new($class, $pattern, $with_partial = 0) { - my ($class, $pattern, $with_partial) = @_; require OpenBSD::PkgSpec; bless { spec => $class->spec_class->new($pattern, $with_partial)}, $class; } -sub add_pkgpath_hint +sub add_pkgpath_hint($self, $pkgpath) { - my ($self, $pkgpath) = @_; $self->{pkgpath} = $pkgpath; return $self; } -sub spec_class +sub spec_class($) { "OpenBSD::PkgSpec" } -sub is_valid +sub is_valid($self) { - my $self = shift; return $self->{spec}->is_valid; } package OpenBSD::Search::Exact; our @ISA=(qw(OpenBSD::Search::PkgSpec)); -sub spec_class +sub spec_class($) { "OpenBSD::PkgSpec::Exact" } package OpenBSD::Search::Stem; our @ISA=(qw(OpenBSD::Search)); -sub new +sub new($class, $stem) { - my ($class, $stem) = @_; # TODO this is where we currently handle "branch" matches # but it's likely the stem/ % mechanisms should be seen as more # generic cases of PackageSpecs eventually to better results @@ -109,10 +98,8 @@ sub new } } -sub _new +sub _new($class, $stem) { - my ($class, $stem) = @_; - if ($stem =~ m/^(.*)\-\-(.*)/) { # XXX return OpenBSD::Search::Exact->new("$1-*-$2"); @@ -120,25 +107,21 @@ sub _new return bless {"$stem" => 1}, $class; } -sub split +sub split($class, $pkgname) { - my ($class, $pkgname) = @_; require OpenBSD::PackageName; return $class->new(OpenBSD::PackageName::splitstem($pkgname)); } -sub add_stem +sub add_stem($self, $extra) { - my ($self, $extra) = @_; $self->{$extra} = 1; } -sub match +sub match($self, $o) { - my ($self, $o) = @_; - my @r = (); for my $k (keys %$self) { push(@r, $o->stemlist->find($k)); @@ -146,15 +129,13 @@ sub match return @r; } -sub _keep +sub _keep($self, $stem) { - my ($self, $stem) = @_; return defined $self->{$stem}; } -sub filter +sub filter($self, @l) { - my ($self, @l) = @_; my @result = (); require OpenBSD::PackageName; for my $pkg (@l) { @@ -168,9 +149,8 @@ sub filter package OpenBSD::Search::PartialStem; our @ISA=(qw(OpenBSD::Search::Stem)); -sub match +sub match($self, $o) { - my ($self, $o) = @_; my @r = (); for my $k (keys %$self) { push(@r, $o->stemlist->find_partial($k)); @@ -178,9 +158,8 @@ sub match return @r; } -sub _keep +sub _keep($self, $stem) { - my ($self, $stem) = @_; for my $partial (keys %$self) { if ($stem =~ /\Q$partial\E/) { return 1; @@ -191,29 +170,24 @@ sub _keep package OpenBSD::Search::FilterLocation; our @ISA=(qw(OpenBSD::Search)); -sub new +sub new($class, $code) { - my ($class, $code) = @_; - return bless {code => $code}, $class; } -sub filter_locations +sub filter_locations($self, $l) { - my ($self, $l) = @_; return &{$self->{code}}($l); } -sub more_recent_than +sub more_recent_than($class, $name, $rfound) { - my ($class, $name, $rfound) = @_; require OpenBSD::PackageName; my $f = OpenBSD::PackageName->from_string($name); return $class->new( -sub { - my $l = shift; +sub($l) { my $r = []; for my $e (@$l) { if ($f->{version}->compare($e->pkgname->{version}) <= 0) { @@ -227,12 +201,10 @@ sub { }); } -sub keep_most_recent +sub keep_most_recent($class) { - my $class = shift; return $class->new( -sub { - my $l = shift; +sub($l) { # no need to filter return $l if @$l <= 1; @@ -278,12 +250,10 @@ sub { ); } -sub match_partialpath +sub match_partialpath($class, $subdir) { - my ($class, $subdir) = @_; return $class->new( -sub { - my $l = shift; +sub($l) { if (@$l == 0) { return $l; } diff --git a/usr.sbin/pkg_add/OpenBSD/SharedItems.pm b/usr.sbin/pkg_add/OpenBSD/SharedItems.pm index e593e6a2e1d..1f98a6b6118 100644 --- a/usr.sbin/pkg_add/OpenBSD/SharedItems.pm +++ b/usr.sbin/pkg_add/OpenBSD/SharedItems.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: SharedItems.pm,v 1.33 2019/06/09 12:16:07 espie Exp $ +# $OpenBSD: SharedItems.pm,v 1.34 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2004-2006 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::SharedItems; @@ -25,14 +24,12 @@ use OpenBSD::PackageInfo; use OpenBSD::PackingList; use OpenBSD::Paths; -sub find_items_in_installed_packages +sub find_items_in_installed_packages($state) { - my $state = shift; my $db = OpenBSD::SharedItemsRecorder->new; $state->status->what("Read")->object("shared items"); $state->progress->for_list("Read shared items", [installed_packages()], - sub { - my $e = shift; + sub($e) { my $plist = OpenBSD::PackingList->from_installation($e, \&OpenBSD::PackingList::SharedItemsOnly) or return; return if !defined $plist; @@ -41,9 +38,8 @@ sub find_items_in_installed_packages return $db; } -sub check_shared +sub check_shared($set, $o) { - my ($set, $o) = @_; if (!defined $set->{db}) { $set->{db} = OpenBSD::SharedItemsRecorder->new; for my $pkg (installed_packages()) { @@ -62,10 +58,8 @@ sub check_shared } } -sub wipe_directory +sub wipe_directory($state, $h, $d) { - my ($state, $h, $d) = @_; - my $realname = $state->{destdir}.$d; for my $i (@{$h->{$d}}) { @@ -80,10 +74,8 @@ sub wipe_directory return 1; } -sub cleanup +sub cleanup($recorder, $state) { - my ($recorder, $state) = @_; - my $remaining = find_items_in_installed_packages($state); $state->progress->clear; @@ -142,18 +134,17 @@ sub cleanup } package OpenBSD::PackingElement; -sub cleanup +sub cleanup($, $) { } -sub reload +sub reload($, $) { } package OpenBSD::PackingElement::Mandir; -sub cleanup +sub cleanup($self, $state) { - my ($self, $state) = @_; my $fullname = $state->{destdir}.$self->fullname; $state->log->set_context('-'.$self->{pkgname}); $state->log("You may wish to remove #1 from man.conf", $fullname); @@ -163,9 +154,8 @@ sub cleanup } package OpenBSD::PackingElement::Fontdir; -sub cleanup +sub cleanup($self, $state) { - my ($self, $state) = @_; my $fullname = $state->{destdir}.$self->fullname; $state->log->set_context('-'.$self->{pkgname}); $state->log("You may wish to remove #1 from your font path", $fullname); @@ -175,9 +165,8 @@ sub cleanup } package OpenBSD::PackingElement::Infodir; -sub cleanup +sub cleanup($self, $state) { - my ($self, $state) = @_; my $fullname = $state->{destdir}.$self->fullname; for my $f (OpenBSD::Paths->info_cruft) { unlink("$fullname/$f"); diff --git a/usr.sbin/pkg_add/OpenBSD/SharedLibs.pm b/usr.sbin/pkg_add/OpenBSD/SharedLibs.pm index 94134a0f38a..61f663346a5 100644 --- a/usr.sbin/pkg_add/OpenBSD/SharedLibs.pm +++ b/usr.sbin/pkg_add/OpenBSD/SharedLibs.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: SharedLibs.pm,v 1.61 2023/05/21 16:50:50 espie Exp $ +# $OpenBSD: SharedLibs.pm,v 1.62 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2010 Marc Espie # @@ -54,7 +54,6 @@ sub new($class, $state = $class->_basestate) }, $class; } - sub register_library($self, $lib, $pkgname) { $self->{repo}->register($lib, $pkgname); diff --git a/usr.sbin/pkg_add/OpenBSD/Signature.pm b/usr.sbin/pkg_add/OpenBSD/Signature.pm index 04508fab12b..e80f9122945 100644 --- a/usr.sbin/pkg_add/OpenBSD/Signature.pm +++ b/usr.sbin/pkg_add/OpenBSD/Signature.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Signature.pm,v 1.28 2023/05/27 10:04:17 espie Exp $ +# $OpenBSD: Signature.pm,v 1.29 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2010 Marc Espie # @@ -18,66 +18,57 @@ # this is the code that handles "update signatures", which has nothing # to do with cryptography -use strict; -use warnings; +use v5.36; package OpenBSD::PackingElement; -sub signature {} +sub signature($, $) {} package OpenBSD::PackingElement::VersionElement; -sub signature +sub signature($self, $hash) { - my ($self, $hash) = @_; $hash->{$self->signature_key} = $self; } -sub always +sub always($) { return 1; } package OpenBSD::PackingElement::Version; -sub signature +sub signature($self, $hash) { - my ($self, $hash) = @_; - $hash->{VERSION}{name} += $self->name; } package OpenBSD::PackingElement::Dependency; -sub signature_key +sub signature_key($self) { - my $self = shift; return $self->{pkgpath}; } -sub sigspec +sub sigspec($self) { - my $self = shift; return OpenBSD::PackageName->from_string($self->{def}); } -sub long_string +sub long_string($self) { - my $self = shift; return '@'.$self->sigspec->to_string; } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; return $a->sigspec->compare($b->sigspec); } -sub always +sub always($) { return 0; } package OpenBSD::PackingElement::Wantlib; -sub signature_key +sub signature_key($self) { - my $self = shift; my $spec = $self->spec; if ($spec->is_valid) { return $spec->key; @@ -86,46 +77,40 @@ sub signature_key } } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; return $a->spec->compare($b->spec); } -sub long_string +sub long_string($self) { - my $self = shift; return $self->spec->to_string; } -sub always +sub always($) { return 1; } package OpenBSD::PackingElement::Version; -sub signature_key +sub signature_key($) { return 'VERSION'; } -sub long_string +sub long_string($self) { - my $self = shift; return $self->{name}; } -sub compare +sub compare($a, $b) { - my ($a, $b) = @_; return $a->{name} <=> $b->{name}; } package OpenBSD::Signature; -sub from_plist +sub from_plist($class, $plist) { - my ($class, $plist) = @_; - my $k = {}; $k->{VERSION} = OpenBSD::PackingElement::Version->new(0); $plist->visit('signature', $k); @@ -137,34 +122,28 @@ sub from_plist } } -sub full +sub full($) { return "OpenBSD::Signature::Full"; } -sub new +sub new($class, $pkgname, $extra) { - my ($class, $pkgname, $extra) = @_; bless { name => $pkgname, extra => $extra }, $class; } -sub string +sub string($self) { - my $self = shift; return join(',', $self->{name}, sort map {$_->long_string} values %{$self->{extra}}); } -sub compare +sub compare($a, $b, $state) { - my ($a, $b, $state) = @_; return $b->revert_compare($a, $state); } -sub revert_compare +sub revert_compare($b, $a, $state) { - my ($b, $a, $state) = @_; - - if ($a->{name} eq $b->{name}) { # first check if system version changed # then we don't have to go any further @@ -219,10 +198,8 @@ sub revert_compare } } -sub print_error +sub print_error($a, $b, $state) { - my ($a, $b, $state) = @_; - $state->errsay("Error: #1 exists in two non-comparable versions", $a->{name}); $state->errsay("Someone forgot to bump a REVISION"); @@ -232,9 +209,8 @@ sub print_error package OpenBSD::Signature::Full; our @ISA=qw(OpenBSD::Signature); -sub new +sub new($class, $pkgname, $extra, $plist) { - my ($class, $pkgname, $extra, $plist) = @_; my $o = $class->SUPER::new($pkgname, $extra); my $a = $plist->get('always-update'); # TODO remove after 2025 @@ -245,15 +221,13 @@ sub new return $o; } -sub string +sub string($self) { - my $self = shift; return join(',', $self->SUPER::string, $self->{hash}); } -sub revert_compare +sub revert_compare($b, $a, $state) { - my ($b, $a, $state) = @_; my $r = $b->SUPER::revert_compare($a, $state); if (defined $r && $r == 0) { if ($a->string ne $b->string) { @@ -263,9 +237,8 @@ sub revert_compare return $r; } -sub compare +sub compare($a, $b, $state) { - my ($a, $b, $state) = @_; my $r = $a->SUPER::compare($b, $state); if (defined $r && $r == 0) { if ($a->string ne $b->string) { diff --git a/usr.sbin/pkg_add/OpenBSD/Signer.pm b/usr.sbin/pkg_add/OpenBSD/Signer.pm index 9686387e28f..2d545030c07 100644 --- a/usr.sbin/pkg_add/OpenBSD/Signer.pm +++ b/usr.sbin/pkg_add/OpenBSD/Signer.pm @@ -1,6 +1,6 @@ #! /usr/bin/perl # ex:ts=8 sw=4: -# $OpenBSD: Signer.pm,v 1.11 2023/05/17 15:51:58 espie Exp $ +# $OpenBSD: Signer.pm,v 1.12 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2014 Marc Espie # @@ -16,12 +16,12 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; # code necessary to create signed packages # the factory that chooses what method to use to sign things +# we keep that just in case we need to change scheme again package OpenBSD::Signer; use OpenBSD::PackageInfo; @@ -29,10 +29,8 @@ my $h = { signify2 => 'OpenBSD::Signer::SIGNIFY2', }; -sub factory +sub factory($class, $state) { - my ($class, $state) = @_; - my @p = @{$state->{signature_params}}; if (defined $h->{$p[0]}) { @@ -44,9 +42,8 @@ sub factory package OpenBSD::Signer::SIGNIFY2; our @ISA = qw(OpenBSD::Signer); -sub new +sub new($class, $state, @p) { - my ($class, $state, @p) = @_; if (@p != 2 || !-f $p[1]) { $state->usage("$p[0] signature wants -s privkey"); } @@ -54,9 +51,8 @@ sub new return $o; } -sub sign +sub sign($signer, $pkg, $state, $tmp) { - my ($signer, $pkg, $state, $tmp) = @_; my $privkey = $signer->{privkey}; my $url = $pkg->url; if (!$pkg->{repository}->is_local_file) { @@ -68,7 +64,7 @@ sub sign $state->system(OpenBSD::Paths->signify, '-zS', '-s', $privkey, '-m', $url, '-x', $tmp); } -sub want_local +sub want_local($) { return 1; } @@ -76,9 +72,8 @@ sub want_local package OpenBSD::CreateSign::State; our @ISA = qw(OpenBSD::AddCreateDelete::State); -sub create_archive +sub create_archive($state, $filename, $dir) { - my ($state, $filename, $dir) = @_; require IO::Compress::Gzip; my $level = $state->{subst}->value('COMPRESSION_LEVEL') // 6; my $fh = IO::Compress::Gzip->new($filename, @@ -88,9 +83,8 @@ sub create_archive return OpenBSD::Ustar->new($fh, $state, $dir); } -sub new_gstream +sub new_gstream($state) { - my $state = shift; close($state->{archive}{fh}); my $level = $state->{subst}->value('COMPRESSION_LEVEL') // 6; $state->{archive}{fh} =IO::Compress::Gzip->new( @@ -100,9 +94,8 @@ sub new_gstream $state->{archive_filename}, $!); } -sub ntodo +sub ntodo($self, $offset = 0) { - my ($self, $offset) = @_; return sprintf("%u/%u", $self->{done}-$offset, $self->{total}); } diff --git a/usr.sbin/pkg_add/OpenBSD/State.pm b/usr.sbin/pkg_add/OpenBSD/State.pm index 46d55f93ef1..cc671073f09 100644 --- a/usr.sbin/pkg_add/OpenBSD/State.pm +++ b/usr.sbin/pkg_add/OpenBSD/State.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: State.pm,v 1.73 2023/05/21 16:07:35 espie Exp $ +# $OpenBSD: State.pm,v 1.74 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2014 Marc Espie # @@ -16,65 +16,52 @@ # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; package OpenBSD::PackageRepositoryFactory; -sub new +sub new($class, $state) { - my ($class, $state) = @_; return bless {state => $state}, $class; } -sub locator +sub locator($self) { - my $self = shift; return $self->{state}->locator; } -sub installed +sub installed($self, $all = 0) { - my ($self, $all) = @_; require OpenBSD::PackageRepository::Installed; return OpenBSD::PackageRepository::Installed->new($all, $self->{state}); } -sub path_parse +sub path_parse($self, $pkgname) { - my ($self, $pkgname) = @_; - return $self->locator->path_parse($pkgname, $self->{state}); } -sub find +sub find($self, $pkg) { - my ($self, $pkg) = @_; - return $self->locator->find($pkg, $self->{state}); } -sub reinitialize +sub reinitialize($) { } -sub match_locations +sub match_locations($self, @p) { - my $self = shift; - - return $self->locator->match_locations(@_, $self->{state}); + return $self->locator->match_locations(@p, $self->{state}); } -sub grabPlist +sub grabPlist($self, $url, $code) { - my ($self, $url, $code) = @_; - return $self->locator->grabPlist($url, $code, $self->{state}); } -sub path +sub path($self) { - my $self = shift; require OpenBSD::PackageRepositoryList; return OpenBSD::PackageRepositoryList->new($self->{state}); @@ -88,33 +75,30 @@ use OpenBSD::Error; use parent qw(OpenBSD::BaseState Exporter); our @EXPORT = (); -sub locator +sub locator($) { require OpenBSD::PackageLocator; return "OpenBSD::PackageLocator"; } -sub cache_directory +sub cache_directory($) { return undef; } -sub new +sub new($class, $cmd = undef, @p) { - my $class = shift; - my $cmd = shift; if (!defined $cmd) { $cmd = $0; $cmd =~ s,.*/,,; } my $o = bless {cmd => $cmd}, $class; - $o->init(@_); + $o->init(@p); return $o; } -sub init +sub init($self) { - my $self = shift; $self->{subst} = OpenBSD::Subst->new; $self->{repo} = OpenBSD::PackageRepositoryFactory->new($self); $self->{export_level} = 1; @@ -123,22 +107,20 @@ sub init } } -sub repo +sub repo($self) { - my $self = shift; return $self->{repo}; } -sub handle_continue +sub handle_continue($self) { - my $self = shift; $self->find_window_size; # invalidate cache so this runs again after continue delete $self->{can_output}; } OpenBSD::Auto::cache(can_output, - sub { + sub($) { require POSIX; return 1 if !-t STDOUT; @@ -151,8 +133,7 @@ OpenBSD::Auto::cache(can_output, }); OpenBSD::Auto::cache(installpath, - sub { - my $self = shift; + sub($self) { return undef if $self->defines('NOINSTALLPATH'); require OpenBSD::Paths; open(my $fh, '<', OpenBSD::Paths->installurl) or return undef; @@ -165,36 +146,31 @@ OpenBSD::Auto::cache(installpath, }); OpenBSD::Auto::cache(shlibs, - sub { - my $self = shift; + sub($self) { require OpenBSD::SharedLibs; return $self->{shlibs} //= OpenBSD::SharedLibs->new($self); }); -sub usage_is +sub usage_is($self, @usage) { - my ($self, @usage) = @_; $self->{usage} = \@usage; } -sub verbose +sub verbose($self) { - my $self = shift; return $self->{v}; } -sub opt +sub opt($self, $k) { - my ($self, $k) = @_; return $self->{opt}{$k}; } -sub usage +sub usage($self, @p) { - my $self = shift; my $code = 0; - if (@_) { - print STDERR "$self->{cmd}: ", $self->f(@_), "\n"; + if (@p) { + print STDERR "$self->{cmd}: ", $self->f(@p), "\n"; $code = 1; } print STDERR "Usage: $self->{cmd} ", shift(@{$self->{usage}}), "\n"; @@ -204,30 +180,32 @@ sub usage exit($code); } -sub do_options +sub do_options($state, $sub) { - my ($state, $sub) = @_; # this could be nicer... try { - &$sub; + &$sub(); } catch { $state->usage("#1", $_); }; } -sub handle_options +sub handle_options($state, $opt_string, @usage) { - my ($state, $opt_string, @usage) = @_; require OpenBSD::Getopt; $state->{opt}{v} = 0 unless $opt_string =~ m/v/; - $state->{opt}{h} = sub { $state->usage; } unless $opt_string =~ m/h/; - $state->{opt}{D} = sub { - $state->{subst}->parse_option(shift); - } unless $opt_string =~ m/D/; + $state->{opt}{h} = + sub() { + $state->usage; + } unless $opt_string =~ m/h/; + $state->{opt}{D} = + sub($opt) { + $state->{subst}->parse_option($opt); + } unless $opt_string =~ m/D/; $state->usage_is(@usage); - $state->do_options(sub { + $state->do_options(sub() { OpenBSD::Getopt::getopts($opt_string.'hvD:', $state->{opt}); }); $state->{v} = $state->opt('v'); @@ -241,7 +219,7 @@ sub handle_options } return if $state->{no_exports}; - # XXX + # TODO make sure nothing uses this no strict "refs"; no strict "vars"; for my $k (keys %{$state->{opt}}) { @@ -252,33 +230,29 @@ sub handle_options OpenBSD::State->import; } -sub defines +sub defines($self, $k) { - my ($self, $k) = @_; return $self->{subst}->value($k); } -sub width +sub width($self) { - my $self = shift; if (!defined $self->{width}) { $self->find_window_size; } return $self->{width}; } -sub height +sub height($self) { - my $self = shift; if (!defined $self->{height}) { $self->find_window_size; } return $self->{height}; } -sub find_window_size +sub find_window_size($self) { - my $self = shift; require Term::ReadKey; my @l = Term::ReadKey::GetTermSizeGWINSZ(\*STDOUT); # default to sane values @@ -295,8 +269,7 @@ sub find_window_size } OpenBSD::Auto::cache(signer_list, - sub { - my $self = shift; + sub($self) { if ($self->defines('SIGNER')) { return [split /,/, $self->{subst}->value('SIGNER')]; } else { diff --git a/usr.sbin/pkg_add/OpenBSD/Subst.pm b/usr.sbin/pkg_add/OpenBSD/Subst.pm index f863b37c943..e8934115fbd 100644 --- a/usr.sbin/pkg_add/OpenBSD/Subst.pm +++ b/usr.sbin/pkg_add/OpenBSD/Subst.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Subst.pm,v 1.19 2023/05/27 10:05:50 espie Exp $ +# $OpenBSD: Subst.pm,v 1.20 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2008 Marc Espie # @@ -15,40 +15,37 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; # very simple package, just holds everything needed for substitution # according to package rules. package OpenBSD::Subst; -sub new +# XXX ReverseSubst takes a state as an extra parameter +sub new($class, @) { - bless {}, shift; + bless {}, $class; } -sub hash +sub hash($self) { - shift; + return $self; } -sub add +sub add($self, $k, $v) { - my ($self, $k, $v) = @_; $k =~ s/^\^//; $self->{$k} = $v; } -sub value +sub value($self, $k) { - my ($self, $k) = @_; return $self->{$k}; } -sub parse_option +sub parse_option($self, $opt) { - my ($self, $opt) = @_; if ($opt =~ m/^([^=]+)\=(.*)$/o) { my ($k, $v) = ($1, $2); $v =~ s/^\'(.*)\'$/$1/; @@ -59,10 +56,8 @@ sub parse_option } } -sub do +sub do($self, $s) { - my $self = shift; - my $s = shift; return $s unless $s =~ m/\$/o; # no need to subst if no $ while ( my $k = ($s =~ m/\$\{([A-Za-z_][^\}]*)\}/o)[0] ) { my $v = $self->{$k}; @@ -73,9 +68,8 @@ sub do return $s; } -sub copy_fh2 +sub copy_fh2($self, $src, $dest) { - my ($self, $src, $dest) = @_; my $contents = do { local $/; <$src> }; while (my ($k, $v) = each %{$self}) { $contents =~ s/\$\{\Q$k\E\}/$v/g; @@ -84,25 +78,21 @@ sub copy_fh2 print $dest $contents; } -sub copy_fh +sub copy_fh($self, $srcname, $dest) { - my ($self, $srcname, $dest) = @_; open my $src, '<', $srcname or die "can't open $srcname: $!"; $self->copy_fh2($src, $dest); } -sub copy +sub copy($self, $srcname, $destname) { - my ($self, $srcname, $destname) = @_; open my $dest, '>', $destname or die "can't open $destname: $!"; $self->copy_fh($srcname, $dest); return $dest; } -sub has_fragment +sub has_fragment($self, $def, $frag, $msg) { - my ($self, $def, $frag, $msg) = @_; - my $v = $self->value($def); if (!defined $v) { @@ -116,10 +106,8 @@ sub has_fragment } } -sub empty +sub empty($self, $k) { - my ($self, $k) = @_; - my $v = $self->value($k); if (defined $v && $v) { return 0; diff --git a/usr.sbin/pkg_add/OpenBSD/Temp.pm b/usr.sbin/pkg_add/OpenBSD/Temp.pm index 754bae9160b..a3b4dcceba7 100644 --- a/usr.sbin/pkg_add/OpenBSD/Temp.pm +++ b/usr.sbin/pkg_add/OpenBSD/Temp.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Temp.pm,v 1.38 2019/07/24 09:03:12 espie Exp $ +# $OpenBSD: Temp.pm,v 1.39 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2005 Marc Espie # @@ -15,8 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; package OpenBSD::Temp; @@ -35,7 +34,7 @@ my $files = {}; my ($lastname, $lasterror, $lasttype); OpenBSD::Handler->atend( - sub { + sub($) { while (my ($name, $pid) = each %$files) { unlink($name) if $pid == $$; } @@ -45,10 +44,10 @@ OpenBSD::Handler->atend( }); -sub dir +sub dir($) { my $caught; - my $h = sub { $caught = shift; }; + my $h = sub($sig, @) { $caught = $sig; }; my $dir; { @@ -72,11 +71,10 @@ sub dir } } -sub fh_file +sub fh_file($stem, $cleanup) { - my ($stem, $cleanup) = @_; my $caught; - my $h = sub { $caught = shift; }; + my $h = sub($sig, @) { $caught = $sig; }; my ($fh, $file); { @@ -96,22 +94,20 @@ sub fh_file return ($fh, $file); } -sub file +sub file($) { return (fh_file("pkgout", - sub { my $n = shift; $files->{$n} = $$; })) [1]; + sub($name) { $files->{$name} = $$; })) [1]; } -sub reclaim +sub reclaim($class, $name) { - my ($class, $name) = @_; delete $files->{$name}; delete $dirs->{$name}; } -sub permanent_file +sub permanent_file($dir, $stem) { - my ($dir, $stem) = @_; my $template = "$stem.XXXXXXXXXX"; if (defined $dir) { $template = "$dir/$template"; @@ -123,9 +119,8 @@ sub permanent_file return (); } -sub permanent_dir +sub permanent_dir($dir, $stem) { - my ($dir, $stem) = @_; my $template = "$stem.XXXXXXXXXX"; if (defined $dir) { $template = "$dir/$template"; @@ -137,12 +132,9 @@ sub permanent_dir return undef; } -sub last_error +sub last_error($class, $template = "User #1 couldn't create temp #2 as #3: #4") { - my ($class, $template) = @_; - my ($user) = getpwuid($>); - $template //= "User #1 couldn't create temp #2 as #3: #4"; return ($template, $user, $lasttype, $lastname, $lasterror); } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/Tracker.pm b/usr.sbin/pkg_add/OpenBSD/Tracker.pm index 8ea46e51cce..4f25a8d424c 100644 --- a/usr.sbin/pkg_add/OpenBSD/Tracker.pm +++ b/usr.sbin/pkg_add/OpenBSD/Tracker.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Tracker.pm,v 1.30 2023/05/27 10:06:38 espie Exp $ +# $OpenBSD: Tracker.pm,v 1.31 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2009 Marc Espie # @@ -28,7 +28,7 @@ # the Tracker object does maintain that information globally so that # Update/Dependencies can do its job. -use strict; +use v5.36; use warnings; package OpenBSD::Tracker; @@ -36,15 +36,13 @@ package OpenBSD::Tracker; # XXX we're a singleton class our $s; -sub new +sub new($class) { - my $class = shift; return $s //= bless {}, $class; } -sub dump2 +sub dump2($set) { - my $set = shift; if (defined $set->{merged}) { return "merged from ".dump2($set->{merged}); } @@ -55,7 +53,7 @@ sub dump2 join(",", $set->hint_names)); } -sub dump +sub dump() { return unless defined $s; for my $l ('to_install', 'to_update') { @@ -71,33 +69,29 @@ sub dump } } -sub sets_todo +sub sets_todo($self, $offset = 0) { - my ($self, $offset) = @_; return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset, scalar keys %{$self->{total}}); } -sub handle_set +sub handle_set($self, $set) { - my ($self, $set) = @_; $self->{total}{$set} = 1; if ($set->{finished}) { $self->{done}{$set} = 1; } } -sub known +sub known($self, $set) { - my ($self, $set) = @_; for my $n ($set->newer, $set->older, $set->hints) { $self->{known}{$n->pkgname} = 1; } } -sub add_set +sub add_set($self, $set) { - my ($self, $set) = @_; for my $n ($set->newer) { $self->{to_install}{$n->pkgname} = $set; } @@ -113,18 +107,16 @@ sub add_set return $self; } -sub todo +sub todo($self, @sets) { - my ($self, @sets) = @_; for my $set (@sets) { $self->add_set($set); } return $self; } -sub remove_set +sub remove_set($self, $set) { - my ($self, $set) = @_; for my $n ($set->newer) { delete $self->{to_install}{$n->pkgname}; delete $self->{cant_install}{$n->pkgname}; @@ -136,9 +128,8 @@ sub remove_set $self->handle_set($set); } -sub uptodate +sub uptodate($self, $set) { - my ($self, $set) = @_; $set->{finished} = 1; $self->remove_set($set); for my $n ($set->older, $set->kept) { @@ -146,9 +137,8 @@ sub uptodate } } -sub cant +sub cant($self, $set) { - my ($self, $set) = @_; $set->{finished} = 1; $self->remove_set($set); $self->known($set); @@ -163,10 +153,8 @@ sub cant } } -sub done +sub done($self, $set) { - my ($self, $set) = @_; - $set->{finished} = 1; $self->remove_set($set); $self->known($set); @@ -180,10 +168,8 @@ sub done } } -sub is +sub is($self, $k, $pkg) { - my ($self, $k, $pkg) = @_; - my $set = $self->{$k}{$pkg}; if (ref $set) { return $set->real_set; @@ -192,33 +178,28 @@ sub is } } -sub is_known +sub is_known($self, $pkg) { - my ($self, $pkg) = @_; return $self->is('known', $pkg); } -sub is_installed +sub is_installed($self, $pkg) { - my ($self, $pkg) = @_; return $self->is('installed', $pkg); } -sub is_to_update +sub is_to_update($self, $pkg) { - my ($self, $pkg) = @_; return $self->is('to_update', $pkg); } -sub cant_list +sub cant_list($self) { - my $self = shift; return keys %{$self->{cant_update}}; } -sub cant_install_list +sub cant_install_list($self) { - my $self = shift; return keys %{$self->{cant_install}}; } diff --git a/usr.sbin/pkg_add/OpenBSD/Update.pm b/usr.sbin/pkg_add/OpenBSD/Update.pm index 31decd846db..0ac0bc10395 100644 --- a/usr.sbin/pkg_add/OpenBSD/Update.pm +++ b/usr.sbin/pkg_add/OpenBSD/Update.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Update.pm,v 1.169 2023/05/27 10:06:55 espie Exp $ +# $OpenBSD: Update.pm,v 1.170 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2004-2014 Marc Espie # @@ -14,31 +14,26 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; package OpenBSD::Handle; -sub update +sub update($self, $updater, $set, $state) { - my ($self, $updater, $set, $state) = @_; return $updater->process_handle($set, $self, $state); } # TODO hint and hint2 are horrible names package OpenBSD::hint; -sub update +sub update($self, $updater, $set, $state) { - my ($self, $updater, $set, $state) = @_; return $updater->process_hint($set, $self, $state); } package OpenBSD::hint2; -sub update +sub update($self, $updater, $set, $state) { - my ($self, $updater, $set, $state) = @_; - return $updater->process_hint2($set, $self, $state); } @@ -48,31 +43,25 @@ use OpenBSD::PackageName; use OpenBSD::Error; use OpenBSD::UpdateSet; -sub new +sub new($class) { - my $class = shift; return bless {}, $class; } -sub add_handle +sub add_handle($self, $set, $old, $n) { - my ($self, $set, $old, $n) = @_; $old->{update_found} = $n; $set->add_newer($n); } -sub add_location +sub add_location($self, $set, $handle, $location) { - my ($self, $set, $handle, $location) = @_; - $self->add_handle($set, $handle, OpenBSD::Handle->from_location($location)); } -sub look_for_debug +sub look_for_debug($self, $set, $oldname, $newname, $state) { - my ($self, $set, $oldname, $newname, $state) = @_; - # hurdles to pass before adding debug packages return unless $state->{debug_packages}; @@ -85,26 +74,22 @@ sub look_for_debug $set->add_newer(OpenBSD::Handle->from_location($l->[0])); } -sub found_update +sub found_update($self, $set, $old, $location, $state) { - my ($self, $set, $old, $location, $state) = @_; - $self->add_location($set, $old, $location); $self->look_for_debug($set, $old->pkgname, $location->name, $state); } -sub progress_message +sub progress_message($self, $state, @r) { - my ($self, $state, @r) = @_; my $msg = $state->f(@r); $msg .= $state->ntogo_string; $state->progress->message($msg); $state->say($msg) if $state->verbose >= 2; } -sub process_handle +sub process_handle($self, $set, $h, $state) { - my ($self, $set, $h, $state) = @_; my $pkgname = $h->pkgname; if ($pkgname =~ m/^\.libs\d*\-/o) { @@ -114,8 +99,7 @@ sub process_handle if (!$set->{quirks}) { my $base = 0; $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $base = $quirks->is_base_system($h, $state); }); if ($base) { @@ -150,8 +134,7 @@ sub process_handle if (!$set->{quirks}) { $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $quirks->tweak_search(\@search, $h, $state); }); } @@ -178,8 +161,7 @@ sub process_handle push(@search, OpenBSD::Search::FilterLocation->more_recent_than($sname, \$oldfound)); } push(@search, OpenBSD::Search::FilterLocation->new( - sub { - my $l = shift; + sub($l) { if (@$l == 0) { return $l; } @@ -251,10 +233,8 @@ sub process_handle } } -sub say_skipped_packages +sub say_skipped_packages($self, $state, $o, $n) { - my ($self, $state, $o, $n) = @_; - my $o_name = $o->pkgname; my @o_ps = map { @{$o->pkgpath->{$_}} } keys %{$o->pkgpath}; my $o_pp = join(" ", map {$_->fullpkgpath} @o_ps); @@ -269,10 +249,8 @@ sub say_skipped_packages $state->say($t, $n_name, $o_name, $n_pp, $o_pp); } -sub find_nearest +sub find_nearest($base, $locs) { - my ($base, $locs) = @_; - my $pkgname = OpenBSD::PackageName->from_string($base); return undef if !defined $pkgname->{version}; my @sorted = sort {$a->pkgname->{version}->compare($b->pkgname->{version}) } @$locs; @@ -285,10 +263,8 @@ sub find_nearest return undef; } -sub process_hint +sub process_hint($self, $set, $hint, $state) { - my ($self, $set, $hint, $state) = @_; - my $l; my $hint_name = $hint->pkgname; my $k = OpenBSD::Search::FilterLocation->keep_most_recent; @@ -301,8 +277,7 @@ sub process_hint $t =~ s/\-\d([^-]*)\-?/--/; my @search = (OpenBSD::Search::Stem->new($t)); $state->run_quirks( - sub { - my $quirks = shift; + sub($quirks) { $quirks->tweak_search(\@search, $hint, $state); }); $l = $set->match_locations(@search, $k); @@ -326,9 +301,8 @@ sub process_hint my $cache = {}; -sub process_hint2 +sub process_hint2($self, $set, $hint, $state) { - my ($self, $set, $hint, $state) = @_; my $pkgname = $hint->pkgname; my $pkg2; if ($pkgname =~ m/[\/\:]/o) { @@ -359,9 +333,8 @@ sub process_hint2 return 1; } -sub process_set +sub process_set($self, $set, $state) { - my ($self, $set, $state) = @_; my @problems = (); for my $h ($set->older, $set->hints) { next if $h->{update_found}; @@ -384,9 +357,8 @@ sub process_set return 1; } -sub stem2location +sub stem2location($self, $locator, $name, $state, $is_quirks = 0) { - my ($self, $locator, $name, $state, $is_quirks) = @_; my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name)); if (@$l > 1 && !$state->defines('allversions')) { $l = OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l); diff --git a/usr.sbin/pkg_add/OpenBSD/UpdateSet.pm b/usr.sbin/pkg_add/OpenBSD/UpdateSet.pm index 64df690163b..4bdebae20a5 100644 --- a/usr.sbin/pkg_add/OpenBSD/UpdateSet.pm +++ b/usr.sbin/pkg_add/OpenBSD/UpdateSet.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: UpdateSet.pm,v 1.88 2023/05/27 10:07:12 espie Exp $ +# $OpenBSD: UpdateSet.pm,v 1.89 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2007-2010 Marc Espie # @@ -41,20 +41,18 @@ # for instance, package installation will check UpdateSets for internal # dependencies and for conflicts. For that to work, we need kept stuff # -use strict; -use warnings; +use v5.36; # hints should behave like locations package OpenBSD::hint; -sub new +sub new($class, $name) { - my ($class, $name) = @_; bless {name => $name}, $class; } -sub pkgname +sub pkgname($self) { - return shift->{name}; + return $self->{name}; } package OpenBSD::hint2; @@ -67,53 +65,47 @@ our @ISA = qw(OpenBSD::hint); package OpenBSD::DeleteSet; use OpenBSD::Error; -sub new +sub new($class, $state) { - my ($class, $state) = @_; return bless {older => {}}, $class; } -sub add_older +sub add_older($self, @p) { - my $self = shift; - for my $h (@_) { + for my $h (@p) { $self->{older}{$h->pkgname} = $h; $h->{is_old} = 1; } return $self; } -sub older +sub older($self) { - my $self = shift; return values %{$self->{older}}; } -sub older_names +sub older_names($self) { - my $self = shift; return keys %{$self->{older}}; } -sub all_handles +sub all_handles # forwarder { &older; } -sub changed_handles +sub changed_handles # forwarder { &older; } -sub mark_as_finished +sub mark_as_finished($self) { - my $self = shift; $self->{finished} = 1; } -sub cleanup +sub cleanup($self, $error = undef, $errorinfo = undef) { - my ($self, $error, $errorinfo) = @_; for my $h ($self->all_handles) { $h->cleanup($error, $errorinfo); } @@ -130,45 +122,42 @@ sub cleanup $self->mark_as_finished; } -sub has_error +sub has_error # forwarder { &OpenBSD::Handle::has_error; } # display code that will put together packages with the same version -sub smart_join +sub smart_join($self, @p) { - my $self = shift; - if (@_ <= 1) { - return join('+', @_); + if (@p <= 1) { + return join('+', @p); } my ($k, @stems); - for my $l (@_) { + for my $l (@p) { my ($stem, @rest) = OpenBSD::PackageName::splitname($l); my $k2 = join('-', @rest); $k //= $k2; if ($k2 ne $k) { - return join('+', sort @_); + return join('+', sort @p); } push(@stems, $stem); } return join('+', sort @stems).'-'.$k; } -sub print +sub print($self) { - my $self = shift; return $self->smart_join($self->older_names); } -sub todo_names +sub todo_names # forwarder { &older_names; } -sub short_print +sub short_print($self) { - my $self = shift; my $result = $self->smart_join($self->todo_names); if (length $result > 30) { return substr($result, 0, 27)."..."; @@ -177,18 +166,16 @@ sub short_print } } -sub real_set +sub real_set($set) { - my $set = shift; while (defined $set->{merged}) { $set = $set->{merged}; } return $set; } -sub merge_set +sub merge_set($self, $set) { - my ($self, $set) = @_; $self->add_older($set->older); $set->mark_as_finished; # XXX and mark it as merged, for eventual updates @@ -196,10 +183,8 @@ sub merge_set } # Merge several deletesets together -sub merge +sub merge($self, $tracker, @sets) { - my ($self, $tracker, @sets) = @_; - # Apparently simple, just add the missing parts for my $set (@sets) { next if $set eq $self; @@ -211,19 +196,19 @@ sub merge return $self; } -sub match_locations +sub match_locations($, @) { return []; } OpenBSD::Auto::cache(solver, - sub { + sub($self) { require OpenBSD::Dependencies; - return OpenBSD::Dependencies::Solver->new(shift); + return OpenBSD::Dependencies::Solver->new($self); }); OpenBSD::Auto::cache(conflict_cache, - sub { + sub($) { require OpenBSD::Dependencies; return OpenBSD::ConflictCache->new; }); @@ -231,9 +216,8 @@ OpenBSD::Auto::cache(conflict_cache, package OpenBSD::UpdateSet; our @ISA = qw(OpenBSD::DeleteSet); -sub new +sub new($class, $state) { - my ($class, $state) = @_; my $o = $class->SUPER::new($state); $o->{newer} = {}; $o->{kept} = {}; @@ -243,27 +227,22 @@ sub new return $o; } -sub path +# TODO this stuff is mostly unused right now (or buggy) +sub path($set) { - my $set = shift; - return $set->{path}; } -sub add_repositories +sub add_repositories($set, @repos) { - my ($set, @repos) = @_; - if (!defined $set->{path}) { $set->{path} = $set->{repo}->path; } $set->{path}->add(@repos); } -sub merge_paths +sub merge_paths($set, $other) { - my ($set, $other) = @_; - if (defined $other->path) { if (!defined $set->path) { $set->{path} = $other->path; @@ -273,9 +252,8 @@ sub merge_paths } } -sub match_locations +sub match_locations($set, @spec) { - my ($set, @spec) = @_; my $r = []; if (defined $set->{path}) { $r = $set->{path}->match_locations(@spec); @@ -286,29 +264,26 @@ sub match_locations return $r; } -sub add_newer +sub add_newer($self, @p) { - my $self = shift; - for my $h (@_) { + for my $h (@p) { $self->{newer}{$h->pkgname} = $h; $self->{updates}++; } return $self; } -sub add_kept +sub add_kept($self, @p) { - my $self = shift; - for my $h (@_) { + for my $h (@p) { $self->{kept}->{$h->pkgname} = $h; } return $self; } -sub move_kept +sub move_kept($self, @p) { - my $self = shift; - for my $h (@_) { + for my $h (@p) { delete $self->{older}{$h->pkgname}; delete $self->{newer}{$h->pkgname}; $self->{kept}{$h->pkgname} = $h; @@ -322,75 +297,64 @@ sub move_kept return $self; } -sub add_hints +sub add_hints($self, @p) { - my $self = shift; - for my $h (@_) { + for my $h (@p) { push(@{$self->{hints}}, OpenBSD::hint->new($h)); } return $self; } -sub add_hints2 +sub add_hints2($self, @p) { - my $self = shift; - for my $h (@_) { + for my $h (@p) { push(@{$self->{hints}}, OpenBSD::hint2->new($h)); } return $self; } -sub newer +sub newer($self) { - my $self = shift; return values %{$self->{newer}}; } -sub kept +sub kept($self) { - my $self = shift; return values %{$self->{kept}}; } -sub hints +sub hints($self) { - my $self = shift; return @{$self->{hints}}; } -sub newer_names +sub newer_names($self) { - my $self = shift; return keys %{$self->{newer}}; } -sub kept_names +sub kept_names($self) { - my $self = shift; return keys %{$self->{kept}}; } -sub all_handles +sub all_handles($self) { - my $self = shift; return ($self->older, $self->newer, $self->kept); } -sub changed_handles +sub changed_handles($self) { - my $self = shift; return ($self->older, $self->newer); } -sub hint_names +sub hint_names($self) { - my $self = shift; return map {$_->pkgname} $self->hints; } -sub older_to_do +sub older_to_do($self) { - my $self = shift; # XXX in `combined' updates, some dependencies may remove extra # packages, so we do a double-take on the list of packages we # are actually replacing... for now, until we merge update sets. @@ -404,9 +368,8 @@ sub older_to_do return @l; } -sub print +sub print($self) { - my $self = shift; my $result = ""; if ($self->kept > 0) { $result = "[".$self->smart_join($self->kept_names)."]"; @@ -440,9 +403,8 @@ sub print return $result; } -sub todo_names +sub todo_names($self) { - my $self = shift; if ($self->newer > 0) { return $self->newer_names; } else { @@ -450,9 +412,8 @@ sub todo_names } } -sub validate_plists +sub validate_plists($self, $state) { - my ($self, $state) = @_; $state->{problems} = 0; delete $state->{overflow}; @@ -496,9 +457,8 @@ sub validate_plists } } -sub cleanup_old_shared +sub cleanup_old_shared($set, $state) { - my ($set, $state) = @_; my $h = $set->{old_shared}; for my $d (sort {$b cmp $a} keys %$h) { @@ -509,19 +469,16 @@ sub cleanup_old_shared } my @extra = qw(solver conflict_cache); -sub mark_as_finished +sub mark_as_finished($self) { - my $self = shift; for my $i (@extra, 'sha') { delete $self->{$i}; } $self->SUPER::mark_as_finished; } -sub merge_if_exists +sub merge_if_exists($self, $k, @extra) { - my ($self, $k, @extra) = @_; - my @list = (); for my $s (@extra) { if ($s ne $self && defined $s->{$k}) { @@ -531,9 +488,8 @@ sub merge_if_exists $self->$k->merge(@list); } -sub merge_set +sub merge_set($self, $set) { - my ($self, $set) = @_; $self->SUPER::merge_set($set); $self->add_newer($set->newer); $self->add_kept($set->kept); @@ -543,10 +499,8 @@ sub merge_set } # Merge several updatesets together -sub merge +sub merge($self, $tracker, @sets) { - my ($self, $tracker, @sets) = @_; - for my $i (@extra) { $self->merge_if_exists($i, @sets); } diff --git a/usr.sbin/pkg_add/OpenBSD/Ustar.pm b/usr.sbin/pkg_add/OpenBSD/Ustar.pm index 608668eba2c..0fce9df252c 100644 --- a/usr.sbin/pkg_add/OpenBSD/Ustar.pm +++ b/usr.sbin/pkg_add/OpenBSD/Ustar.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Ustar.pm,v 1.95 2023/05/27 10:07:33 espie Exp $ +# $OpenBSD: Ustar.pm,v 1.96 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2002-2014 Marc Espie # @@ -17,8 +17,7 @@ # Handle utar archives -use strict; -use warnings; +use v5.36; package OpenBSD::Ustar; @@ -57,12 +56,8 @@ our $gnamecache = OpenBSD::GnameCache->new; # This is a multiple of st_blksize everywhere.... my $buffsize = 2 * 1024 * 1024; -sub new +sub new($class, $fh, $state, $destdir = '') { - my ($class, $fh, $state, $destdir) = @_; - - $destdir = '' unless defined $destdir; - return bless { fh => $fh, swallow => 0, @@ -73,41 +68,36 @@ sub new # $self->set_description($description): # application-level description of the archive for error messages -sub set_description +sub set_description($self, $d) { - my ($self, $d) = @_; $self->{description} = $d; } # $self->set_callback(sub($size_done) {}): # for large file extraction, provide intermediate callbacks with the # size already done for progress meters and the likes -sub set_callback +sub set_callback($self, $code) { - my ($self, $code) = @_; $self->{callback} = $code; } -sub _fatal +sub _fatal($self, $msg, @args) { - my ($self, $msg, @args) = @_; $self->{state}->fatal("Ustar [#1][#2]: #3", $self->{description} // '?', $self->{lastname} // '?', $self->{state}->f($msg, @args)); } -sub _new_object +sub _new_object($self, $h, $class) { - my ($self, $h, $class) = @_; $h->{archive} = $self; $h->{destdir} = $self->{destdir}; bless $h, $class; return $h; } -sub skip +sub skip($self) { - my $self = shift; my $temp; while ($self->{swallow} > 0) { @@ -145,9 +135,8 @@ my $unsupported = { }; # helpers for the XHDR type -sub _read_records +sub _read_records($self, $size) { - my ($self, $size) = @_; my $toread = $self->{swallow}; my $result = ''; while ($toread > 0) { @@ -168,9 +157,8 @@ sub _read_records return substr($result, 0, $size); } -sub _parse_records +sub _parse_records($self, $result, $h) { - my ($self, $result, $h) = @_; open(my $fh, '<', \$h); while (<$fh>) { chomp; @@ -185,9 +173,8 @@ sub _parse_records } } -sub next +sub next($self) { - my $self = shift; # get rid of the current object $self->skip; my $header; @@ -275,9 +262,8 @@ sub next } # helper for prepare: ustar has strong limitations wrt directory/filename -sub _split_name +sub _split_name($name) { - my $name = shift; my $prefix = ''; my $l = length $name; @@ -293,9 +279,8 @@ sub _split_name } # helper for prepare -sub _extended_record +sub _extended_record($k, $v) { - my ($k, $v) = @_; my $string = " $k=$v\n"; my $len = length($string); if ($len < 995) { @@ -307,10 +292,9 @@ sub _extended_record } } -sub _pack_header +sub _pack_header($archive, $type, $size, $entry, $prefix, $name, $linkname, + $uname, $gname, $major, $minor) { - my ($archive, $type, $size, $entry, $prefix, $name, $linkname, - $uname, $gname, $major, $minor) = @_; my $header; my $cksum = ' 'x8; @@ -338,9 +322,8 @@ sub _pack_header my $whatever = "usualSuspect000"; -sub _mkheader +sub _mkheader($archive, $entry, $type) { - my ($archive, $entry, $type) = @_; my ($prefix, $name) = _split_name($entry->name); my ($extendedname, $extendedlink); my $linkname = $entry->{linkname}; @@ -412,11 +395,8 @@ sub _mkheader return $header; } -sub prepare +sub prepare($self, $filename, $destdir = $self->{destdir}) { - my ($self, $filename, $destdir) = @_; - - $destdir //= $self->{destdir}; my $realname = "$destdir/$filename"; my ($dev, $ino, $mode, $uid, $gid, $rdev, $size, $mtime) = @@ -460,48 +440,40 @@ sub prepare return $entry; } -sub _pad +sub _pad($self) { - my $self = shift; my $fh = $self->{fh}; - print $fh "\0"x1024 or $self->_fatal("Error writing to archive: #1", $!); + print $fh "\0"x1024 or + $self->_fatal("Error writing to archive: #1", $!); } -sub close +sub close($self) { - my $self = shift; if (defined $self->{padout}) { - $self->_pad; + $self->_pad; } close($self->{fh}); } -sub destdir +sub destdir($self) { - my $self = shift; - if (@_ > 0) { - $self->{destdir} = shift; - } else { - return $self->{destdir}; - } + return $self->{destdir}; } -sub set_destdir +sub set_destdir($self, $d) { - my ($self, $d) = @_; $self->{destdir} = $d; } -sub fh +sub fh($self) { - return $_[0]->{fh}; + return $self->{fh}; } package OpenBSD::Ustar::Object; -sub recheck_owner +sub recheck_owner($entry) { - my $entry = shift; # XXX weird format to prevent cvs from expanding OpenBSD id $entry->{uid} //= $OpenBSD::Ustar::uidcache ->lookup($entry->{uname}); @@ -509,41 +481,35 @@ sub recheck_owner ->lookup($entry->{gname}); } -sub _fatal +sub _fatal($self, @args) { - my ($self, @args) = @_; $self->{archive}->_fatal(@args); } -sub _left_todo +sub _left_todo($self, $toread) { - my ($self, $toread) = @_; return if $toread == 0; return unless defined $self->{archive}{callback}; &{$self->{archive}{callback}}($self->{size} - $toread); } -sub name +sub name($self) { - my $self = shift; return $self->{name}; } -sub fullname +sub fullname($self) { - my $self = shift; return $self->{destdir}.$self->{name}; } -sub set_name +sub set_name($self, $v) { - my ($self, $v) = @_; $self->{name} = $v; } -sub _set_modes_on_object +sub _set_modes_on_object($self, $o) { - my ($self, $o) = @_; chown $self->{uid}, $self->{gid}, $o; chmod $self->{mode}, $o; if (defined $self->{mtime} || defined $self->{atime}) { @@ -551,15 +517,13 @@ sub _set_modes_on_object } } -sub _set_modes +sub _set_modes($self) { - my $self = shift; $self->_set_modes_on_object($self->fullname); } -sub _ensure_dir +sub _ensure_dir($self, $dir) { - my ($self, $dir) = @_; return if -d $dir; $self->_ensure_dir(File::Basename::dirname($dir)); if (mkdir($dir)) { @@ -568,22 +532,21 @@ sub _ensure_dir $self->_fatal("Error making directory #1: #2", $dir, $!); } -sub _make_basedir +sub _make_basedir($self) { - my $self = shift; my $dir = $self->{destdir}.File::Basename::dirname($self->name); $self->_ensure_dir($dir); } -sub write +sub write($self) { - my $self = shift; my $arc = $self->{archive}; my $out = $arc->{fh}; $arc->{padout} = 1; my $header = $arc->_mkheader($self, $self->type); - print $out $header or $self->_fatal("Error writing to archive: #1", $!); + print $out $header or + $self->_fatal("Error writing to archive: #1", $!); $self->write_contents($arc); my $k = $self->{key}; if (!defined $arc->{key}{$k}) { @@ -591,71 +554,70 @@ sub write } } -sub alias +sub alias($self, $arc, $alias) { - my ($self, $arc, $alias) = @_; - my $k = $self->{archive}.":".$self->{archive}{cachename}; if (!defined $arc->{key}{$k}) { $arc->{key}{$k} = $alias; } } -sub write_contents +# $self->write_contents($arc) +sub write_contents($, $) { # only files have anything to write } -sub resolve_links +# $self->resolve_links($arc) +sub _resolve_links($, $) { # only hard links must cheat } -sub copy_contents +# $self->copy_contents($arc) +sub copy_contents($, $) { # only files need copying } -sub copy +sub copy($self, $wrarc) { - my ($self, $wrarc) = @_; my $out = $wrarc->{fh}; - $self->resolve_links($wrarc); + $self->_resolve_links($wrarc); $wrarc->{padout} = 1; my $header = $wrarc->_mkheader($self, $self->type); - print $out $header or $self->_fatal("Error writing to archive: #1", $!); + print $out $header or + $self->_fatal("Error writing to archive: #1", $!); $self->copy_contents($wrarc); } -sub isDir() { 0 } -sub isFile() { 0 } -sub isDevice() { 0 } -sub isFifo() { 0 } -sub isLink() { 0 } -sub isSymLink() { 0 } -sub isHardLink() { 0 } +sub isDir($) { 0 } +sub isFile($) { 0 } +sub isDevice($) { 0 } +sub isFifo($) { 0 } +sub isLink($) { 0 } +sub isSymLink($) { 0 } +sub isHardLink($) { 0 } package OpenBSD::Ustar::Dir; our @ISA=qw(OpenBSD::Ustar::Object); -sub create +sub create($self) { - my $self = shift; $self->_ensure_dir($self->fullname); $self->_set_modes; } -sub isDir() { 1 } +sub isDir($) { 1 } -sub type() { OpenBSD::Ustar::DIR } +sub type($) { OpenBSD::Ustar::DIR } package OpenBSD::Ustar::HardLink; our @ISA=qw(OpenBSD::Ustar::Object); -sub create +sub create($self) { - my $self = shift; $self->_make_basedir; my $linkname = $self->{linkname}; if (defined $self->{cwd}) { @@ -666,10 +628,8 @@ sub create $self->{destdir}, $linkname, $self->name, $!); } -sub resolve_links +sub _resolve_links($self, $arc) { - my ($self, $arc) = @_; - my $k = $self->{archive}.":".$self->{linkname}; if (defined $arc->{key}{$k}) { $self->{linkname} = $arc->{key}{$k}; @@ -679,17 +639,16 @@ sub resolve_links } } -sub isLink() { 1 } -sub isHardLink() { 1 } +sub isLink($) { 1 } +sub isHardLink($) { 1 } -sub type() { OpenBSD::Ustar::HARDLINK } +sub type($) { OpenBSD::Ustar::HARDLINK } package OpenBSD::Ustar::SoftLink; our @ISA=qw(OpenBSD::Ustar::Object); -sub create +sub create($self) { - my $self = shift; $self->_make_basedir; symlink $self->{linkname}, $self->fullname or $self->_fatal("Can't symlink #1 to #2: #3", @@ -698,17 +657,16 @@ sub create POSIX::lchown($self->{uid}, $self->{gid}, $self->fullname); } -sub isLink() { 1 } -sub isSymLink() { 1 } +sub isLink($) { 1 } +sub isSymLink($) { 1 } -sub type() { OpenBSD::Ustar::SOFTLINK } +sub type($) { OpenBSD::Ustar::SOFTLINK } package OpenBSD::Ustar::Fifo; our @ISA=qw(OpenBSD::Ustar::Object); -sub create +sub create($self) { - my $self = shift; $self->_make_basedir; require POSIX; POSIX::mkfifo($self->fullname, $self->{mode}) or @@ -716,15 +674,14 @@ sub create $self->_set_modes; } -sub isFifo() { 1 } -sub type() { OpenBSD::Ustar::FIFO } +sub isFifo($) { 1 } +sub type($) { OpenBSD::Ustar::FIFO } package OpenBSD::UStar::Device; our @ISA=qw(OpenBSD::Ustar::Object); -sub create +sub create($self) { - my $self = shift; $self->_make_basedir; $self->{archive}{state}->system(OpenBSD::Paths->mknod, '-m', $self->{mode}, '--', $self->fullname, @@ -732,19 +689,20 @@ sub create $self->_set_modes; } -sub isDevice() { 1 } +sub isDevice($) { 1 } package OpenBSD::Ustar::BlockDevice; our @ISA=qw(OpenBSD::Ustar::Device); -sub type() { OpenBSD::Ustar::BLOCKDEVICE } -sub devicetype() { 'b' } +sub type($) { OpenBSD::Ustar::BLOCKDEVICE } +sub devicetype($) { 'b' } package OpenBSD::Ustar::CharDevice; our @ISA=qw(OpenBSD::Ustar::Device); -sub type() { OpenBSD::Ustar::BLOCKDEVICE } -sub devicetype() { 'c' } +sub type($) { OpenBSD::Ustar::BLOCKDEVICE } +sub devicetype($) { 'c' } + # This is very specific to classic Unix: files with series of 0s should # have "gaps" created by using lseek while writing. @@ -757,9 +715,8 @@ use constant { UNFINISHED => 3, }; -sub new +sub new($class, $out) { - my ($class, $out) = @_; my $bs = (stat $out)[11]; my $zeroes; if (defined $bs) { @@ -768,9 +725,8 @@ sub new bless [ $out, $bs, $zeroes, 0 ], $class; } -sub write +sub write($self, $buffer) { - my ($self, $buffer) = @_; my ($fh, $bs, $zeroes, $e) = @$self; START: if (defined $bs) { @@ -806,9 +762,8 @@ START: } } -sub close +sub close($self) { - my ($self) = @_; if ($self->[UNFINISHED]) { defined(sysseek($self->[FH], -1, 1)) or return 0; defined(syswrite($self->[FH], "\0")) or return 0; @@ -819,18 +774,16 @@ sub close package OpenBSD::Ustar::File; our @ISA=qw(OpenBSD::Ustar::Object); -sub create +sub create($self) { - my $self = shift; $self->_make_basedir; open(my $fh, '>', $self->fullname) or $self->_fatal("Can't write to #1: #2", $self->fullname, $!); $self->extract_to_fh($fh); } -sub extract_to_fh +sub extract_to_fh($self, $fh) { - my ($self, $fh) = @_; my $buffer; my $out = OpenBSD::CompactWriter->new($fh); my $toread = $self->{size}; @@ -865,9 +818,8 @@ sub extract_to_fh $self->fullname, $!); } -sub contents +sub contents($self) { - my $self = shift; my $toread = $self->{size}; my $buffer; my $offset = 0; @@ -895,9 +847,8 @@ sub contents return $buffer; } -sub write_contents +sub write_contents($self, $arc) { - my ($self, $arc) = @_; my $filename = $self->{realname}; my $size = $self->{size}; my $out = $arc->{fh}; @@ -930,9 +881,8 @@ sub write_contents } } -sub copy_contents +sub copy_contents($self, $arc) { - my ($self, $arc) = @_; my $out = $arc->{fh}; my $buffer; my $size = $self->{size}; @@ -948,9 +898,8 @@ sub copy_contents $self->_fatal("Premature end of archive"); } $self->{archive}{swallow} -= $actual; - unless (print $out $buffer) { + print $out $buffer or $self->_fatal("Error writing to archive #1", $!); - } $toread -= $actual; } @@ -962,8 +911,8 @@ sub copy_contents $self->alias($arc, $self->name); } -sub isFile() { 1 } +sub isFile($) { 1 } -sub type() { OpenBSD::Ustar::FILE1 } +sub type($) { OpenBSD::Ustar::FILE1 } 1; diff --git a/usr.sbin/pkg_add/OpenBSD/Vstat.pm b/usr.sbin/pkg_add/OpenBSD/Vstat.pm index 1046ca63eb6..92822077528 100644 --- a/usr.sbin/pkg_add/OpenBSD/Vstat.pm +++ b/usr.sbin/pkg_add/OpenBSD/Vstat.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: Vstat.pm,v 1.71 2023/05/27 10:08:25 espie Exp $ +# $OpenBSD: Vstat.pm,v 1.72 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2007 Marc Espie # @@ -21,17 +21,15 @@ # uses mount and df directly for now. -use strict; -use warnings; +use v5.36; package OpenBSD::Vstat::Object; my $cache = {}; my $dummy; $dummy = bless \$dummy, __PACKAGE__; -sub new +sub new($class, $value = undef) { - my ($class, $value) = @_; if (!defined $value) { return $dummy; } @@ -41,35 +39,32 @@ sub new return $cache->{$value}; } -sub exists +sub exists($) { return 1; } -sub value +sub value($self) { - my $self = shift; return $$self; } -sub none +sub none($) { return OpenBSD::Vstat::Object::None->new; } - package OpenBSD::Vstat::Object::None; our @ISA = qw(OpenBSD::Vstat::Object); - my $none; $none = bless \$none, __PACKAGE__; -sub exists +sub exists($) { return 0; } -sub new +sub new($) { return $none; } @@ -77,17 +72,15 @@ sub new package OpenBSD::Vstat::Object::Directory; our @ISA = qw(OpenBSD::Vstat::Object); -sub new +sub new($class, $fname, $set, $o) { - my ($class, $fname, $set, $o) = @_; bless { name => $fname, set => $set, o => $o }, $class; } # XXX directories don't do anything until you test for their presence. # which only happens if you want to replace a directory with a file. -sub exists +sub exists($self) { - my $self = shift; require OpenBSD::SharedItems; return OpenBSD::SharedItems::check_shared($self->{set}, $self->{o}); @@ -97,9 +90,8 @@ package OpenBSD::Vstat; use File::Basename; use OpenBSD::Paths; -sub stat +sub stat($self, $fname) { - my ($self, $fname) = @_; my $dev = (stat $fname)[0]; if (!defined $dev && $fname ne '/') { @@ -108,32 +100,27 @@ sub stat return OpenBSD::Mounts->find($dev, $fname, $self->{state}); } -sub account_for +sub account_for($self, $name, $size) { - my ($self, $name, $size) = @_; my $e = $self->stat($name); $e->{used} += $size; return $e; } -sub account_later +sub account_later($self, $name, $size) { - my ($self, $name, $size) = @_; my $e = $self->stat($name); $e->{delayed} += $size; return $e; } -sub new +sub new($class, $state) { - my ($class, $state) = @_; - bless {v => [{}], state => $state}, $class; } -sub exists +sub exists($self, $name) { - my ($self, $name) = @_; for my $v (@{$self->{v}}) { if (defined $v->{$name}) { return $v->{$name}->exists; @@ -142,9 +129,8 @@ sub exists return -e $name; } -sub value +sub value($self, $name) { - my ($self, $name) = @_; for my $v (@{$self->{v}}) { if (defined $v->{$name}) { return $v->{$name}->value; @@ -153,10 +139,8 @@ sub value return undef; } -sub synchronize +sub synchronize($self) { - my $self = shift; - OpenBSD::Mounts->synchronize; if ($self->{state}->{not}) { # this is the actual stacking case: in pretend mode, @@ -173,32 +157,27 @@ sub synchronize } } -sub drop_changes +sub drop_changes($self) { - my $self = shift; - OpenBSD::Mounts->drop_changes; # drop the top layer $self->{v}[0] = {}; } -sub add +sub add($self, $name, $size, $value) { - my ($self, $name, $size, $value) = @_; $self->{v}[0]->{$name} = OpenBSD::Vstat::Object->new($value); return defined($size) ? $self->account_for($name, $size) : undef; } -sub remove +sub remove($self, $name, $size) { - my ($self, $name, $size) = @_; $self->{v}[0]->{$name} = OpenBSD::Vstat::Object->none; return defined($size) ? $self->account_later($name, -$size) : undef; } -sub remove_first +sub remove_first($self, $name, $size) { - my ($self, $name, $size) = @_; $self->{v}[0]->{$name} = OpenBSD::Vstat::Object->none; return defined($size) ? $self->account_for($name, -$size) : undef; } @@ -206,18 +185,15 @@ sub remove_first # since directories may become files during updates, we may have to remove # them early, so we need to record them: store exactly as much info as needed # for SharedItems. -sub remove_directory +sub remove_directory($self, $name, $o) { - my ($self, $name, $o) = @_; $self->{v}[0]->{$name} = OpenBSD::Vstat::Object::Directory->new($name, $self->{state}{current_set}, $o); } -sub tally +sub tally($self) { - my $self = shift; - OpenBSD::Mounts->tally($self->{state}); } @@ -227,7 +203,7 @@ my $devinfo; my $devinfo2; my $giveup; -sub giveup +sub giveup($) { if (!defined $giveup) { $giveup = OpenBSD::MountPoint::Fail->new; @@ -235,42 +211,38 @@ sub giveup return $giveup; } -sub new +sub new($class, $dev, $mp, $opts) { - my ($class, $dev, $mp, $opts) = @_; - if (!defined $devinfo->{$dev}) { $devinfo->{$dev} = OpenBSD::MountPoint->new($dev, $mp, $opts); } return $devinfo->{$dev}; } -sub run +sub run($class, $state, @args) { - my $state = shift; - my $code = pop; - open(my $cmd, "-|", @_) or - $state->errsay("Can't run #1", join(' ', @_)) + my $code = pop @args; + open(my $cmd, "-|", @args) or + $state->errsay("Can't run #1", join(' ', @args)) and return; while (<$cmd>) { &$code($_); } if (!close($cmd)) { if ($!) { - $state->errsay("Error running #1: #2", $!, join(' ', @_)); + $state->errsay("Error running #1: #2", $!, + join(' ', @args)); } else { - $state->errsay("Exit status #1 from #2", $?, join(' ', @_)); + $state->errsay("Exit status #1 from #2", $?, + join(' ', @args)); } } } -sub ask_mount +sub ask_mount($class, $state) { - my ($class, $state) = @_; - delete $ENV{'BLOCKSIZE'}; - run($state, OpenBSD::Paths->mount, sub { - my $l = shift; + $class->run($state, OpenBSD::Paths->mount, sub($l) { chomp $l; if ($l =~ m/^(.*?)\s+on\s+(\/.*?)\s+type\s+.*?(?:\s+\((.*?)\))?$/o) { my ($dev, $mp, $opts) = ($1, $2, $3); @@ -281,16 +253,14 @@ sub ask_mount }); } -sub ask_df +sub ask_df($class, $fname, $state) { - my ($class, $fname, $state) = @_; - my $info = $class->giveup; my $blocksize = 512; $class->ask_mount($state) if !defined $devinfo; - run($state, OpenBSD::Paths->df, "--", $fname, sub { - my $l = shift; + $class->run($state, OpenBSD::Paths->df, "--", $fname, + sub($l) { chomp $l; if ($l =~ m/^Filesystem\s+(\d+)\-blocks/o) { $blocksize = $1; @@ -303,14 +273,13 @@ sub ask_df $info->{avail} = $avail; $info->{blocksize} = $blocksize; } - }); + }); return $info; } -sub find +sub find($class, $dev, $fname, $state) { - my ($class, $dev, $fname, $state) = @_; if (!defined $dev) { return $class->giveup; } @@ -320,24 +289,22 @@ sub find return $devinfo2->{$dev}; } -sub synchronize +sub synchronize($class) { for my $v (values %$devinfo2) { $v->synchronize; } } -sub drop_changes +sub drop_changes($class) { for my $v (values %$devinfo2) { $v->drop_changes; } } -sub tally +sub tally($self, $state) { - my ($self, $state) = @_; - for my $v ((sort {$a->name cmp $b->name } values %$devinfo2), $self->giveup) { $v->tally($state); } @@ -345,9 +312,8 @@ sub tally package OpenBSD::MountPoint; -sub parse_opts +sub parse_opts($self, $opts) { - my ($self, $opts) = @_; for my $o (split /\,\s*/o, $opts) { if ($o eq 'read-only') { $self->{ro} = 1; @@ -361,29 +327,28 @@ sub parse_opts } } -sub ro +sub ro($self) { - return shift->{ro}; + return $self->{ro}; } -sub nodev +sub nodev($self) { - return shift->{nodev}; + return $self->{nodev}; } -sub nosuid +sub nosuid($self) { - return shift->{nosuid}; + return $self->{nosuid}; } -sub noexec +sub noexec($self) { - return shift->{noexec}; + return $self->{noexec}; } -sub new +sub new($class, $dev, $mp, $opts) { - my ($class, $dev, $mp, $opts) = @_; my $n = bless { commited_use => 0, used => 0, delayed => 0, hw => 0, dev => $dev, mp => $mp }, $class; if (defined $opts) { @@ -393,22 +358,18 @@ sub new } -sub avail +sub avail($self, $used = 0) { - my ($self, $used) = @_; return $self->{avail} - $self->{used}/$self->{blocksize}; } -sub name +sub name($self) { - my $self = shift; return "$self->{dev} on $self->{mp}"; } -sub report_ro +sub report_ro($s, $state, $fname) { - my ($s, $state, $fname) = @_; - if ($state->verbose >= 3 or ++($s->{problems}) < 4) { $state->errsay("Error: #1 is read-only (#2)", $s->name, $fname); @@ -418,10 +379,8 @@ sub report_ro $state->{problems}++; } -sub report_overflow +sub report_overflow($s, $state, $fname) { - my ($s, $state, $fname) = @_; - if ($state->verbose >= 3 or ++($s->{problems}) < 4) { $state->errsay("Error: #1 is not large enough (#2)", $s->name, $fname); @@ -433,17 +392,14 @@ sub report_overflow $state->{overflow} = 1; } -sub report_noexec +sub report_noexec($s, $state, $fname) { - my ($s, $state, $fname) = @_; $state->errsay("Error: #1 is noexec (#2)", $s->name, $fname); $state->{problems}++; } -sub synchronize +sub synchronize($v) { - my $v = shift; - if ($v->{used} > $v->{hw}) { $v->{hw} = $v->{used}; } @@ -452,18 +408,14 @@ sub synchronize $v->{commited_use} = $v->{used}; } -sub drop_changes +sub drop_changes($v) { - my $v = shift; - $v->{used} = $v->{commited_use}; $v->{delayed} = 0; } -sub tally +sub tally($data, $state) { - my ($data, $state) = @_; - return if $data->{used} == 0; $state->print("#1: #2 bytes", $data->name, $data->{used}); my $avail = $data->avail; @@ -478,15 +430,14 @@ sub tally package OpenBSD::MountPoint::Fail; our @ISA=qw(OpenBSD::MountPoint); -sub avail +sub avail($, $) { return 1; } -sub new +sub new($class) { - my $class = shift; - my $n = $class->SUPER::new('???', '???'); + my $n = $class->SUPER::new('???', '???', ''); $n->{avail} = 0; return $n; } diff --git a/usr.sbin/pkg_add/OpenBSD/md5.pm b/usr.sbin/pkg_add/OpenBSD/md5.pm index be0f605f441..98b79846d03 100644 --- a/usr.sbin/pkg_add/OpenBSD/md5.pm +++ b/usr.sbin/pkg_add/OpenBSD/md5.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: md5.pm,v 1.19 2023/05/16 14:29:20 espie Exp $ +# $OpenBSD: md5.pm,v 1.20 2023/06/13 09:07:17 espie Exp $ # # Copyright (c) 2003-2007 Marc Espie # @@ -15,38 +15,33 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; # XXX even though there is ONE current implementation of OpenBSD::digest # (SHA256) we keep the framework open in case we ever need to switch, # as we did in the past with md5 -> sha256 package OpenBSD::digest; -sub new +sub new($class, $filename) { - my ($class, $filename) = @_; $class = ref($class) || $class; my $digest = $class->digest_file($filename); bless \$digest, $class; } -sub key +sub key($self) { - my $self = shift; return $$self; } -sub write +sub write($self, $fh) { - my ($self, $fh) = @_; print $fh "\@", $self->keyword, " ", $self->stringize, "\n"; } -sub digest_file +sub digest_file($self, $fname) { - my ($self, $fname) = @_; - my $d = $self->algo; + my $d = $self->_algo; eval { $d->addfile($fname); }; @@ -57,17 +52,15 @@ sub digest_file return $d->digest; } -sub fromstring +sub fromstring($class, $arg) { - my ($class, $arg) = @_; $class = ref($class) || $class; - my $d = $class->unstringize($arg); + my $d = $class->_unstringize($arg); bless \$d, $class; } -sub equals +sub equals($a, $b) { - my ($a, $b) = @_; return ref($a) eq ref($b) && $$a eq $$b; } @@ -77,30 +70,26 @@ our @ISA=(qw(OpenBSD::digest)); use Digest::SHA; use MIME::Base64; -sub algo +sub _algo($self) { - my $self = shift; return Digest::SHA->new(256); } -sub stringize +sub stringize($self) { - my $self = shift; - return encode_base64($$self, ''); } -sub unstringize +sub _unstringize($class, $arg) { - my ($class, $arg) = @_; if ($arg =~ /^[0-9a-f]{64}$/i) { return pack('H*', $arg); } return decode_base64($arg); } -sub keyword +sub keyword($) { return "sha"; } -- 2.20.1