17e83eca3Sespie# ex:ts=8 sw=4: 2*76be6724Sespie# $OpenBSD: State.pm,v 1.77 2023/11/25 10:18:40 espie Exp $ 37e83eca3Sespie# 445019a4aSespie# Copyright (c) 2007-2014 Marc Espie <espie@openbsd.org> 57e83eca3Sespie# 67e83eca3Sespie# Permission to use, copy, modify, and distribute this software for any 77e83eca3Sespie# purpose with or without fee is hereby granted, provided that the above 87e83eca3Sespie# copyright notice and this permission notice appear in all copies. 97e83eca3Sespie# 107e83eca3Sespie# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 117e83eca3Sespie# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 127e83eca3Sespie# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 137e83eca3Sespie# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 147e83eca3Sespie# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 157e83eca3Sespie# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 167e83eca3Sespie# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 177e83eca3Sespie# 187e83eca3Sespie 19039cbdaaSespieuse v5.36; 207e83eca3Sespie 2109457c5cSespiepackage OpenBSD::PackageRepositoryFactory; 22039cbdaaSespiesub new($class, $state) 2309457c5cSespie{ 24a298a0f0Sespie return bless {state => $state}, $class; 2509457c5cSespie} 2609457c5cSespie 27039cbdaaSespiesub locator($self) 2801fd8ee4Sespie{ 2901fd8ee4Sespie return $self->{state}->locator; 3001fd8ee4Sespie} 3101fd8ee4Sespie 32039cbdaaSespiesub installed($self, $all = 0) 3309457c5cSespie{ 3409457c5cSespie require OpenBSD::PackageRepository::Installed; 3509457c5cSespie 365732efc0Sespie return OpenBSD::PackageRepository::Installed->new($all, $self->{state}); 3709457c5cSespie} 3809457c5cSespie 39039cbdaaSespiesub path_parse($self, $pkgname) 4009457c5cSespie{ 4101fd8ee4Sespie return $self->locator->path_parse($pkgname, $self->{state}); 4209457c5cSespie} 4309457c5cSespie 44039cbdaaSespiesub find($self, $pkg) 4509457c5cSespie{ 4601fd8ee4Sespie return $self->locator->find($pkg, $self->{state}); 4709457c5cSespie} 4809457c5cSespie 49039cbdaaSespiesub reinitialize($) 5095dd7c3aSespie{ 5195dd7c3aSespie} 5295dd7c3aSespie 53039cbdaaSespiesub match_locations($self, @p) 5409457c5cSespie{ 55039cbdaaSespie return $self->locator->match_locations(@p, $self->{state}); 5609457c5cSespie} 5709457c5cSespie 58039cbdaaSespiesub grabPlist($self, $url, $code) 5903da085cSespie{ 6001fd8ee4Sespie return $self->locator->grabPlist($url, $code, $self->{state}); 6103da085cSespie} 6203da085cSespie 63039cbdaaSespiesub path($self) 6409457c5cSespie{ 6509457c5cSespie require OpenBSD::PackageRepositoryList; 6609457c5cSespie 675732efc0Sespie return OpenBSD::PackageRepositoryList->new($self->{state}); 6809457c5cSespie} 6909457c5cSespie 707e83eca3Sespie# common routines to everything state. 717e83eca3Sespie# in particular, provides "singleton-like" access to UI. 727e83eca3Sespiepackage OpenBSD::State; 731b7dc0e4Sespieuse OpenBSD::Subst; 7409457c5cSespieuse OpenBSD::Error; 75839fcc54Sespieuse parent qw(OpenBSD::BaseState Exporter); 761b7dc0e4Sespieour @EXPORT = (); 777e83eca3Sespie 78039cbdaaSespiesub locator($) 7901fd8ee4Sespie{ 8001fd8ee4Sespie require OpenBSD::PackageLocator; 8101fd8ee4Sespie return "OpenBSD::PackageLocator"; 8201fd8ee4Sespie} 8301fd8ee4Sespie 84039cbdaaSespiesub cache_directory($) 85d71f6f90Sespie{ 86d71f6f90Sespie return undef; 87d71f6f90Sespie} 88d71f6f90Sespie 89039cbdaaSespiesub new($class, $cmd = undef, @p) 907e83eca3Sespie{ 9191daaedbSespie if (!defined $cmd) { 9291daaedbSespie $cmd = $0; 9391daaedbSespie $cmd =~ s,.*/,,; 9491daaedbSespie } 957e83eca3Sespie my $o = bless {cmd => $cmd}, $class; 96039cbdaaSespie $o->init(@p); 977e83eca3Sespie return $o; 987e83eca3Sespie} 997e83eca3Sespie 100039cbdaaSespiesub init($self) 1017e83eca3Sespie{ 1021b7dc0e4Sespie $self->{subst} = OpenBSD::Subst->new; 10309457c5cSespie $self->{repo} = OpenBSD::PackageRepositoryFactory->new($self); 104a7d81fe1Sespie $self->{export_level} = 1; 1059451df68Sespie $SIG{'CONT'} = sub { 1069451df68Sespie $self->handle_continue; 1079451df68Sespie } 10809457c5cSespie} 10909457c5cSespie 110039cbdaaSespiesub repo($self) 11109457c5cSespie{ 11209457c5cSespie return $self->{repo}; 1137e83eca3Sespie} 1147e83eca3Sespie 115039cbdaaSespiesub handle_continue($self) 11633ae5dabSespie{ 11792c1b6f5Sespie $self->find_window_size; 1189451df68Sespie # invalidate cache so this runs again after continue 1199451df68Sespie delete $self->{can_output}; 12033ae5dabSespie} 12133ae5dabSespie 1229451df68SespieOpenBSD::Auto::cache(can_output, 123039cbdaaSespie sub($) { 1249451df68Sespie require POSIX; 1257d028f80Sespie 126730cf84eSespie return 1 if !-t STDOUT; 1279451df68Sespie # XXX uses POSIX semantics so fd, we can hardcode stdout ;) 1287d028f80Sespie my $s = POSIX::tcgetpgrp(1); 129730cf84eSespie # note that STDOUT may be redirected 130730cf84eSespie # (tcgetpgrp() returns 0 for pipes and -1 for files) 131730cf84eSespie # (we shouldn't be there because of the tty test) 132730cf84eSespie return $s <= 0 || getpgrp() == $s; 1339451df68Sespie }); 1349451df68Sespie 1356b6947a6SespieOpenBSD::Auto::cache(installpath, 136039cbdaaSespie sub($self) { 1378a054d5eSespie return undef if $self->defines('NOINSTALLPATH'); 1386b6947a6Sespie require OpenBSD::Paths; 139a71e68baSespie open(my $fh, '<', OpenBSD::Paths->installurl) or return undef; 1406b6947a6Sespie while (<$fh>) { 1416b6947a6Sespie chomp; 1426b6947a6Sespie next if m/^\s*\#/; 1436b6947a6Sespie next if m/^\s*$/; 144a71e68baSespie return "$_/%c/packages/%a/"; 1456b6947a6Sespie } 146a2652750Sespie }); 147a2652750Sespie 14808eb747cSespieOpenBSD::Auto::cache(shlibs, 149039cbdaaSespie sub($self) { 15008eb747cSespie require OpenBSD::SharedLibs; 15108eb747cSespie return $self->{shlibs} //= OpenBSD::SharedLibs->new($self); 15208eb747cSespie }); 15308eb747cSespie 154039cbdaaSespiesub usage_is($self, @usage) 1557e83eca3Sespie{ 1567e83eca3Sespie $self->{usage} = \@usage; 1577e83eca3Sespie} 1587e83eca3Sespie 159039cbdaaSespiesub verbose($self) 1601b7dc0e4Sespie{ 1611b7dc0e4Sespie return $self->{v}; 1621b7dc0e4Sespie} 1631b7dc0e4Sespie 164039cbdaaSespiesub opt($self, $k) 1651b7dc0e4Sespie{ 1661b7dc0e4Sespie return $self->{opt}{$k}; 1671b7dc0e4Sespie} 1681b7dc0e4Sespie 169039cbdaaSespiesub usage($self, @p) 1707e83eca3Sespie{ 1717e83eca3Sespie my $code = 0; 172039cbdaaSespie if (@p) { 173039cbdaaSespie print STDERR "$self->{cmd}: ", $self->f(@p), "\n"; 1747e83eca3Sespie $code = 1; 1757e83eca3Sespie } 1767e83eca3Sespie print STDERR "Usage: $self->{cmd} ", shift(@{$self->{usage}}), "\n"; 1777e83eca3Sespie for my $l (@{$self->{usage}}) { 1787e83eca3Sespie print STDERR " $l\n"; 1797e83eca3Sespie } 1807e83eca3Sespie exit($code); 1817e83eca3Sespie} 1827e83eca3Sespie 183039cbdaaSespiesub do_options($state, $sub) 184ece832d9Sespie{ 185ece832d9Sespie # this could be nicer... 18609457c5cSespie 18709457c5cSespie try { 188039cbdaaSespie &$sub(); 18991273194Sespie } catch { 19009457c5cSespie $state->usage("#1", $_); 19109457c5cSespie }; 192ece832d9Sespie} 193ece832d9Sespie 1948d091280Sespiesub validate_usage($state, $string, @usage) 1958d091280Sespie{ 1968d091280Sespie my $h = {}; 1978d091280Sespie my $h2 = {}; 1988d091280Sespie my $previous; 1998d091280Sespie for my $letter (split //, $string) { 2008d091280Sespie if ($letter eq ':') { 2018d091280Sespie $h->{$previous} = 1; 2028d091280Sespie } else { 2038d091280Sespie $previous = $letter; 2048d091280Sespie $h->{$previous} = 0; 2058d091280Sespie } 2068d091280Sespie } 2078d091280Sespie for my $u (@usage) { 2088d091280Sespie while ($u =~ s/\[\-(.*?)\]//) { 2098d091280Sespie my $opts = $1; 2108d091280Sespie if ($opts =~ m/^[A-Za-z]+$/) { 2118d091280Sespie for my $o (split //, $opts) { 2128d091280Sespie $h2->{$o} = 0; 2138d091280Sespie } 2148d091280Sespie } else { 2158d091280Sespie $opts =~ m/./; 2168d091280Sespie $h2->{$&} = 1; 2178d091280Sespie } 2188d091280Sespie } 2198d091280Sespie } 2208d091280Sespie for my $k (keys %$h) { 2218d091280Sespie if (!exists $h2->{$k}) { 2228d091280Sespie $state->errsay("Option #1 #2is not in usage", $k, 2238d091280Sespie $h->{$k} ? "(with params) " : ""); 2248d091280Sespie } elsif ($h2->{$k} != $h->{$k}) { 2258d091280Sespie $state->errsay("Discrepancy for option #1", $k); 2268d091280Sespie } 2278d091280Sespie } 2288d091280Sespie for my $k (keys %$h2) { 2298d091280Sespie if (!exists $h->{$k}) { 2308d091280Sespie $state->errsay("Option #1 does not exist", $k); 2318d091280Sespie } 2328d091280Sespie } 2338d091280Sespie} 2348d091280Sespie 235039cbdaaSespiesub handle_options($state, $opt_string, @usage) 2361b7dc0e4Sespie{ 2371b7dc0e4Sespie require OpenBSD::Getopt; 2381b7dc0e4Sespie 2399f65a95eSespie $state->{opt}{v} = 0 unless $opt_string =~ m/v/; 240039cbdaaSespie $state->{opt}{h} = 241039cbdaaSespie sub() { 242039cbdaaSespie $state->usage; 243039cbdaaSespie } unless $opt_string =~ m/h/; 244039cbdaaSespie $state->{opt}{D} = 245039cbdaaSespie sub($opt) { 246039cbdaaSespie $state->{subst}->parse_option($opt); 2479f65a95eSespie } unless $opt_string =~ m/D/; 2481b7dc0e4Sespie $state->usage_is(@usage); 249039cbdaaSespie $state->do_options(sub() { 2509f65a95eSespie OpenBSD::Getopt::getopts($opt_string.'hvD:', $state->{opt}); 2511b7dc0e4Sespie }); 2521b7dc0e4Sespie $state->{v} = $state->opt('v'); 253c21f7911Sespie 254*76be6724Sespie # XXX don't try to move to AddCreateDelete, PkgInfo needs this too 255f34ebb88Sespie if ($state->defines('unsigned')) { 256c21f7911Sespie $state->{signature_style} //= 'unsigned'; 257c21f7911Sespie } elsif ($state->defines('oldsign')) { 258f34ebb88Sespie $state->fatal('old style signature no longer supported'); 259c21f7911Sespie } else { 2600c058166Snaddy $state->{signature_style} //= 'new'; 261c21f7911Sespie } 262c21f7911Sespie 2638d091280Sespie if ($state->defines('VALIDATE_USAGE')) { 2648d091280Sespie $state->validate_usage($opt_string.'vD:', @usage); 2658d091280Sespie } 2661b7dc0e4Sespie return if $state->{no_exports}; 267039cbdaaSespie # TODO make sure nothing uses this 2681b7dc0e4Sespie no strict "refs"; 2691b7dc0e4Sespie no strict "vars"; 2701b7dc0e4Sespie for my $k (keys %{$state->{opt}}) { 2711b7dc0e4Sespie ${"opt_$k"} = $state->opt($k); 2721b7dc0e4Sespie push(@EXPORT, "\$opt_$k"); 2731b7dc0e4Sespie } 274a7d81fe1Sespie local $Exporter::ExportLevel = $state->{export_level}; 2753550cba9Sespie OpenBSD::State->import; 2761b7dc0e4Sespie} 2771b7dc0e4Sespie 278039cbdaaSespiesub defines($self, $k) 279fc17dd9dSespie{ 280fc17dd9dSespie return $self->{subst}->value($k); 281fc17dd9dSespie} 282fc17dd9dSespie 283039cbdaaSespiesub width($self) 284645b31caSespie{ 285645b31caSespie if (!defined $self->{width}) { 286645b31caSespie $self->find_window_size; 287645b31caSespie } 288645b31caSespie return $self->{width}; 289645b31caSespie} 290645b31caSespie 291039cbdaaSespiesub height($self) 292645b31caSespie{ 293645b31caSespie if (!defined $self->{height}) { 294645b31caSespie $self->find_window_size; 295645b31caSespie } 296645b31caSespie return $self->{height}; 297645b31caSespie} 298645b31caSespie 299039cbdaaSespiesub find_window_size($self) 300645b31caSespie{ 301645b31caSespie require Term::ReadKey; 302645b31caSespie my @l = Term::ReadKey::GetTermSizeGWINSZ(\*STDOUT); 3038b347d32Sespie # default to sane values 304645b31caSespie $self->{width} = 80; 305645b31caSespie $self->{height} = 24; 3068b347d32Sespie if (@l == 4) { 3078b347d32Sespie # only use what we got if sane 3088b347d32Sespie $self->{width} = $l[0] if $l[0] > 0; 3098b347d32Sespie $self->{height} = $l[1] if $l[1] > 0; 310645b31caSespie $SIG{'WINCH'} = sub { 311645b31caSespie $self->find_window_size; 312645b31caSespie }; 313645b31caSespie } 314645b31caSespie} 315645b31caSespie 3167e83eca3Sespie1; 317