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