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