ArcCheck.pm revision 1.39 
1# ex:ts=8 sw=4:
2# $OpenBSD: ArcCheck.pm,v 1.39 2023/05/16 16:45:04 espie Exp $
3#
4# Copyright (c) 2005-2006 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# Supplementary code to handle archives in the package context.
19# Ustar allows about anything, but we want to forbid a lot of things.
20# this code is used during creation and extraction, "bridging" the gap
21# between tar balls OpenBSD::Ustar::Object and
22# packing list OpenBSD::PackingElement
23
24# specifically, during create time:
25# 	$o = $archive->prepare_long($item);
26# 	if (!$o->verify_modes($self))
27# 		error...
28# 	if (!$o->is_allowed)
29#		error...
30
31# during extraction:
32#	$o->validate_meta($item) or
33#		error...
34
35use strict;
36use warnings;
37
38use OpenBSD::Ustar;
39
40package OpenBSD::Ustar::Object;
41use POSIX;
42
43sub is_allowed() { 0 }
44
45# match archive header link name against actual link name
46sub check_linkname
47{
48	my ($self, $linkname) = @_;
49	my $c = $self->{linkname};
50	if ($self->isHardLink && defined $self->{cwd}) {
51		$c = $self->{cwd}.'/'.$c;
52	}
53	return $c eq $linkname;
54}
55
56sub errsay
57{
58	my ($self, @args) = @_;
59	$self->{archive}{state}->errsay(@args);
60}
61
62sub validate_meta
63{
64	my ($o, $item) = @_;
65
66	$o->{cwd} = $item->cwd;
67	if (defined $item->{symlink} || $o->isSymLink) {
68		if (!defined $item->{symlink}) {
69			$o->errsay("bogus symlink #1 -> #2",
70			    $item->name, $o->{linkname});
71			$o->errsay("\t(no \@symlink annotation in packing-list)");
72			return 0;
73		}
74		if (!$o->isSymLink) {
75			$o->errsay("bogus symlink #1 -> #2",
76			    $item->name, $item->{symlink});
77			$o->errsay("\t(not a symlink in the tarball)");
78			return 0;
79		}
80		if (!$o->check_linkname($item->{symlink})) {
81			$o->errsay("archive symlink does not match #1 != #2",
82			    $o->{linkname}, $item->{symlink});
83			return 0;
84		}
85	} elsif (defined $item->{link} || $o->isHardLink) {
86		if (!defined $item->{link}) {
87			$o->errsay("bogus hardlink #1 -> #2",
88			    $item->name, $o->{linkname});
89			$o->errsay("\t(no \@link annotation in packing-list)");
90			return 0;
91		}
92		if (!$o->isHardLink) {
93			$o->errsay("bogus hardlink #1 -> #2",
94			    $item->name, $item->{link});
95			$o->errsay("\t(not a link in the tarball)");
96			return 0;
97		}
98		if (!$o->check_linkname($item->{link})) {
99			$o->errsay("archive hardlink does not match #1 != #2",
100			    $o->{linkname}, $item->{link});
101			return 0;
102		}
103	} elsif ($o->isFile) {
104		if (!defined $item->{size}) {
105			$o->errsay("Error: file #1 does not have recorded size",
106			    $item->fullname);
107			return 0;
108		} elsif ($item->{size} != $o->{size}) {
109			$o->errsay("Error: size does not match for #1",
110			    $item->fullname);
111			return 0;
112		}
113	} else {
114		$o->errsay("archive content for #1 should be file",
115		    $item->name);
116		return 0;
117	}
118	return $o->verify_modes($item);
119}
120
121sub strip_modes
122{
123	my ($o, $item) = @_;
124
125	my $result = $o->{mode};
126
127	# disallow writable files/dirs without explicit annotation
128	if (!defined $item->{mode}) {
129		# if there's an owner, we have to be explicit
130		if (defined $item->{owner}) {
131			$result &= ~(S_IWUSR|S_IWGRP|S_IWOTH);
132		} else {
133			$result &= ~(S_IWGRP|S_IWOTH);
134		}
135		# and make libraries non-executable
136		if ($item->is_a_library) {
137			$result &= ~(S_IXUSR|S_IXGRP|S_IXOTH);
138		}
139		$result |= S_IROTH | S_IRGRP;
140	}
141	# XXX newer tarballs never have suid/sgid, but some 7.0 packages
142	# still have them... We'll strip them here unconditionally instead
143	# of in XXX /1 and XXX /2
144	if (defined $item->{group} || defined $item->{owner}) {
145		$result &= ~(S_ISUID|S_ISGID);
146	}
147	return $result;
148}
149
150sub printable_mode
151{
152	my $o = shift;
153	return sprintf("%4o",
154	    $o->{mode} & (S_IRWXU | S_IRWXG | S_IRWXO | S_ISUID | S_ISGID));
155}
156
157sub verify_modes
158{
159	my ($o, $item) = @_;
160	my $result = 1;
161
162	if (!defined $item->{owner}) {
163		if ($o->{uname} ne 'root') {
164			$o->errsay("Error: no \@owner for #1 (#2)",
165			    $item->fullname, $o->{uname});
166	    		$result = 0;
167		}
168	}
169	if (!defined $item->{group}) {
170		if ($o->{gname} ne 'bin' && $o->{gname} ne 'wheel') {
171			$o->errsay("Error: no \@group for #1 (#2)",
172			    $item->fullname, $o->{gname});
173			$result = 0;
174		}
175	}
176	# XXX /1
177	$o->{mode} &= ~(S_ISUID|S_ISGID);
178	if ($o->{mode} != $o->strip_modes($o)) {
179		$o->errsay("Error: weird mode for #1: #2", $item->fullname,
180		    $o->printable_mode);
181		    $result = 0;
182 	}
183	return $result;
184}
185
186package OpenBSD::Ustar::HardLink;
187sub is_allowed() { 1 }
188
189package OpenBSD::Ustar::SoftLink;
190sub is_allowed() { 1 }
191
192package OpenBSD::Ustar::File;
193sub is_allowed() { 1 }
194
195package OpenBSD::Ustar;
196use POSIX;
197
198# prepare item according to pkg_create's rules.
199sub prepare_long
200{
201	my ($self, $item) = @_;
202	my $entry;
203	if (defined $item->{wtempname}) {
204		$entry = $self->prepare($item->{wtempname}, '');
205	} else {
206		$entry = $self->prepare($item->name);
207	}
208	if (defined $item->{owner}) {
209		$entry->{uname} = $item->{owner};
210		if (defined $item->{uid}) {
211			$entry->{uid} = $item->{uid};
212		} else {
213			delete $entry->{uid};
214		}
215	} else {
216		$entry->{uname} = "root";
217		delete $entry->{uid};
218	}
219	if (defined $item->{group}) {
220		$entry->{gname} = $item->{group};
221		if (defined $item->{gid}) {
222			$entry->{gid} = $item->{gid};
223		} else {
224			delete $entry->{gid};
225		}
226	} else {
227		$entry->{gname} = "bin";
228		delete $entry->{gid};
229	}
230	# likewise, we skip links on extractions, so hey, don't even care
231	# about modes and stuff.
232	if ($entry->isSymLink) {
233		$entry->{mode} = 0777;
234		$entry->{uname} = 'root';
235		$entry->{gname} = 'wheel';
236		delete $entry->{uid};
237		delete $entry->{gid};
238	}
239	$entry->recheck_owner;
240	if (!defined $entry->{uname}) {
241		$self->fatal("No user name for #1 (uid #2)",
242		    $item->name, $entry->{uid});
243	}
244	if (!defined $entry->{gname}) {
245		$self->fatal("No group name for #1 (gid #2)",
246		    $item->name, $entry->{gid});
247	}
248	# XXX /2
249	$entry->{mode} = $entry->strip_modes($item) & ~(S_ISUID|S_ISGID);
250	if (defined $item->{ts}) {
251		delete $entry->{mtime};
252	}
253
254	$entry->set_name($item->name);
255	return $entry;
256}
257
2581;
259