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