"move" part of the OpenBSD::State code into its own (stateless) class
authorespie <espie@openbsd.org>
Fri, 21 Jan 2022 17:41:41 +0000 (17:41 +0000)
committerespie <espie@openbsd.org>
Fri, 21 Jan 2022 17:41:41 +0000 (17:41 +0000)
so that it can be reused light-weight by portgen and the likes.

(the actual move will happen once the base sets all have the new files)

usr.sbin/pkg_add/Makefile
usr.sbin/pkg_add/OpenBSD/BaseState.pm [new file with mode: 0644]
usr.sbin/pkg_add/OpenBSD/BaseState.pod [new file with mode: 0644]

index 5319192..546cd0f 100644 (file)
@@ -1,4 +1,4 @@
-# $OpenBSD: Makefile,v 1.92 2022/01/05 16:35:35 deraadt Exp $
+# $OpenBSD: Makefile,v 1.93 2022/01/21 17:41:41 espie Exp $
 
 .include <bsd.own.mk>
 
@@ -15,6 +15,7 @@ PACKAGES= \
     OpenBSD/AddCreateDelete.pm \
     OpenBSD/AddDelete.pm \
     OpenBSD/ArcCheck.pm \
+    OpenBSD/BaseState.pm \
     OpenBSD/CollisionReport.pm \
     OpenBSD/Delete.pm \
     OpenBSD/Dependencies/SolverBase.pm \
@@ -90,6 +91,7 @@ LIBBASE=/usr/libdata/perl5
 PODS= \
     OpenBSD::md5 \
     OpenBSD::style \
+    OpenBSD::BaseState \
     OpenBSD::Getopt \
     OpenBSD::IdCache \
     OpenBSD::Intro \
diff --git a/usr.sbin/pkg_add/OpenBSD/BaseState.pm b/usr.sbin/pkg_add/OpenBSD/BaseState.pm
new file mode 100644 (file)
index 0000000..2157e9b
--- /dev/null
@@ -0,0 +1,307 @@
+# ex:ts=8 sw=4:
+# $OpenBSD: BaseState.pm,v 1.1 2022/01/21 17:41:41 espie Exp $
+#
+# Copyright (c) 2007-2022 Marc Espie <espie@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# 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;
+
+package OpenBSD::BaseState;
+use Carp;
+
+sub can_output
+{
+       1;
+}
+sub sync_display
+{
+}
+
+my $forbidden = qr{[^[:print:]\s]};
+
+sub safe
+{
+       my ($self, $string) = @_;
+       $string =~ s/$forbidden/?/g;
+       return $string;
+}
+
+sub f
+{
+       my $self = shift;
+       if (@_ == 0) {
+               return undef;
+       }
+       my ($fmt, @l) = @_;
+
+       # is there anything to format, actually ?
+       if ($fmt =~ m/\#\d/) {
+               # encode any unknown chars as ?
+               for (@l) {
+                       s/$forbidden/?/g if defined;
+               }
+               # make it so that #0 is #
+               unshift(@l, '#');
+               $fmt =~ s,\#(\d+),($l[$1] // "<Undefined #$1>"),ge;
+       }
+       return $fmt;
+}
+
+sub _fatal
+{
+       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";
+}
+
+sub fatal
+{
+       my $self = shift;
+       $self->_fatal($self->f(@_));
+}
+
+sub _fhprint
+{
+       my $self = shift;
+       my $fh = shift;
+       $self->sync_display;
+       print $fh @_;
+}
+sub _print
+{
+       my $self = shift;
+       $self->_fhprint(\*STDOUT, @_) if $self->can_output;
+}
+
+sub _errprint
+{
+       my $self = shift;
+       $self->_fhprint(\*STDERR, @_);
+}
+
+sub fhprint
+{
+       my $self = shift;
+       my $fh = shift;
+       $self->_fhprint($fh, $self->f(@_));
+}
+
+sub fhsay
+{
+       my $self = shift;
+       my $fh = shift;
+       if (@_ == 0) {
+               $self->_fhprint($fh, "\n");
+       } else {
+               $self->_fhprint($fh, $self->f(@_), "\n");
+       }
+}
+
+sub print
+{
+       my $self = shift;
+       $self->fhprint(\*STDOUT, @_) if $self->can_output;
+}
+
+sub say
+{
+       my $self = shift;
+       $self->fhsay(\*STDOUT, @_) if $self->can_output;
+}
+
+sub errprint
+{
+       my $self = shift;
+       $self->fhprint(\*STDERR, @_);
+}
+
+sub errsay
+{
+       my $self = shift;
+       $self->fhsay(\*STDERR, @_);
+}
+
+my @signal_name = ();
+sub fillup_names
+{
+       {
+       # XXX force autoload
+       package verylocal;
+
+       require POSIX;
+       POSIX->import(qw(signal_h));
+       }
+
+       for my $sym (keys %POSIX::) {
+               next unless $sym =~ /^SIG([A-Z].*)/;
+               my $value = eval "&POSIX::$sym()";
+               # skip over POSIX stuff we don't have like SIGRT or SIGPOLL
+               next unless defined $value;
+               $signal_name[$value] = $1;
+       }
+       # extra BSD signals
+       $signal_name[5] = 'TRAP';
+       $signal_name[7] = 'IOT';
+       $signal_name[10] = 'BUS';
+       $signal_name[12] = 'SYS';
+       $signal_name[16] = 'URG';
+       $signal_name[23] = 'IO';
+       $signal_name[24] = 'XCPU';
+       $signal_name[25] = 'XFSZ';
+       $signal_name[26] = 'VTALRM';
+       $signal_name[27] = 'PROF';
+       $signal_name[28] = 'WINCH';
+       $signal_name[29] = 'INFO';
+}
+
+sub find_signal
+{
+       my ($self, $number) = @_;
+
+       if (@signal_name == 0) {
+               $self->fillup_names;
+       }
+
+       return $signal_name[$number] || $number;
+}
+
+sub child_error
+{
+       my ($self, $error) = @_;
+       $error //= $?;
+
+       my $extra = "";
+
+       if ($error & 128) {
+               $extra = $self->f(" (core dumped)");
+       }
+       if ($error & 127) {
+               return $self->f("killed by signal #1#2",
+                   find_signal($error & 127), $extra);
+       } else {
+               return $self->f("exit(#1)#2", ($error >> 8), $extra);
+       }
+}
+
+sub _system
+{
+       my $self = shift;
+       $self->sync_display;
+       my ($todo, $todo2);
+       if (ref $_[0] eq 'CODE') {
+               $todo = shift;
+       } else {
+               $todo = sub {};
+       }
+       if (ref $_[0] eq 'CODE') {
+               $todo2 = shift;
+       } else {
+               $todo2 = sub {};
+       }
+       my $r = fork;
+       if (!defined $r) {
+               return 1;
+       } elsif ($r == 0) {
+               $DB::inhibit_exit = 0;
+               &$todo;
+               exec {$_[0]} @_ or
+                   exit 1;
+       } else {
+               &$todo2;
+               waitpid($r, 0);
+               return $?;
+       }
+}
+
+sub system
+{
+       my $self = shift;
+       my $r = $self->_system(@_);
+       if ($r != 0) {
+               if (ref $_[0] eq 'CODE') {
+                       shift;
+               }
+               if (ref $_[0] eq 'CODE') {
+                       shift;
+               }
+               $self->errsay("system(#1) failed: #2",
+                   join(", ", @_), $self->child_error);
+       }
+       return $r;
+}
+
+sub verbose_system
+{
+       my $self = shift;
+       my @p = @_;
+       if (ref $p[0]) {
+               shift @p;
+       }
+       if (ref $p[0]) {
+               shift @p;
+       }
+
+       $self->print("Running #1", join(' ', @p));
+       my $r = $self->_system(@_);
+       if ($r != 0) {
+               $self->say("... failed: #1", $self->child_error);
+       } else {
+               $self->say;
+       }
+}
+
+sub copy_file
+{
+       my $self = shift;
+       require File::Copy;
+
+       my $r = File::Copy::copy(@_);
+       if (!$r) {
+               $self->say("copy(#1) failed: #2", join(',', @_), $!);
+       }
+       return $r;
+}
+
+sub unlink
+{
+       my $self = shift;
+       my $verbose = shift;
+       my $r = unlink @_;
+       if ($r != @_) {
+               $self->say("rm #1 failed: removed only #2 targets, #3",
+                   join(' ', @_), $r, $!);
+       } elsif ($verbose) {
+               $self->say("rm #1", join(' ', @_));
+       }
+       return $r;
+}
+
+sub copy
+{
+       my $self = shift;
+       require File::Copy;
+
+       my $r = File::Copy::copy(@_);
+       if (!$r) {
+               $self->say("copy(#1) failed: #2", join(',', @_), $!);
+       }
+       return $r;
+}
+
+1;
diff --git a/usr.sbin/pkg_add/OpenBSD/BaseState.pod b/usr.sbin/pkg_add/OpenBSD/BaseState.pod
new file mode 100644 (file)
index 0000000..0daf457
--- /dev/null
@@ -0,0 +1,36 @@
+$OpenBSD: BaseState.pod,v 1.1 2022/01/21 17:41:41 espie Exp $
+
+=head1 NAME
+
+OpenBSD::BaseState - light-weight IO and system acces in pkg_add
+
+=head1 SYNOPSIS
+
+    use OpenBSD::BaseState;
+
+    OpenBSD::BaseState->say("I'm sorry #1, I'm afraid I can't do that", $user);
+    OpenBSD::BaseState->system('make', '-C');
+
+=head1 DESCRIPTION
+
+C<OpenBSD::BaseState> contains utility functions for C<OpenBSD::State> objects,
+as a light-weight framework for perl code that doesn't really need fully
+fledged state objects and all the extra luggage that the object provides.
+
+As such, C<OpenBSD::BaseState> contains the actual code for
+C<fhprint>, C<fhsay> C<print>, C<say>, C<errsay>, C<fatal>, C<f>, C<system>, C<verbose_system>, C<copy_file>, C<unlink>, C<copy>
+
+=over 4
+
+=item $class->can_output
+
+hook to be overidden if need be, for programs that do not want to keep
+writing to the terminal in the background. Returns 1 by default.
+
+=back
+
+=head1 BUGS
+
+User interface needs are not fully fleshed out and C<OpenBSD::State> is
+a work-in-progress.  What's described here should hopefully no longer
+change too much.