ArcCheck.pm revision 1.21
1# ex:ts=8 sw=4: 2# $OpenBSD: ArcCheck.pm,v 1.21 2011/01/02 15:25:45 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 1 if $self->name eq $item->name; 36 if ($self->name =~ m/^LongName\d+$/o) { 37 $self->set_name($item->name); 38 return 1; 39 } 40 return 0; 41} 42 43# match archive header link name against actual link names 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 1 if $c eq $linkname; 52 if ($self->{linkname} =~ m/^Long(?:Link|Name)\d+$/o) { 53 $self->{linkname} = $linkname; 54 if ($self->isHardLink && defined $self->{cwd}) { 55 $self->{linkname} =~ s|^$self->{cwd}/||; 56 } 57 return 1; 58 } 59 return 0; 60} 61 62use POSIX; 63 64sub verify_modes 65{ 66 my ($o, $item) = @_; 67 my $result = 1; 68 69 if (!defined $item->{owner} && !$o->isSymLink) { 70 if ($o->{uname} ne 'root' && $o->{uname} ne 'bin') { 71 $o->errsay("Error: no \@owner for #1 (#2)", 72 $item->fullname, $o->{uname}); 73 $result = 0; 74 } 75 } 76 if (!defined $item->{group} && !$o->isSymLink) { 77 if ($o->{gname} ne 'bin' && $o->{gname} ne 'wheel') { 78 if (($o->{mode} & (S_ISUID | S_ISGID | S_IWGRP)) != 0) { 79 $o->errsay("Error: no \@group for #1 (#2), which has mode #3", 80 $item->fullname, $o->{uname}, 81 sprintf("%4o", $o->{mode} & (S_IRWXU | S_IRWXG | S_IRWXO | S_ISUID | S_ISGID))); 82 $result = 0; 83 } else { 84 $o->errsay("Warning: no \@group for #1 (#2)", 85 $item->fullname, $o->{gname}); 86 } 87 } 88 } 89 if (!defined $item->{mode} && $o->isFile) { 90 if (($o->{mode} & (S_ISUID | S_ISGID | S_IWOTH)) != 0) { 91 $o->errsay("Error: weird mode for #1: #2", 92 $item->fullname, 93 sprintf("%4o", $o->{mode} & (S_IRWXU | S_IRWXG | S_IRWXO | S_ISUID | S_ISGID))); 94 $result = 0; 95 } 96 } 97 return $result; 98} 99 100# copy long items, avoiding duplicate long names. 101sub copy_long 102{ 103 my ($self, $wrarc) = @_; 104 if ($self->name =~ m/^LongName(\d+)$/o) { 105 $wrarc->{name_index} = $1 + 1; 106 } 107 if (length($self->name) > 108 OpenBSD::Ustar::MAXFILENAME + OpenBSD::Ustar::MAXPREFIX + 1) { 109 $wrarc->{name_index} = 0 if !defined $wrarc->{name_index}; 110 $self->set_name('LongName'.$wrarc->{name_index}++); 111 } 112 $self->copy($wrarc); 113} 114 115package OpenBSD::Ustar; 116 117# prepare item and introduce long names where needed. 118sub prepare_long 119{ 120 my ($self, $item) = @_; 121 my $entry; 122 if (defined $item->{wtempname}) { 123 $entry = $self->prepare($item->{wtempname}, ''); 124 } else { 125 $entry = $self->prepare($item->name); 126 } 127 if (!defined $entry->{uname}) { 128 $self->fatal("No user name for #1 (uid #2)", 129 $item->name, $entry->{uid}); 130 } 131 if (!defined $entry->{gname}) { 132 $self->fatal("No group name for #1 (uid #2)", 133 $item->name, $entry->{gid}); 134 } 135 136 $entry->set_name($item->name); 137 my ($prefix, $name) = split_name($entry->name); 138 if (length($name) > MAXFILENAME || length($prefix) > MAXPREFIX) { 139 $self->{name_index} = 0 if !defined $self->{name_index}; 140 $entry->set_name('LongName'.$self->{name_index}++); 141 } 142 if ((defined $entry->{linkname}) && 143 length($entry->{linkname}) > MAXLINKNAME) { 144 $self->{linkname_index} = 0 if !defined $self->{linkname_index}; 145 $entry->{linkname} = 'LongLink'.$self->{linkname_index}++; 146 } 147 return $entry; 148} 149 1501; 151