ArcCheck.pm revision 1.29
1# ex:ts=8 sw=4: 2# $OpenBSD: ArcCheck.pm,v 1.29 2014/09/16 08:51:38 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# Contrarily to GNU-tar, we do not change the archive format, but by 20# convention, the names LongName\d+ and LongLink\d correspond to names 21# too long to fit. The actual names reside in the PLIST, but the archive 22# is still a valid archive. 23 24use strict; 25use warnings; 26 27use OpenBSD::Ustar; 28 29package OpenBSD::Ustar::Object; 30 31# match archive header name against PackingElement item 32sub check_name 33{ 34 my ($self, $item) = @_; 35 return $self->name eq $item->name; 36} 37 38# match archive header link name against actual link names 39sub check_linkname 40{ 41 my ($self, $linkname) = @_; 42 my $c = $self->{linkname}; 43 if ($self->isHardLink && defined $self->{cwd}) { 44 $c = $self->{cwd}.'/'.$c; 45 } 46 return $c eq $linkname; 47} 48 49use POSIX; 50 51sub verify_modes 52{ 53 my ($o, $item) = @_; 54 my $result = 1; 55 56 if (!defined $item->{owner} && !$o->isSymLink) { 57 if ($o->{uname} ne 'root' && $o->{uname} ne 'bin') { 58 $o->errsay("Error: no \@owner for #1 (#2)", 59 $item->fullname, $o->{uname}); 60 $result = 0; 61 } 62 } 63 if (!defined $item->{group} && !$o->isSymLink) { 64 if ($o->{gname} ne 'bin' && $o->{gname} ne 'wheel') { 65 if (($o->{mode} & (S_ISUID | S_ISGID | S_IWGRP)) != 0) { 66 $o->errsay("Error: no \@group for #1 (#2), which has mode #3", 67 $item->fullname, $o->{uname}, 68 sprintf("%4o", $o->{mode} & (S_IRWXU | S_IRWXG | S_IRWXO | S_ISUID | S_ISGID))); 69 $result = 0; 70 } else { 71 $o->errsay("Warning: no \@group for #1 (#2)", 72 $item->fullname, $o->{gname}); 73 } 74 } 75 } 76 if (!defined $item->{mode} && $o->isFile) { 77 if (($o->{mode} & (S_ISUID | S_ISGID | S_IWOTH)) != 0 || 78 ($o->{mode} & S_IROTH) == 0 || ($o->{mode} & S_IRGRP) == 0) { 79 $o->errsay("Error: weird mode for #1: #2", 80 $item->fullname, 81 sprintf("%4o", $o->{mode} & (S_IRWXU | S_IRWXG | S_IRWXO | S_ISUID | S_ISGID))); 82 $result = 0; 83 } 84 } 85 if ($o->isFile) { 86 if (!defined $item->{size}) { 87 $o->errsay("Error: file #1 does not have recorded size", 88 $item->fullname); 89 $result = 0; 90 } elsif ($item->{size} != $o->{size}) { 91 $o->errsay("Error: size does not match for #1", 92 $item->fullname); 93 $result = 0; 94 } 95 } 96 return $result; 97} 98 99package OpenBSD::Ustar; 100use POSIX; 101 102# prepare item and introduce long names where needed. 103sub prepare_long 104{ 105 my ($self, $item) = @_; 106 my $entry; 107 if (defined $item->{wtempname}) { 108 $entry = $self->prepare($item->{wtempname}, ''); 109 } else { 110 $entry = $self->prepare($item->name); 111 } 112 if (defined $item->{owner}) { 113 $entry->{uname} = $item->{owner}; 114 if (defined $item->{uid}) { 115 $entry->{uid} = $item->{uid}; 116 } else { 117 delete $entry->{uid}; 118 } 119 } elsif ($< && $entry->{uid} == $<) { 120 $entry->{uname} = "root"; 121 delete $entry->{uid}; 122 } 123 if (defined $item->{group}) { 124 $entry->{gname} = $item->{group}; 125 if (defined $item->{gid}) { 126 $entry->{gid} = $item->{gid}; 127 } else { 128 delete $entry->{gid}; 129 } 130 } elsif ($< && $( =~ m/\b$entry->{gid}\b/) { 131 $entry->{gname} = "bin"; 132 delete $entry->{gid}; 133 } 134 $entry->recheck_owner; 135 if (!defined $entry->{uname}) { 136 $self->fatal("No user name for #1 (uid #2)", 137 $item->name, $entry->{uid}); 138 } 139 if (!defined $entry->{gname}) { 140 $self->fatal("No group name for #1 (gid #2)", 141 $item->name, $entry->{gid}); 142 } 143 # disallow writable files/dirs without explicit annotation 144 if (!defined $item->{mode}) { 145 $entry->{mode} &= ~(S_IWUSR|S_IWGRP|S_IWOTH); 146 } 147 # if we're going to set the group or owner, sguid bits won't 148 # survive the extraction 149 if (defined $item->{group} || defined $item->{owner}) { 150 $entry->{mode} &= ~(S_ISUID|S_ISGID); 151 } 152 if (defined $item->{ts}) { 153 delete $entry->{mtime}; 154 } 155 # likewise, we skip links on extractions, so hey, don't even care 156 # about modes and stuff. 157 if ($entry->isSymLink) { 158 $entry->{mode} = 0777; 159 $entry->{uid} = 0; 160 $entry->{gid} = 0; 161 $entry->{uname} = 'root'; 162 $entry->{gname} = 'wheel'; 163 } 164 165 $entry->set_name($item->name); 166 return $entry; 167} 168 1691; 170