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