# 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 <espie@openbsd.org>
#
# 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;
use OpenBSD::Paths;
use File::Copy;
-sub manpages_index
+sub manpages_index($state)
{
- my ($state) = @_;
return unless defined $state->{addman};
my $destdir = $state->{destdir};
delete $state->{addman};
}
-sub register_installation
+sub register_installation($plist, $state)
{
- my ($plist, $state) = @_;
if ($state->{not}) {
$plist->to_cache;
} else {
}
}
-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);
return $borked;
}
-sub perform_installation
+sub perform_installation($handle, $state)
{
- my ($handle, $state) = @_;
-
return if $state->defines('stub');
$state->{partial} = $handle->{partial};
}
}
-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);
}
}
-sub perform_extraction
+sub perform_extraction($handle, $state)
{
- my ($handle, $state) = @_;
-
return if $state->defines('stub');
$handle->{partial} = {};
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};
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
}
}
-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;
}
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;
}
}
-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;
# 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;
}
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}++;
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);
}
}
-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) {
$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;
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},
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});
}
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 {
}
}
-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)) {
}
}
-sub prepare_to_extract
+sub prepare_to_extract($self, $state, $file)
{
- my ($self, $state, $file) = @_;
my $fullname = $self->fullname;
my $destdir = $state->{destdir};
$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;
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;
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});
return $self->create_temp($d, $state);
}
-sub tie
+sub tie($self, $state)
{
- my ($self, $state) = @_;
if (defined $self->{link} || defined $self->{symlink}) {
return;
}
}
-sub extract
+sub extract($self, $state, $file)
{
- my ($self, $state, $file) = @_;
-
$self->SUPER::extract($state);
my $d = $self->find_safe_dir($state);
}
}
-sub install
+sub install($self, $state)
{
- my ($self, $state) = @_;
$self->SUPER::install($state);
my $fullname = $self->fullname;
my $destdir = $state->{destdir};
}
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);
}
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);
}
}
-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;
}
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",
package OpenBSD::PackingElement::Manpage;
-sub install
+sub install($self, $state)
{
- my ($self, $state) = @_;
$self->SUPER::install($state);
$self->register_manpage($state, 'addman');
}
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;
}
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;
}
package OpenBSD::PackingElement::Dir;
-sub extract
+sub extract($self, $state)
{
- my ($self, $state) = @_;
my $fullname = $self->fullname;
my $destdir = $state->{destdir};
$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};
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);
}
package OpenBSD::PackingElement::Lib;
-sub install
+sub install($self, $state)
{
- my ($self, $state) = @_;
$self->SUPER::install($state);
$self->mark_ldconfig_directory($state);
}
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
$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);
}
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);
}
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);
}
# 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 <espie@openbsd.org>
#
# 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
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++;
};
};
$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,
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 {
}
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;
}
# 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 <espie@openbsd.org>
#
# 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) {
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;
}
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);
rethrow $dielater;
}
-sub parse_and_run
+sub parse_and_run($self, $cmd)
{
- my ($self, $cmd) = @_;
-
my $state = $self->new_state($cmd);
$state->handle_options;
}
# $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}}) {
}
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;
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;
$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.':';
}
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');
}
}
-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",
}
}
-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);
});
}
if ($state->is_interactive) {
$h{'<None>'} = 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
}
}
-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 {
# 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};
}
# 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;
}
}
# 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")
# 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};
}
}
-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;
}
# 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 <espie@openbsd.org>
#
# $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;
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}) {
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
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}) {
}
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}, '');
# 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 <espie@openbsd.org>
#
# 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/) {
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
$signal_name[29] = 'INFO';
}
-sub find_signal
+sub find_signal($self, $number)
{
- my ($self, $number) = @_;
-
if (@signal_name == 0) {
$self->fillup_names;
}
return $signal_name[$number] || $number;
}
-sub child_error
+sub child_error($self, $error = $?)
{
- my ($self, $error) = @_;
- $error //= $?;
-
my $extra = "";
if ($error & 128) {
}
}
-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) {
} elsif ($r == 0) {
$DB::inhibit_exit = 0;
&$todo();
- exec {$_[0]} @_ or
+ exec {$p[0]} @p or
exit 1;
} else {
&$todo2();
}
}
-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;
}
}
$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 {
}
}
-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;
}
# 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 <espie@openbsd.org>
#
# 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);
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) {
return $bypkg;
}
-sub collision_report
+sub collision_report($list, $state, $set)
{
- my ($list, $state, $set) = @_;
-
my $destdir = $state->{destdir};
if ($state->defines('removecollisions')) {
# 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 <espie@openbsd.org>
#
# 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;
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));
return $borked;
}
-sub manpages_unindex
+sub manpages_unindex($state)
{
- my ($state) = @_;
return unless defined $state->{rmman};
my $destdir = $state->{destdir};
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()) {
$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')) {
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);
$l->erase;
}
-sub delete_plist
+sub delete_plist($plist, $state)
{
- my ($plist, $state) = @_;
-
my $pkgname = $plist->pkgname;
$state->{pkgname} = $pkgname;
if (!$state->defines('stub')) {
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);
}
# $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) {
}
}
-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;
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);
}
$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);
}
$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);
}
$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;
}
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);
}
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;
}
}
-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) {
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};
}
}
-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) {
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);
use OpenBSD::Error;
use File::Basename;
-sub delete
+sub delete($self, $state)
{
- my ($self, $state) = @_;
my $realname = $self->realname($state);
my $orig = $self->{copyfrom};
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,
}
package OpenBSD::PackingElement::Shell;
-sub delete
+sub delete($self, $state)
{
- my ($self, $state) = @_;
unless ($state->{not}) {
my $destdir = $state->{destdir};
my $fullname = $self->fullname;
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}) {
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);
package OpenBSD::PackingElement::ExtraUnexec;
-sub delete
+sub delete($self, $state)
{
- my ($self, $state) = @_;
if ($state->{extra}) {
$self->run($state);
} else {
}
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);
}
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);
}
# 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 <espie@openbsd.org>
#
# 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);
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));
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 = ();
}
}
-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};
}
}
-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) {
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}) {
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
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;
}
}
-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)) {
}
}
-sub find_old_lib
+sub find_old_lib($self, $state, $base, $pattern, $lib)
{
- my ($self, $state, $base, $pattern, $lib) = @_;
require OpenBSD::Search;
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}}) {
}
}
-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;
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)) {
}
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);
# 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 <espie@openbsd.org>
#
# 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;
# 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)
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}}));
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) {
}
}
-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});
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 {
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,
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);
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;
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];
}
}
-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}) {
# 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}}) {
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];
}
}
-sub solve_dependency
+sub solve_dependency($self, $state, $dep, $package)
{
- my ($self, $state, $dep, $package) = @_;
-
my $v;
if (defined $self->cached($dep)) {
$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} = {};
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);
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));
}
}
-sub dependencies
+sub dependencies($self)
{
- my $self = shift;
if (wantarray) {
return keys %{$self->{all_dependencies}};
} else {
}
}
-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}) {
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;
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) {
}
);
-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";
# 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 <espie@openbsd.org>
#
# 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';
# 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, $$;
# 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);
# 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;
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;
}
}
-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;
# 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 <espie@openbsd.org>
#
# 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) {
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}) {
return $old->{update_found};
}
-sub adjust
+sub adjust($self, $state)
{
- my ($self, $state) = @_;
my $set = $self->{set};
for my $f (keys %{$self->{forward}}) {
}
}
-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) {
}
}
-sub check
+sub check($self, $state)
{
- my ($self, $state) = @_;
-
my @r = keys %{$self->{forward}};
my $set = $self->{set};
my $result = {};
}
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
#! /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 <espie@openbsd.org>
#
# 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;
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;
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');
$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));
}
our @ISA = qw(OpenBSD::PkgAdd);
OpenBSD::Auto::cache(updater,
- sub {
+ sub($) {
require OpenBSD::Update;
return OpenBSD::FwUpdate::Update->new;
});
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) {
}
}
-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;
}
}
-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));
}
-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);
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;
}
# 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;
$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);
# 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 <espie@openbsd.org>
#
# 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;
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 {
}
}
-sub getopts
+sub getopts($args, $hash)
{
- my ($args, $hash) = @_;
-
$hash = {} unless defined $hash;
local @EXPORT;
# 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 <espie@openbsd.org>
#
# fairly non-descriptive name. Used to store various package information
# during installs and updates.
-use strict;
-use warnings;
+use v5.36;
package OpenBSD::Handle;
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;
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;
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} &&
}
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;
}
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";
}
}
-sub complete_old
+sub complete_old($self)
{
- my $self = shift;
my $location = $self->{location};
if (!defined $location) {
}
}
-sub complete_dependency_info
+sub complete_dependency_info($self)
{
- my $self = shift;
my $location = $self->{location};
if (!defined $location) {
}
}
-sub create_old
+sub create_old($class, $pkgname, $state)
{
-
- my ($class, $pkgname, $state) = @_;
my $self= $class->new;
$self->{name} = $pkgname;
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;
$handle->{plist} = $plist;
}
-sub get_location
+sub get_location($handle, $state)
{
- my ($handle, $state) = @_;
-
my $name = $handle->{name};
my $location = $state->repo->find($name);
$handle->{pkgname} = $location->name;
}
-sub complete
+sub complete($handle, $state)
{
- my ($handle, $state) = @_;
-
return if $handle->has_error;
if (!defined $handle->{location}) {
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;
# 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 <espie@openbsd.org>
#
# 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}) {
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 {
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;
# 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 <espie@openbsd.org>
#
# 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;
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}, $!);
$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);
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 {
}
}
-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;
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";
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;
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;
return $self;
}
-sub unlock
+sub unlock($self)
{
my $self = shift;
if (defined $self->{dlock}) {
# 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 <espie@openbsd.org>
#
# 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,
}, $class;
}
-sub ask_list
+sub ask_list($self, $prompt, @values)
{
- my ($self, $prompt, @values) = @_;
if ($self->{always}) {
return $values[0];
}
}
}
-sub confirm
+sub confirm($self, $prompt, $yesno = 0)
{
- my ($self, $prompt, $yesno) = @_;
if ($self->{always}) {
return 1;
}
goto LOOP2;
}
-sub is_interactive
+sub is_interactive($self)
{
- return shift->{level};
+ return $self->{level};
}
1;
# 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 <espie@openbsd.org>
#
# 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 {
}
}
-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;
return $r;
}
-sub compare
+sub compare($a, $b)
{
- my ($a, $b) = @_;
if ($a->key ne $b->key) {
return $a->key cmp $b->key;
}
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}) {
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;
}
}
-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;
}
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
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 {
}
}
-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 {
}
}
-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;
}
}
-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;
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";
}
}
# 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);
}
# 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 <espie@openbsd.org>
#
# 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 {
}
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);
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;
}
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);
}
}
-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);
}
# 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 <espie@openbsd.org>
#
# 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) {
$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);
}
}
# 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 <espie@openbsd.org>
#
# 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;
}
}
-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;
# 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 <espie@openbsd.org>
#
# 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) {
$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 {
}
}
-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) {
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;
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);
}
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);
}
# 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;
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;
}
}
-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);
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 = {};
}
}
-sub save
+sub save($self, $set, $state)
{
- my ($self, $set, $state) = @_;
-
for my $o ($set->older) {
save_libs_from_handle($o, $set, $state);
}
# 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 <espie@openbsd.org>
#
# 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;
$info{$i} = $j;
}
-sub _init_list
+sub _init_list()
{
$list = {};
$stemlist = OpenBSD::PackageName::compile_stemlist();
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();
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/";
}
}
-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;
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";
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;
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)) {
return;
}
-sub unlock_db
+sub unlock_db()
{
if (defined $dlock) {
flock($dlock, LOCK_UN);
# 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 <espie@openbsd.org>
#
# 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;
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;
});
# 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;
}
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 ) {
}
}
-sub contents
+sub contents($self)
{
- my $self = shift;
if (!defined $self->{contents}) {
if (!$self->_opened) {
return;
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);
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;
}
}
-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};
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) {
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};
}
# proxy for archive operations
-sub next
+sub next($self)
{
- my $self = shift;
-
if (!$self->_opened) {
return;
}
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;
}
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);
}
# 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 <espie@openbsd.org>
#
# 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;
my $default_path;
-sub add_default
+sub add_default($self, $state, $p)
{
- my ($self, $state, $p) = @_;
my $w;
if (defined $ENV{TRUSTED_PKG_PATH}) {
}
}
-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);
}
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);
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);
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);
}
# 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 <espie@openbsd.org>
#
# 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$||;
}
# see packages-specs(7)
-sub splitname
+sub splitname($n)
{
- my $n = shift;
if ($n =~ /^(.*?)\-(\d.*)$/o) {
my $stem = $1;
my $rest = $2;
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;
}
}
-sub splitstem
+sub splitstem($s)
{
- my $s = shift;
if ($s =~ /^(.*?)\-\d/o) {
return $1;
} else {
}
}
-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 {
}
}
-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) {
}
}
-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;
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*)$/) {
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};
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};
}
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]) {
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;
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;
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};
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;
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 {
}
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);
# 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 <espie@openbsd.org>
#
# 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.
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";
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};
}
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;
}
}
-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;
return $self->{stemlist};
}
-sub wipe_info
+sub wipe_info($self, $pkg)
{
- my ($self, $pkg) = @_;
-
require File::Path;
my $dir = $pkg->{dir};
}
# 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 {
$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) {
}
# 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
return $fh;
}
-sub find
+sub find($repository, $name)
{
- my ($repository, $name) = @_;
my $self = $repository->new_location($name);
if ($self->contents) {
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;
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 {
}
}
-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", $!);
}
}
}
-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;
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;
}
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;
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."/") {
}
# 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);
$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);
}
}
}
-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;
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/^\/\/(.*?)(\/.*)$/) {
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};
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) {
}
}
-sub finish_and_close
+sub finish_and_close($self, $object)
{
- my ($self, $object) = @_;
if (defined $object->{cache_dir}) {
while (defined $object->next) {
}
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) =
}
}
-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
}
-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}
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;
}
}
-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} = [];
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}};
}
}
-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;
}
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;
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",
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 $>;
$> = $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;
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>) {
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 {
# 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 <espie@openbsd.org>
#
# 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 {
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};
# 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 = {};
$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);
});
}
}
-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}) {
#! /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 <espie@openbsd.org>
#
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;
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,
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);
$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;
return $h;
}
-sub getline
+sub getline($self)
{
- my $self = shift;
while (1) {
if ($self->{buffer} =~ s/^(.*?)\015\012//) {
return $1;
}
}
-sub retrieve
+sub retrieve($self, $sz)
{
- my ($self, $sz) = @_;
while(length($self->{buffer}) < $sz) {
my $buffer;
$self->{fh}->recv($buffer, $sz - length($self->{buffer}));
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);
}
}
-sub retrieve_chunked
+sub retrieve_chunked($self)
{
- my $self = shift;
my $result = '';
while (1) {
my $sz = $self->getline;
return $result;
}
-sub retrieve_response
+sub retrieve_response($self, $h)
{
- my ($self, $h) = @_;
-
if ($h->{chunked}) {
return $self->retrieve_chunked;
}
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;
}
}
}
-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";
my $pid;
my $token = 0;
-sub batch
+sub batch($code)
{
- my $code = shift;
if (defined $pid) {
waitpid($pid, 0);
undef $pid;
}
}
-sub abort_batch
+sub abort_batch()
{
if (defined $pid) {
kill HUP => $pid;
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;
use File::Basename;
-sub get_file
+sub get_file($o, $fname)
{
- my ($o, $fname) = @_;
-
my $bailout = 0;
$SIG{'HUP'} = sub {
$bailout++;
} while ($end < $total_size);
}
-sub main
+sub main($self)
{
- my $self = shift;
my $o = _Proxy::Connection->new($self->{host}, "www");
while (<STDIN>) {
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) {
# 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 <espie@openbsd.org>
#
# 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.
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;
}
}
-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 {
}
}
-sub setup_cache
+sub setup_cache($repo, $setlist)
{
- my ($repo, $setlist) = @_;
-
my $state = $repo->{state};
return if $state->defines("NO_CACHING");
}
}
-sub parse_url
+sub parse_url($class, $r, $state)
{
- my ($class, $r, $state) = @_;
-
my $path;
if ($$r =~ m/^(.*?)\:(.*)/) {
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) {
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
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;
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);
}
our @ISA = (qw(OpenBSD::PackageRepositoryBase));
-sub urlscheme
+sub urlscheme($)
{
return 'inst';
}
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)) {
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);
}
# 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 <espie@openbsd.org>
#
# 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};
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} = [];
return $distant{$k};
}
-sub list
+sub list($self)
{
- my ($self) = @_;
if (!defined $self->{list}) {
if (!defined $self->{controller}) {
$self->initiate;
return $self->{list};
}
-sub cleanup
+sub cleanup($self)
{
- my $self = shift;
if (defined $self->{controller}) {
my $cmdfh = $self->{cmdfh};
my $getfh = $self->{getfh};
}
}
-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;
}
# 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 <espie@openbsd.org>
#
# 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;
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,
# 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;
$token++;
$pid = fork();
if (!defined $pid) {
- print "ERROR: fork failed: $!\n";
+ say "ERROR: fork failed: $!";
}
if ($pid == 0) {
&$code();
}
}
-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]."/";
}
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";
} 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";
# 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 <espie@openbsd.org>
#
# 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;
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);
}
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);
# 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 <espie@openbsd.org>
#
# 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.
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);
}
}
-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;
#
# 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 '';
}
}
-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}) {
# 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|^/|) {
}
}
-sub make_full
+sub make_full($self, $path)
{
- my ($self, $path) = @_;
if ($path !~ m|^/|o && $self->cwd ne '.') {
$path = $self->cwd."/".$path;
$path =~ s,^//,/,;
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};
}
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 {
}
}
-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};
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);
}
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
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);
$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;
}
}
-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",
}
}
-sub IsFile() { 1 }
+sub IsFile($) { 1 }
package OpenBSD::PackingElement::FileWithDebugInfo;
our @ISA=qw(OpenBSD::PackingElement::FileBase);
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 '.') {
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;
}
$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
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);
}
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);
}
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};
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};
}
}
-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) {
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),
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 {
}
}
-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:
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) {
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($, $)
{
}
__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));
__PACKAGE__->register_with_factory('symlink');
-sub add
+sub add($class, $plist, $args)
{
- my ($class, $plist, $args) = @_;
-
$plist->{state}->{lastfile}->make_symlink($args);
return;
}
__PACKAGE__->register_with_factory('link');
-sub add
+sub add($class, $plist, $args)
{
- my ($class, $plist, $args) = @_;
-
$plist->{state}->{lastfile}->make_hardlink($args);
return;
}
__PACKAGE__->register_with_factory('temp');
-sub add
+sub add($class, $plist, $args)
{
- my ($class, $plist, $args) = @_;
$plist->{state}->{lastfile}->set_tempname($args);
return;
}
__PACKAGE__->register_with_factory('size');
-sub add
+sub add($class, $plist, $args)
{
- my ($class, $plist, $args) = @_;
-
$plist->{state}->{lastfile}->add_size($args);
return;
}
__PACKAGE__->register_with_factory('ts');
-sub add
+sub add($class, $plist, $args)
{
- my ($class, $plist, $args) = @_;
-
$plist->{state}->{lastfile}->add_timestamp($args);
return;
}
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') {
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});
return join(' ', @l);
}
-sub hash_plist
+sub hash_plist($self, $plist)
{
- my ($self, $plist) = @_;
delete $self->{hash};
my $content;
open my $fh, '>', \$content;
$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';
}
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,
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 {
}
}
-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);
}
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);
}
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};
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);
});
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 {
}
}
-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})
});
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,
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;
# - 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;
return 1;
}
-sub stringize
+sub stringize($self)
{
- my $self = shift;
return join(':', map { $self->{$_}}
(qw(name uid group class comment home shell)));
}
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) {
return 1;
}
-sub stringize($)
+sub stringize($self)
{
- my $self = $_[0];
return join(':', map { $self->{$_}}
(qw(name gid)));
}
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};
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};
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 {
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};
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};
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,
}, $class;
}
-sub stringize
+sub stringize($self)
{
- my $self = shift;
if ($self->{params} ne '') {
return join(' ', $self->name, $self->{params});
} else {
# 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);
}
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
'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,
}, $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";
$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 '') {
}
}
-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;
}
}
-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'
push(@{$state->{tag_cleanup}{$tag->{expanded}}}, $self);
}
-sub need_params
+sub need_params($)
{
1
}
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
}
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",
}
}
-sub restore_fontdir
+sub _restore_fontdir($state, $dirname)
{
- my ($state, $dirname) = @_;
if (-f "$dirname/fonts.dir.dist") {
unlink("$dirname/fonts.dir");
}
}
-sub run_if_exists
+sub _run_if_exists($state, $cmd, @l)
{
- my ($state, $cmd, @l) = @_;
-
if (-x $cmd) {
$state->vsystem($cmd, @l);
} else {
}
}
-sub finish
+sub finish($class, $state)
{
- my ($class, $state) = @_;
return if $state->{not};
my @l = keys %{$state->{recorder}->{fonts_todo}};
$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;
}
}
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;
}
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;
}
}
-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;
}
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>) {
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) {
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";
}
}
# don't incorporate this into compared signatures
-sub write_without_variation
+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;
}
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($, $)
{
}
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);
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);
}
# 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,
}, $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) {
return $o;
}
-sub fullpkgpath
+sub fullpkgpath($self)
{
- my ($self) = @_;
if(%{$self->{mandatory}}) {
my $m = join(",", keys %{$self->{mandatory}});
return "$self->{dir},$m";
# 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};
}
# basic match: after mandatory, nothing left
-sub match2
+sub match2($self, $has, $h)
{
- my ($self, $has, $h) = @_;
if (keys %$h) {
return 0;
} else {
}
# 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})) {
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) });
# 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;
}
# 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 <espie@openbsd.org>
#
# 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,
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);
}
package OpenBSD::PackingList::hashpath;
-sub match
+sub match($h, $plist)
{
- my ($h, $plist) = @_;
my $f = $plist->fullpkgpath2;
if (!defined $f) {
return 0;
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/;
}
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'};
}
}
-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);
});
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($_);
}
}
-sub ExtraInfoOnly
+sub ExtraInfoOnly($fh, $cont)
{
- my ($fh, $cont) = @_;
while (<$fh>) {
if (m/^\@(?:name|pkgpath|comment\s+(?:subdir|pkgpath)\=|option)\b/o) {
&$cont($_);
}
}
-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
}
}
-sub ConflictOnly
+sub ConflictOnly($fh, $cont)
{
- my ($fh, $cont) = @_;
while (<$fh>) {
if (m/^\@(?:name|conflict|option)\b/o) {
&$cont($_);
}
}
-sub fromfile
+sub fromfile($a, $fname, $code = \&defaultCode)
{
- my ($a, $fname, $code) = @_;
open(my $fh, '<', $fname) or return;
my $plist;
eval {
return $plist;
}
-sub tofile
+sub tofile($self, $fname)
{
- my ($self, $fname) = @_;
open(my $fh, '>', $fname) or return;
$self->zap_wrong_annotations;
$self->write($fh);
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 // "?");
$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 {
}
}
-sub pkgname
+sub pkgname($self)
{
- my $self = shift;
if (defined $self->{name}) {
return $self->{name}->name;
} else {
}
}
-sub localbase
+sub localbase($self)
{
- my $self = shift;
-
if (defined $self->{localbase}) {
return $self->{localbase}->name;
} else {
}
}
-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 {
}
}
-sub fullpkgpath2
+sub fullpkgpath2($self)
{
- my $self = shift;
if (defined $self->{extrainfo} && $self->{extrainfo}{subdir} ne '') {
return $self->{extrainfo}{path};
} else {
}
}
-sub pkgpath
+sub pkgpath($self)
{
- my $self = shift;
if (!defined $self->{_hashpath}) {
my $h = $self->{_hashpath} =
bless {}, "OpenBSD::PackingList::hashpath";
return $self->{_hashpath};
}
-sub match_pkgpath
+sub match_pkgpath($self, $plist2)
{
- my ($self, $plist2) = @_;
return $self->pkgpath->match($plist2) ||
$plist2->pkgpath->match($self);
}
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};
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};
}
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) {
$plist_cache->{$self->pkgname} = $plist;
}
-sub to_installation
+sub to_installation($self)
{
- my ($self) = @_;
-
require OpenBSD::PackageInfo;
return if $main::not;
$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);
}
# 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 <espie@openbsd.org>
#
# 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`);
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`);
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);
}
}
-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;
}
#! /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 <espie@openbsd.org>
#
# 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}
}
}
-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,
}
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
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 ...');
}
OpenBSD::Auto::cache(cache_directory,
- sub {
- my $self = shift;
+ sub($) {
if (defined $ENV{PKG_CACHE}) {
return $ENV{PKG_CACHE};
} else {
});
OpenBSD::Auto::cache(debug_cache_directory,
- sub {
- my $self = shift;
+ sub($) {
if (defined $ENV{DEBUG_PKG_CACHE}) {
return $ENV{DEBUG_PKG_CACHE};
} else {
}
});
-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) {
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)) {
}
}
-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);
}
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;
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) {
}
}
-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;
$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;
$o->complete_old;
}
+ $set->propagate_manual_install;
my $check = $set->install_issues($state);
return 0 if !defined $check;
return 1;
}
-sub find_conflicts
+sub find_conflicts($set, $state)
{
- my ($set, $state) = @_;
-
my $c = $set->conflict_cache;
for my $handle ($set->newer) {
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
}
}
-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;
}
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\-/;
return 1;
}
-sub install_issues
+sub install_issues($set, $state)
{
- my ($set, $state) = @_;
-
my @conflicts = $set->find_conflicts($state);
if (@conflicts == 0) {
return if $later;
-
- my $manual_install = 0;
-
for my $old ($set->older) {
my $name = $old->pkgname;
$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(
}
}
-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);
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) {
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";
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) {
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);
}
} 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, '-');
# 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,
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
}
$state->{replacing} = $replacing;
- my $handler = sub {
+ my $handler = sub { # SIGHANDLER
$state->{received} = shift;
$state->errsay("Interrupted");
if ($state->{hardkill}) {
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;
}
}
-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);
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})) {
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 = {};
}
}
-sub process_set
+sub process_set($self, $set, $state)
{
- my ($self, $set, $state) = @_;
-
$state->{current_set} = $set;
if (!$state->updater->process_set($set, $state)) {
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);
$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;
}
}
-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);
});
}
# 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;
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
}
}
-sub finish_display
+sub finish_display($self, $state)
{
- my ($self, $state) = @_;
OpenBSD::Add::manpages_index($state);
# and display delayed thingies.
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);
}
-sub new_state
+sub new_state($self, $cmd)
{
- my ($self, $cmd) = @_;
return OpenBSD::PkgAdd::State->new($cmd);
}
# 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 <espie@openbsd.org>
#
# 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;
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);
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) {
}
}
-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);
}
}
-sub find
+sub find($pkgname, $state)
{
- my ($pkgname, $state) = @_;
my @bad = ();
if (is_installed $pkgname) {
push(@bad, $pkgname);
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}) {
#! /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 <espie@openbsd.org>
#
# 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;
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};
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));
}
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}) {
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;
}
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) {
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()) {
}
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)) {
}
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;
}
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, " ",
}
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) {
}
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) {
}
}
-sub cache_depends
+sub cache_depends # forwarder
{
&OpenBSD::PackingElement::Depend::cache_depends;
}
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;
}
}
-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 => {},
return $o;
}
-sub find
+sub find($self, $name)
{
- my ($self, $name) = @_;
if ($self->{possible}{$name}) {
delete $self->{not_yet}{$name};
return 1;
}
}
-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(
}
}
-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(
}
}
-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")) {
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));
}
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;
}
$self->{params} = [];
}
-sub result
+sub result($self)
{
- my $self = shift;
while (@{$self->{params}} > 0) {
$self->run_command;
}
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, ':');
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) {
}
}
-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(
$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;
$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;
$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"))) {
$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;
}
}
-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) {
}
-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);
});
}
-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,
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}}) {
});
}
-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}) {
});
}
-sub install_pkglocate
+sub install_pkglocate($self, $state)
{
- my ($self, $state) = @_;
-
my $spec = 'pkglocatedb->=1.1';
my @l = installed_stems()->find('pkglocatedb');
}
# 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}}) {
}
}
-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);
}
}
-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;
}
$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));
$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') {
}
}
-sub run
+sub run($self, $state)
{
- my ($self, $state) = @_;
-
my $list = [installed_packages()];
my $list2;
}
}
-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');
#! /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 <espie@openbsd.org>
#
# 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;
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 {
}
}
-sub end_status
+sub end_status($self)
{
- my $self = shift;
-
if ($self->{simple_status}) {
print "\n";
} else {
}
}
-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;
$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;
# 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)) {
$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) {
}
}
-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;
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;
}
-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);
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 {
}
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';
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);
}
}
-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++) {
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};
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;
}
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);
}
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);
$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;
}
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,
$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}};
}
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\}/) {
}
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";
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);
}
}
-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];
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;
return $v;
}
-sub diskcachename
+sub diskcachename($self, $dep)
{
- my ($self, $dep) = @_;
-
if ($ENV{_DEPENDS_CACHE}) {
my $diskcache = $dep->{pkgpath};
$diskcache =~ s/\//--/g;
}
}
-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;
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) {
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;
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;
}
# 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;
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);
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)
});
}
-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');
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') ||
$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,
}
}
-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 {
}
}
-sub create_plist
+sub create_plist($self, $state, $pkgname)
{
- my ($self, $state, $pkgname) = @_;
-
my $plist = OpenBSD::PackingList->new;
if ($pkgname =~ m|([^/]+)$|o) {
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);
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';
}
}
-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);
}
}
-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
}
}
-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});
# 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;
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');
}
}
-sub run_command
+sub run_command($self, $state)
{
- my ($self, $state) = @_;
if (defined $state->opt('Q')) {
$state->{opt}{q} = 1;
}
}
}
-sub parse_and_run
+sub parse_and_run($self, $cmd)
{
- my ($self, $cmd) = @_;
-
my $state = OpenBSD::PkgCreate::State->new($cmd);
$state->handle_options;
#!/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 <espie@openbsd.org>
#
# 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;
}
-sub done
+sub done($self, $set)
{
- my ($self, $set) = @_;
$set->{finished} = 1;
for my $pkgname ($set->older_names) {
delete $self->{todo}{$pkgname};
$self->handle_set($set);
}
-sub cant
+sub cant # forwarder
{
&done;
}
-sub find
+
+sub find($self, $pkgname)
{
- my ($self, $pkgname) = @_;
return $self->{todo}{$pkgname};
}
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')) {
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;
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) {
return $result;
}
-sub process_parameters
+sub process_parameters($self, $state)
{
- my ($self, $state) = @_;
-
my $inst = $state->repo->installed;
if (@ARGV == 0) {
}
}
-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 {
$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) {
return ();
}
-sub main
+sub main($self, $state)
{
- my ($self, $state) = @_;
-
if ($state->{exclude}) {
my $names = {};
for my $l (@{$state->{setlist}}) {
}
}
-sub new_state
+sub new_state($self, $cmd)
{
- my ($self, $cmd) = @_;
return OpenBSD::PkgDelete::State->new($cmd);
}
#! /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 <espie@openbsd.org>
#
# 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, " ";
}
}
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);
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};
$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')) {
}
}
-sub printfile
+sub printfile($state, $filename)
{
- my ($state, $filename) = @_;
-
open my $fh, '<', $filename or return;
while(<$fh>) {
chomp;
$state->say;
}
-sub printfile_sorted
+sub printfile_sorted($state, $filename)
{
- my ($state, $filename) = @_;
-
open my $fh, '<', $filename or return;
my @lines = (<$fh>);
close $fh;
$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>) {
$state->say;
}
-sub hasanyopt
+sub hasanyopt($self, $string)
{
- my ($self, $string) = @_;
for my $i (split //, $string) {
if ($self->opt($i)) {
return 1;
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);
}
}
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;
}
}
-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)) {
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);
}
}
-sub filter_files
+sub filter_files($self, $state, $search, @args)
{
- my ($self, $state, $search, @args) = @_;
require OpenBSD::PackingList;
my @k = ();
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);
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');
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;
}
}
-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;
}
}
-sub handle_query
+sub handle_query($self, $state)
{
- my ($self, $state) = @_;
-
require OpenBSD::Search;
$state->say("PKG_PATH=#1", $ENV{PKG_PATH} // "<undefined>")
}
}
-sub parse_and_run
+sub parse_and_run($self, $cmd)
{
- my ($self, $cmd) = @_;
my $exit_code = 0;
my @sought_files;
my $error_e = 0;
$state->{opt} =
{
'e' =>
- sub {
- my $pat = shift;
+ sub($pat) {
my @list;
if ($pat =~ m/\//o) {
$state->lock;
$state->{terse} = 1;
},
'E' =>
- sub {
+ sub($name) {
require File::Spec;
- push(@sought_files, File::Spec->rel2abs(shift));
+ push(@sought_files, File::Spec->rel2abs($name));
}
};
$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;
}
#! /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 <espie@openbsd.org>
#
# 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;
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}++;
},
};
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')) {
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);
}
};
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);
$n++;
}
if ($n >= $maxjobs) {
- &$reap_job;
+ &$reap_job();
}
}
while ($n != 0) {
- &$reap_job;
+ &$reap_job();
}
} else {
for my $name (@$l) {
}
}
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) {
}
-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) {
# 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 <espie@openbsd.org>
#
# 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) {
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)) {
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 {
'=' => 'eq'
};
-sub new
+sub new($class, $s)
{
- my ($class, $s) = @_;
my ($op, $version) = ('=', $s);
if ($s =~ m/^(\>\=|\>|\<\=|\<|\=)(.*)$/) {
($op, $version) = ($1, $2);
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 {
}
}
-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;
}
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
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
}
}
-sub add_flavor_constraints
+sub add_flavor_constraints($class, $constraints, $flavorspec)
{
- my ($class, $constraints, $flavorspec) = @_;
# and likewise for flavors
if ($flavorspec eq '') {
# non constraint
}
}
-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};
}
}
-sub match_ref
+sub match_ref($o, $list)
{
- my ($o, $list) = @_;
my @result = ();
# Now, have to extract the version number, and the flavor...
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:
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) {
}
}
-sub match_ref
+sub match_ref($self, $r)
{
- my ($self, $r) = @_;
if (wantarray) {
my @l = ();
for my $subpattern (@$self) {
}
}
-sub match_libs_ref
+sub match_libs_ref($self, $r)
{
- my ($self, $r) = @_;
if (wantarray) {
my @l = ();
for my $subpattern (@$self) {
}
}
-sub match_locations
+sub match_locations($self, $r)
{
- my ($self, $r) = @_;
my $l = [];
for my $subpattern (@$self) {
push(@$l, @{$subpattern->match_locations($r)});
return $l;
}
-sub is_valid
+sub is_valid($self)
{
- my $self = shift;
for my $subpattern (@$self) {
return 0 unless $subpattern->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;
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;
# 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 <espie@openbsd.org>
#
# 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;
}
}
-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);
}
$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;
}
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,
}, $class;
}
-sub advance
+sub advance($self, $e)
{
- my ($self, $e) = @_;
if (defined $e->{size}) {
$self->{donesize} += $e->{size};
}
# 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 <espie@openbsd.org>
#
# 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);
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});
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);
}
}
-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;
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) {
$self->{lastdisplay} = $d;
}
-sub message
+sub message($self, $message)
{
- my ($self, $message) = @_;
return unless $self->can_output;
if ($self->{cleareol}) {
$message .= $self->{cleareol};
}
}
-sub show
+sub show($self, $current, $total)
{
- my ($self, $current, $total) = @_;
-
return unless $self->can_output;
if ($self->{playfield}) {
}
}
-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}) {
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';
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});
# 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 <espie@openbsd.org>
#
# 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);
}
# 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 <espie@openbsd.org>
#
# 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} = {};
}
}
-sub synch
+sub synch($self)
{
- my $self = shift;
return $self if $main::not;
if (!unlink $self->{filename}) {
return $self;
}
-sub list
+sub list($self)
{
- my $self = shift;
-
if (wantarray) {
$self->fill_entries;
return keys %{$self->{entries}};
}
}
-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};
$self->synch;
}
-sub add
+sub add($self, @pkgnames)
{
- my ($self, @pkgnames) = @_;
$self->fill_entries;
for my $pkg (@pkgnames) {
$self->{entries}->{$pkg} = 1;
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;
return $cache->{$f};
}
-sub forget
+sub forget($class, $dir)
{
- my ($class, $dir) = @_;
my $f = $dir.$class->filename;
if (exists $cache->{$f}) {
$cache->{$f}->{entries} = {};
}
}
-sub compute_closure
+sub compute_closure($class, @seed)
{
- my ($class, @seed) = @_;
-
my @todo = @seed;
my %done = ();
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;
# 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 <espie@openbsd.org>
#
# 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;
}
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
}
}
-sub _new
+sub _new($class, $stem)
{
- my ($class, $stem) = @_;
-
if ($stem =~ m/^(.*)\-\-(.*)/) {
# XXX
return OpenBSD::Search::Exact->new("$1-*-$2");
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));
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) {
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));
return @r;
}
-sub _keep
+sub _keep($self, $stem)
{
- my ($self, $stem) = @_;
for my $partial (keys %$self) {
if ($stem =~ /\Q$partial\E/) {
return 1;
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) {
});
}
-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;
);
}
-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;
}
# 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 <espie@openbsd.org>
#
# 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;
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;
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()) {
}
}
-sub wipe_directory
+sub wipe_directory($state, $h, $d)
{
- my ($state, $h, $d) = @_;
-
my $realname = $state->{destdir}.$d;
for my $i (@{$h->{$d}}) {
return 1;
}
-sub cleanup
+sub cleanup($recorder, $state)
{
- my ($recorder, $state) = @_;
-
my $remaining = find_items_in_installed_packages($state);
$state->progress->clear;
}
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);
}
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);
}
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");
# 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 <espie@openbsd.org>
#
}, $class;
}
-
sub register_library($self, $lib, $pkgname)
{
$self->{repo}->register($lib, $pkgname);
# 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 <espie@openbsd.org>
#
# 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;
}
}
-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);
}
}
-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
}
}
-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");
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
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) {
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) {
#! /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 <espie@openbsd.org>
#
# 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;
signify2 => 'OpenBSD::Signer::SIGNIFY2',
};
-sub factory
+sub factory($class, $state)
{
- my ($class, $state) = @_;
-
my @p = @{$state->{signature_params}};
if (defined $h->{$p[0]}) {
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");
}
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) {
$state->system(OpenBSD::Paths->signify, '-zS', '-s', $privkey, '-m', $url, '-x', $tmp);
}
-sub want_local
+sub want_local($)
{
return 1;
}
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,
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(
$state->{archive_filename}, $!);
}
-sub ntodo
+sub ntodo($self, $offset = 0)
{
- my ($self, $offset) = @_;
return sprintf("%u/%u", $self->{done}-$offset, $self->{total});
}
# 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 <espie@openbsd.org>
#
# 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});
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;
}
}
-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;
});
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;
});
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";
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');
}
return if $state->{no_exports};
- # XXX
+ # TODO make sure nothing uses this
no strict "refs";
no strict "vars";
for my $k (keys %{$state->{opt}}) {
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
}
OpenBSD::Auto::cache(signer_list,
- sub {
- my $self = shift;
+ sub($self) {
if ($self->defines('SIGNER')) {
return [split /,/, $self->{subst}->value('SIGNER')];
} else {
# 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 <espie@openbsd.org>
#
# 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/;
}
}
-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};
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;
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) {
}
}
-sub empty
+sub empty($self, $k)
{
- my ($self, $k) = @_;
-
my $v = $self->value($k);
if (defined $v && $v) {
return 0;
# 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 <espie@openbsd.org>
#
# 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;
my ($lastname, $lasterror, $lasttype);
OpenBSD::Handler->atend(
- sub {
+ sub($) {
while (my ($name, $pid) = each %$files) {
unlink($name) if $pid == $$;
}
});
-sub dir
+sub dir($)
{
my $caught;
- my $h = sub { $caught = shift; };
+ my $h = sub($sig, @) { $caught = $sig; };
my $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);
{
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";
return ();
}
-sub permanent_dir
+sub permanent_dir($dir, $stem)
{
- my ($dir, $stem) = @_;
my $template = "$stem.XXXXXXXXXX";
if (defined $dir) {
$template = "$dir/$template";
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;
# 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 <espie@openbsd.org>
#
# 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;
# 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});
}
join(",", $set->hint_names));
}
-sub dump
+sub dump()
{
return unless defined $s;
for my $l ('to_install', 'to_update') {
}
}
-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;
}
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};
$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) {
}
}
-sub cant
+sub cant($self, $set)
{
- my ($self, $set) = @_;
$set->{finished} = 1;
$self->remove_set($set);
$self->known($set);
}
}
-sub done
+sub done($self, $set)
{
- my ($self, $set) = @_;
-
$set->{finished} = 1;
$self->remove_set($set);
$self->known($set);
}
}
-sub is
+sub is($self, $k, $pkg)
{
- my ($self, $k, $pkg) = @_;
-
my $set = $self->{$k}{$pkg};
if (ref $set) {
return $set->real_set;
}
}
-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}};
}
# 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 <espie@openbsd.org>
#
# 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);
}
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};
$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) {
if (!$set->{quirks}) {
my $base = 0;
$state->run_quirks(
- sub {
- my $quirks = shift;
+ sub($quirks) {
$base = $quirks->is_base_system($h, $state);
});
if ($base) {
if (!$set->{quirks}) {
$state->run_quirks(
- sub {
- my $quirks = shift;
+ sub($quirks) {
$quirks->tweak_search(\@search, $h, $state);
});
}
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;
}
}
}
-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);
$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;
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;
$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);
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) {
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};
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);
# 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 <espie@openbsd.org>
#
# 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;
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);
}
$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)."...";
}
}
-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
}
# 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;
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;
});
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} = {};
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;
}
}
-sub match_locations
+sub match_locations($set, @spec)
{
- my ($set, @spec) = @_;
my $r = [];
if (defined $set->{path}) {
$r = $set->{path}->match_locations(@spec);
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;
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.
return @l;
}
-sub print
+sub print($self)
{
- my $self = shift;
my $result = "";
if ($self->kept > 0) {
$result = "[".$self->smart_join($self->kept_names)."]";
return $result;
}
-sub todo_names
+sub todo_names($self)
{
- my $self = shift;
if ($self->newer > 0) {
return $self->newer_names;
} else {
}
}
-sub validate_plists
+sub validate_plists($self, $state)
{
- my ($self, $state) = @_;
$state->{problems} = 0;
delete $state->{overflow};
}
}
-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) {
}
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}) {
$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);
}
# 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);
}
# 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 <espie@openbsd.org>
#
# Handle utar archives
-use strict;
-use warnings;
+use v5.36;
package OpenBSD::Ustar;
# 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,
# $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) {
};
# 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) {
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;
}
}
-sub next
+sub next($self)
{
- my $self = shift;
# get rid of the current object
$self->skip;
my $header;
}
# 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;
}
# 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) {
}
}
-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;
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};
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) =
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});
->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}) {
}
}
-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)) {
$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}) {
}
}
-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}) {
$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};
}
}
-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",
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
$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,
$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.
UNFINISHED => 3,
};
-sub new
+sub new($class, $out)
{
- my ($class, $out) = @_;
my $bs = (stat $out)[11];
my $zeroes;
if (defined $bs) {
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) {
}
}
-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;
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};
$self->fullname, $!);
}
-sub contents
+sub contents($self)
{
- my $self = shift;
my $toread = $self->{size};
my $buffer;
my $offset = 0;
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};
}
}
-sub copy_contents
+sub copy_contents($self, $arc)
{
- my ($self, $arc) = @_;
my $out = $arc->{fh};
my $buffer;
my $size = $self->{size};
$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;
}
$self->alias($arc, $self->name);
}
-sub isFile() { 1 }
+sub isFile($) { 1 }
-sub type() { OpenBSD::Ustar::FILE1 }
+sub type($) { OpenBSD::Ustar::FILE1 }
1;
# 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 <espie@openbsd.org>
#
# 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;
}
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;
}
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});
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 '/') {
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;
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;
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,
}
}
-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;
}
# 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});
}
my $devinfo2;
my $giveup;
-sub giveup
+sub giveup($)
{
if (!defined $giveup) {
$giveup = OpenBSD::MountPoint::Fail->new;
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);
});
}
-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;
$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;
}
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);
}
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;
}
}
-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) {
}
-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);
$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);
$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};
}
$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;
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;
}
# 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 <espie@openbsd.org>
#
# 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);
};
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;
}
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";
}
projects / openbsd / commitdiff