xref: /openbsd/usr.sbin/pkg_add/OpenBSD/State.pm (revision 5af055cd) 
1# ex:ts=8 sw=4:
2# $OpenBSD: State.pm,v 1.34 2015/04/06 11:07:24 espie Exp $
3#
4# Copyright (c) 2007-2014 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17#
18
19use strict;
20use warnings;
21
22package OpenBSD::Configuration;
23sub new
24{
25	my ($class, $state) = @_;
26	my $self = bless {}, $class;
27	require OpenBSD::Paths;
28	$self->read_file(OpenBSD::Paths->pkgconf, $state);
29	return $self;
30}
31
32sub read_file
33{
34	my ($self, $filename, $state) = @_;
35	open(my $fh, '<', $filename) or return;
36	while (<$fh>) {
37		chomp;
38		next if m/^\s*\#/;
39		next if m/^\s*$/;
40		my ($cmd, $k, $v, $add);
41		my $h = $self;
42		if (($cmd, $k, $add, $v) = m/^\s*(.*?)\.(.*?)\s*(\+?)\=\s*(.*)\s*$/) {
43			next unless $cmd eq $state->{cmd};
44			my $h = $self->{cmd} = {};
45		} elsif (($k, $add, $v) = m/^\s*(.*?)\s*(\+?)\=\s*(.*)\s*$/) {
46		} else {
47			# bad line: should we say so ?
48			$state->errsay("Bad line in #1: #2 (#3)",
49			    $filename, $_, $.);
50			next;
51		}
52		# remove caps
53		$k =~ tr/A-Z/a-z/;
54		if ($add eq '') {
55			$h->{$k} = [$v];
56		} else {
57			push(@{$h->{$k}}, $v);
58		}
59	}
60}
61
62sub ref
63{
64	my ($self, $k) = @_;
65	if (defined $self->{cmd}{$k}) {
66		return $self->{cmd}{$k};
67	} else {
68		return $self->{$k};
69	}
70}
71
72sub value
73{
74	my ($self, $k) = @_;
75	my $r = $self->ref($k);
76	if (!defined $r) {
77		return $r;
78	}
79	if (wantarray) {
80		return @$r;
81	} else {
82		return $r->[0];
83	}
84}
85
86sub istrue
87{
88	my ($self, $k) = @_;
89	my $v = $self->value($k);
90	if (defined $v && $v =~ /^yes$/i) {
91		return 1;
92	} else {
93		return 0;
94	}
95}
96
97package OpenBSD::PackageRepositoryFactory;
98sub new
99{
100	my ($class, $state) = @_;
101	bless {state => $state}, $class;
102}
103
104sub installed
105{
106	my ($self, $all) = @_;
107	require OpenBSD::PackageRepository::Installed;
108
109	return OpenBSD::PackageRepository::Installed->new($all, $self->{state});
110}
111
112sub path_parse
113{
114	my ($self, $pkgname) = @_;
115	require OpenBSD::PackageLocator;
116
117	return OpenBSD::PackageLocator->path_parse($pkgname, $self->{state});
118}
119
120sub find
121{
122	my ($self, $pkg) = @_;
123	require OpenBSD::PackageLocator;
124
125	return OpenBSD::PackageLocator->find($pkg, $self->{state});
126}
127
128sub reinitialize
129{
130}
131
132sub match_locations
133{
134	my $self = shift;
135	require OpenBSD::PackageLocator;
136
137	return OpenBSD::PackageLocator->match_locations(@_, $self->{state});
138}
139
140sub grabPlist
141{
142	my ($self, $url, $code) = @_;
143	require OpenBSD::PackageLocator;
144
145	return OpenBSD::PackageLocator->grabPlist($url, $code, $self->{state});
146}
147
148sub path
149{
150	my $self = shift;
151	require OpenBSD::PackageRepositoryList;
152
153	return OpenBSD::PackageRepositoryList->new($self->{state});
154}
155
156# common routines to everything state.
157# in particular, provides "singleton-like" access to UI.
158package OpenBSD::State;
159use Carp;
160use OpenBSD::Subst;
161use OpenBSD::Error;
162require Exporter;
163our @ISA = qw(Exporter);
164our @EXPORT = ();
165
166sub new
167{
168	my $class = shift;
169	my $cmd = shift;
170	my $o = bless {cmd => $cmd}, $class;
171	$o->init(@_);
172	return $o;
173}
174
175sub init
176{
177	my $self = shift;
178	$self->{subst} = OpenBSD::Subst->new;
179	$self->{repo} = OpenBSD::PackageRepositoryFactory->new($self);
180	$self->{export_level} = 1;
181}
182
183sub repo
184{
185	my $self = shift;
186	return $self->{repo};
187}
188
189sub sync_display
190{
191}
192
193OpenBSD::Auto::cache(config,
194	sub {
195		return OpenBSD::Configuration->new(shift);
196	});
197
198sub usage_is
199{
200	my ($self, @usage) = @_;
201	$self->{usage} = \@usage;
202}
203
204sub verbose
205{
206	my $self = shift;
207	return $self->{v};
208}
209
210sub opt
211{
212	my ($self, $k) = @_;
213	return $self->{opt}{$k};
214}
215
216sub usage
217{
218	my $self = shift;
219	my $code = 0;
220	if (@_) {
221		print STDERR "$self->{cmd}: ", $self->f(@_), "\n";
222		$code = 1;
223	}
224	print STDERR "Usage: $self->{cmd} ", shift(@{$self->{usage}}), "\n";
225	for my $l (@{$self->{usage}}) {
226		print STDERR "       $l\n";
227	}
228	exit($code);
229}
230
231sub f
232{
233	my $self = shift;
234	if (@_ == 0) {
235		return undef;
236	}
237	my ($fmt, @l) = @_;
238	# make it so that #0 is #
239	unshift(@l, '#');
240	$fmt =~ s,\#(\d+),($l[$1] // "<Undefined #$1>"),ge;
241	return $fmt;
242}
243
244sub _fatal
245{
246	my $self = shift;
247	# implementation note: to print "fatal errors" elsewhere,
248	# the way is to eval { croak @_}; and decide what to do with $@.
249	delete $SIG{__DIE__};
250	$self->sync_display;
251	croak "Fatal error: ", @_, "\n";
252}
253
254sub fatal
255{
256	my $self = shift;
257	$self->_fatal($self->f(@_));
258}
259
260sub _print
261{
262	my $self = shift;
263	$self->sync_display;
264	print @_;
265}
266
267sub _errprint
268{
269	my $self = shift;
270	$self->sync_display;
271	print STDERR @_;
272}
273
274sub print
275{
276	my $self = shift;
277	$self->_print($self->f(@_));
278}
279
280sub say
281{
282	my $self = shift;
283	if (@_ == 0) {
284		$self->_print("\n");
285	} else {
286		$self->_print($self->f(@_), "\n");
287	}
288}
289
290sub errprint
291{
292	my $self = shift;
293	$self->_errprint($self->f(@_));
294}
295
296sub errsay
297{
298	my $self = shift;
299	if (@_ == 0) {
300		$self->_errprint("\n");
301	} else {
302		$self->_errprint($self->f(@_), "\n");
303	}
304}
305
306sub do_options
307{
308	my ($state, $sub) = @_;
309	# this could be nicer...
310
311	try {
312		&$sub;
313	} catchall {
314		$state->usage("#1", $_);
315	};
316}
317
318sub handle_options
319{
320	my ($state, $opt_string, @usage) = @_;
321	require OpenBSD::Getopt;
322
323	$state->{opt}{v} = 0 unless $opt_string =~ m/v/;
324	$state->{opt}{h} = sub { $state->usage; } unless $opt_string =~ m/h/;
325	$state->{opt}{D} = sub {
326		$state->{subst}->parse_option(shift);
327	} unless $opt_string =~ m/D/;
328	$state->usage_is(@usage);
329	$state->do_options(sub {
330		OpenBSD::Getopt::getopts($opt_string.'hvD:', $state->{opt});
331	});
332	$state->{v} = $state->opt('v');
333	return if $state->{no_exports};
334	# XXX
335	no strict "refs";
336	no strict "vars";
337	for my $k (keys %{$state->{opt}}) {
338		${"opt_$k"} = $state->opt($k);
339		push(@EXPORT, "\$opt_$k");
340	}
341	local $Exporter::ExportLevel = $state->{export_level};
342	import OpenBSD::State;
343}
344
345sub defines
346{
347	my ($self, $k) = @_;
348	return $self->{subst}->value($k);
349}
350
351OpenBSD::Auto::cache(signer_list,
352	sub {
353		my $self = shift;
354		if ($self->defines('SIGNER')) {
355			return [split /,/, $self->{subst}->value('SIGNER')];
356		} else {
357			if ($self->defines('FW_UPDATE')) {
358				return [qr{^.*fw$}];
359			} else {
360				return [qr{^.*pkg$}];
361			}
362		}
363	});
364
365my @signal_name = ();
366sub fillup_names
367{
368	{
369	# XXX force autoload
370	package verylocal;
371
372	require POSIX;
373	POSIX->import(qw(signal_h));
374	}
375
376	for my $sym (keys %POSIX::) {
377		next unless $sym =~ /^SIG([A-Z].*)/;
378		$signal_name[eval "&POSIX::$sym()"] = $1;
379	}
380	# extra BSD signals
381	$signal_name[5] = 'TRAP';
382	$signal_name[7] = 'IOT';
383	$signal_name[10] = 'BUS';
384	$signal_name[12] = 'SYS';
385	$signal_name[16] = 'URG';
386	$signal_name[23] = 'IO';
387	$signal_name[24] = 'XCPU';
388	$signal_name[25] = 'XFSZ';
389	$signal_name[26] = 'VTALRM';
390	$signal_name[27] = 'PROF';
391	$signal_name[28] = 'WINCH';
392	$signal_name[29] = 'INFO';
393}
394
395sub find_signal
396{
397	my $number =  shift;
398
399	if (@signal_name == 0) {
400		fillup_names();
401	}
402
403	return $signal_name[$number] || $number;
404}
405
406sub child_error
407{
408	my $self = shift;
409	my $error = $?;
410
411	my $extra = "";
412
413	if ($error & 128) {
414		$extra = $self->f(" (core dumped)");
415	}
416	if ($error & 127) {
417		return $self->f("killed by signal #1#2",
418		    find_signal($error & 127), $extra);
419	} else {
420		return $self->f("exit(#1)#2", ($error >> 8), $extra);
421	}
422}
423
424sub _system
425{
426	my $self = shift;
427	$self->sync_display;
428	my $r = fork;
429	my ($todo, $todo2);
430	if (ref $_[0] eq 'CODE') {
431		$todo = shift;
432	} else {
433		$todo = sub {};
434	}
435	if (ref $_[0] eq 'CODE') {
436		$todo2 = shift;
437	} else {
438		$todo2 = sub {};
439	}
440	if (!defined $r) {
441		return 1;
442	} elsif ($r == 0) {
443		&$todo;
444		exec {$_[0]} @_ or return 1;
445	} else {
446		&$todo2;
447		waitpid($r, 0);
448		return $?;
449	}
450}
451
452sub system
453{
454	my $self = shift;
455	my $r = $self->_system(@_);
456	if ($r != 0) {
457		if (ref $_[0] eq 'CODE') {
458			shift;
459		}
460		if (ref $_[0] eq 'CODE') {
461			shift;
462		}
463		$self->say("system(#1) failed: #2",
464		    join(", ", @_), $self->child_error);
465	}
466	return $r;
467}
468
469sub verbose_system
470{
471	my $self = shift;
472	my @p = @_;
473	if (ref $p[0]) {
474		shift @p;
475	}
476	if (ref $p[0]) {
477		shift @p;
478	}
479
480	$self->print("Running #1", join(' ', @p));
481	my $r = $self->_system(@_);
482	if ($r != 0) {
483		$self->say("... failed: #1", $self->child_error);
484	} else {
485		$self->say;
486	}
487}
488
489sub copy_file
490{
491	my $self = shift;
492	require File::Copy;
493
494	my $r = File::Copy::copy(@_);
495	if (!$r) {
496		$self->say("copy(#1) failed: #2", join(',', @_), $!);
497	}
498	return $r;
499}
500
501sub unlink
502{
503	my $self = shift;
504	my $verbose = shift;
505	my $r = unlink @_;
506	if ($r != @_) {
507		$self->say("rm #1 failed: removed only #2 targets, #3",
508		    join(' ', @_), $r, $!);
509	} elsif ($verbose) {
510		$self->say("rm #1", join(' ', @_));
511	}
512	return $r;
513}
514
515sub copy
516{
517	my $self = shift;
518	require File::Copy;
519
520	my $r = File::Copy::copy(@_);
521	if (!$r) {
522		$self->say("copy(#1) failed: #2", join(',', @_), $!);
523	}
524	return $r;
525}
526
5271;
528