xref: /openbsd/usr.sbin/pkg_add/OpenBSD/Error.pm (revision 85d1f632) 
1# ex:ts=8 sw=4:
2# $OpenBSD: Error.pm,v 1.30 2010/12/24 09:04:14 espie Exp $
3#
4# Copyright (c) 2004-2010 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
17use strict;
18use warnings;
19
20package OpenBSD::Auto;
21sub cache(*&)
22{
23	my ($sym, $code) = @_;
24	my $callpkg = caller;
25	my $actual = sub {
26		my $self = shift;
27		return $self->{$sym} //= &$code($self);
28	};
29	no strict 'refs';
30	*{$callpkg."::$sym"} = $actual;
31}
32
33package OpenBSD::Handler;
34
35my $list = [];
36
37sub register
38{
39	my ($class, $code) = @_;
40	push(@$list, $code);
41}
42
43my $handler = sub {
44	my $sig = shift;
45	for my $c (@$list) {
46		&$c($sig);
47	}
48	$SIG{$sig} = 'DEFAULT';
49	kill $sig, $$;
50};
51
52sub reset
53{
54	$SIG{'INT'} = $handler;
55	$SIG{'QUIT'} = $handler;
56	$SIG{'HUP'} = $handler;
57	$SIG{'KILL'} = $handler;
58	$SIG{'TERM'} = $handler;
59}
60
61__PACKAGE__->reset;
62
63package OpenBSD::Error;
64require Exporter;
65our @ISA=qw(Exporter);
66our @EXPORT=qw(Copy Unlink try throw catch catchall rethrow);
67
68our ($FileName, $Line, $FullMessage);
69
70my @signal_name = ();
71
72use Carp;
73
74sub fillup_names
75{
76	{
77	# XXX force autoload
78	package verylocal;
79
80	require POSIX;
81	POSIX->import(qw(signal_h));
82	}
83
84	for my $sym (keys %POSIX::) {
85		next unless $sym =~ /^SIG([A-Z].*)/;
86		$signal_name[eval "&POSIX::$sym()"] = $1;
87	}
88	# extra BSD signals
89	$signal_name[5] = 'TRAP';
90	$signal_name[7] = 'IOT';
91	$signal_name[10] = 'BUS';
92	$signal_name[12] = 'SYS';
93	$signal_name[16] = 'URG';
94	$signal_name[23] = 'IO';
95	$signal_name[24] = 'XCPU';
96	$signal_name[25] = 'XFSZ';
97	$signal_name[26] = 'VTALRM';
98	$signal_name[27] = 'PROF';
99	$signal_name[28] = 'WINCH';
100	$signal_name[29] = 'INFO';
101}
102
103sub find_signal
104{
105	my $number =  shift;
106
107	if (@signal_name == 0) {
108		fillup_names();
109	}
110
111	return $signal_name[$number] || $number;
112}
113
114sub child_error
115{
116	my $error = $?;
117
118	my $extra = "";
119
120	if ($error & 128) {
121		$extra = " (core dumped)";
122	}
123	if ($error & 127) {
124		return "killed by signal ". find_signal($error & 127).$extra;
125	} else {
126		return "exit(". ($error >> 8) . ")$extra";
127	}
128}
129
130sub Copy
131{
132	require File::Copy;
133
134	my $r = File::Copy::copy(@_);
135	if (!$r) {
136		print "copy(", join(',', @_),") failed: $!\n";
137	}
138	return $r;
139}
140
141sub Unlink
142{
143	my $verbose = shift;
144	my $r = unlink @_;
145	if ($r != @_) {
146		print "rm @_ failed: removed only $r targets, $!\n";
147	} elsif ($verbose) {
148		print "rm @_\n";
149	}
150	return $r;
151}
152
153sub dienow
154{
155	my ($error, $handler) = @_;
156	if ($error) {
157		if ($error =~ m/^(.*?)(?:\s+at\s+(.*)\s+line\s+(\d+)\.?)?$/o) {
158			local $_ = $1;
159			$FileName = $2;
160			$Line = $3;
161			$FullMessage = $error;
162
163			$handler->exec($error, '', $1, $2, $3);
164		} else {
165			die "Fatal error: can't parse $error";
166		}
167	}
168}
169
170sub try(&@)
171{
172	my ($try, $catch) = @_;
173	eval { &$try };
174	dienow($@, $catch);
175}
176
177sub throw
178{
179	croak @_;
180
181}
182
183sub rethrow
184{
185	my $e = shift;
186	die $e if $e;
187}
188
189sub catch(&)
190{
191		bless $_[0], "OpenBSD::Error::catch";
192}
193
194sub catchall(&)
195{
196	bless $_[0], "OpenBSD::Error::catchall";
197}
198
199package OpenBSD::Error::catch;
200sub exec
201{
202	my ($self, $full, $e) = @_;
203	if ($e) {
204		&$self;
205	} else {
206		die $full;
207	}
208}
209
210package OpenBSD::Error::catchall;
211sub exec
212{
213	my ($self, $full, $e) = @_;
214	&$self;
215}
216
2171;
218