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