# ex:ts=8 sw=4:
-# $OpenBSD: ArcCheck.pm,v 1.39 2023/05/16 16:45:04 espie Exp $
+# $OpenBSD: ArcCheck.pm,v 1.40 2023/05/16 16:55:32 espie Exp $
#
# Copyright (c) 2005-2006 Marc Espie <espie@openbsd.org>
#
sub is_allowed() { 0 }
# match archive header link name against actual link name
-sub check_linkname
+sub _check_linkname
{
my ($self, $linkname) = @_;
my $c = $self->{linkname};
return $c eq $linkname;
}
-sub errsay
+sub _errsay
{
my ($self, @args) = @_;
$self->{archive}{state}->errsay(@args);
$o->{cwd} = $item->cwd;
if (defined $item->{symlink} || $o->isSymLink) {
if (!defined $item->{symlink}) {
- $o->errsay("bogus symlink #1 -> #2",
+ $o->_errsay("bogus symlink #1 -> #2",
$item->name, $o->{linkname});
- $o->errsay("\t(no \@symlink annotation in packing-list)");
+ $o->_errsay("\t(no \@symlink annotation in packing-list)");
return 0;
}
if (!$o->isSymLink) {
- $o->errsay("bogus symlink #1 -> #2",
+ $o->_errsay("bogus symlink #1 -> #2",
$item->name, $item->{symlink});
- $o->errsay("\t(not a symlink in the tarball)");
+ $o->_errsay("\t(not a symlink in the tarball)");
return 0;
}
- if (!$o->check_linkname($item->{symlink})) {
- $o->errsay("archive symlink does not match #1 != #2",
+ if (!$o->_check_linkname($item->{symlink})) {
+ $o->_errsay("archive symlink does not match #1 != #2",
$o->{linkname}, $item->{symlink});
return 0;
}
} elsif (defined $item->{link} || $o->isHardLink) {
if (!defined $item->{link}) {
- $o->errsay("bogus hardlink #1 -> #2",
+ $o->_errsay("bogus hardlink #1 -> #2",
$item->name, $o->{linkname});
- $o->errsay("\t(no \@link annotation in packing-list)");
+ $o->_errsay("\t(no \@link annotation in packing-list)");
return 0;
}
if (!$o->isHardLink) {
- $o->errsay("bogus hardlink #1 -> #2",
+ $o->_errsay("bogus hardlink #1 -> #2",
$item->name, $item->{link});
- $o->errsay("\t(not a link in the tarball)");
+ $o->_errsay("\t(not a link in the tarball)");
return 0;
}
- if (!$o->check_linkname($item->{link})) {
- $o->errsay("archive hardlink does not match #1 != #2",
+ if (!$o->_check_linkname($item->{link})) {
+ $o->_errsay("archive hardlink does not match #1 != #2",
$o->{linkname}, $item->{link});
return 0;
}
} elsif ($o->isFile) {
if (!defined $item->{size}) {
- $o->errsay("Error: file #1 does not have recorded size",
+ $o->_errsay("Error: file #1 does not have recorded size",
$item->fullname);
return 0;
} elsif ($item->{size} != $o->{size}) {
- $o->errsay("Error: size does not match for #1",
+ $o->_errsay("Error: size does not match for #1",
$item->fullname);
return 0;
}
} else {
- $o->errsay("archive content for #1 should be file",
+ $o->_errsay("archive content for #1 should be file",
$item->name);
return 0;
}
return $o->verify_modes($item);
}
-sub strip_modes
+sub _strip_modes
{
my ($o, $item) = @_;
return $result;
}
-sub printable_mode
+sub _printable_mode
{
my $o = shift;
return sprintf("%4o",
if (!defined $item->{owner}) {
if ($o->{uname} ne 'root') {
- $o->errsay("Error: no \@owner for #1 (#2)",
+ $o->_errsay("Error: no \@owner for #1 (#2)",
$item->fullname, $o->{uname});
$result = 0;
}
}
if (!defined $item->{group}) {
if ($o->{gname} ne 'bin' && $o->{gname} ne 'wheel') {
- $o->errsay("Error: no \@group for #1 (#2)",
+ $o->_errsay("Error: no \@group for #1 (#2)",
$item->fullname, $o->{gname});
$result = 0;
}
}
# XXX /1
$o->{mode} &= ~(S_ISUID|S_ISGID);
- if ($o->{mode} != $o->strip_modes($o)) {
- $o->errsay("Error: weird mode for #1: #2", $item->fullname,
- $o->printable_mode);
+ if ($o->{mode} != $o->_strip_modes($o)) {
+ $o->_errsay("Error: weird mode for #1: #2", $item->fullname,
+ $o->_printable_mode);
$result = 0;
}
return $result;
$item->name, $entry->{gid});
}
# XXX /2
- $entry->{mode} = $entry->strip_modes($item) & ~(S_ISUID|S_ISGID);
+ $entry->{mode} = $entry->_strip_modes($item) & ~(S_ISUID|S_ISGID);
if (defined $item->{ts}) {
delete $entry->{mtime};
}
# ex:ts=8 sw=4:
-# $OpenBSD: Ustar.pm,v 1.93 2023/05/16 16:45:04 espie Exp $
+# $OpenBSD: Ustar.pm,v 1.94 2023/05/16 16:55:32 espie Exp $
#
# Copyright (c) 2002-2014 Marc Espie <espie@openbsd.org>
#
$self->{callback} = $code;
}
-sub fatal
+sub _fatal
{
my ($self, $msg, @args) = @_;
$self->{state}->fatal("Ustar [#1][#2]: #3",
$self->{state}->f($msg, @args));
}
-sub new_object
+sub _new_object
{
my ($self, $h, $class) = @_;
$h->{archive} = $self;
}
my $actual = read($self->{fh}, $temp, $toread);
if (!defined $actual) {
- $self->fatal("Error while skipping archive: #1", $!);
+ $self->_fatal("Error while skipping archive: #1", $!);
}
if ($actual == 0) {
- $self->fatal("Premature end of archive in header");
+ $self->_fatal("Premature end of archive in header");
}
$self->{swallow} -= $actual;
}
};
# helpers for the XHDR type
-sub read_records
+sub _read_records
{
my ($self, $size) = @_;
my $toread = $self->{swallow};
$maxread = $toread if $maxread > $toread;
my $actual = read($self->{fh}, $buffer, $maxread);
if (!defined $actual) {
- $self->fatal("Error reading from archive: #1", $!);
+ $self->_fatal("Error reading from archive: #1", $!);
}
if ($actual == 0) {
- $self->fatal("Premature end of archive");
+ $self->_fatal("Premature end of archive");
}
$self->{swallow} -= $actual;
$toread -= $actual;
return substr($result, 0, $size);
}
-sub parse_records
+sub _parse_records
{
my ($self, $result, $h) = @_;
open(my $fh, '<', \$h);
my $header;
my $n = read($self->{fh}, $header, 512);
return if (defined $n) and $n == 0;
- $self->fatal("Error while reading header")
+ $self->_fatal("Error while reading header")
unless defined $n and $n == 512;
if ($header eq "\0"x512) {
return $self->next;
$linkname, $magic, $version, $uname, $gname, $major, $minor,
$prefix, $pad) = unpack(USTAR_HEADER, $header);
if ($magic ne "ustar\0" || $version ne '00') {
- $self->fatal("Not an ustar archive header");
+ $self->_fatal("Not an ustar archive header");
}
# verify checksum
my $value = $header;
substr($value, 148, 8) = " "x8;
my $ck2 = unpack("%C*", $value);
if ($ck2 != oct($chksum)) {
- $self->fatal("Bad archive checksum");
+ $self->_fatal("Bad archive checksum");
}
$name =~ s/\0*$//o;
$mode = oct($mode) & 0xfff;
$self->{swallow} += 512 - $size % 512;
}
if ($type eq XHDR) {
- my $h = $self->read_records($size);
+ my $h = $self->_read_records($size);
$result = $self->next;
- $self->parse_records($result, $h);
+ $self->_parse_records($result, $h);
return $result;
}
if (defined $types->{$type}) {
- $self->new_object($result, $types->{$type});
+ $self->_new_object($result, $types->{$type});
} else {
- $self->fatal("Unsupported type #1 (#2)", $type,
+ $self->_fatal("Unsupported type #1 (#2)", $type,
$unsupported->{$type} // "unknown");
}
if (!$result->isFile && $result->{size} != 0) {
- $self->fatal("Bad archive: non null size for #1 (#2)",
+ $self->_fatal("Bad archive: non null size for #1 (#2)",
$types->{$type}, $result->{name});
}
}
# helper for prepare: ustar has strong limitations wrt directory/filename
-sub split_name
+sub _split_name
{
my $name = shift;
my $prefix = '';
}
# helper for prepare
-sub extended_record
+sub _extended_record
{
my ($k, $v) = @_;
my $string = " $k=$v\n";
}
}
-sub pack_header
+sub _pack_header
{
my ($archive, $type, $size, $entry, $prefix, $name, $linkname,
$uname, $gname, $major, $minor) = @_;
my $whatever = "usualSuspect000";
-sub mkheader
+sub _mkheader
{
my ($archive, $entry, $type) = @_;
- my ($prefix, $name) = split_name($entry->name);
+ my ($prefix, $name) = _split_name($entry->name);
my ($extendedname, $extendedlink);
my $linkname = $entry->{linkname};
my $size = $entry->{size};
$extendedlink = 1;
}
if (length $uname > MAXUSERNAME) {
- $archive->fatal("Username too long #1", $uname);
+ $archive->_fatal("Username too long #1", $uname);
}
if (length $gname > MAXGROUPNAME) {
- $archive->fatal("Groupname too long #1", $gname);
+ $archive->_fatal("Groupname too long #1", $gname);
}
- my $header = $archive->pack_header($type, $size, $entry,
+ my $header = $archive->_pack_header($type, $size, $entry,
$prefix, $name, $linkname, $uname, $gname, $major, $minor);
my $x;
if ($extendedname) {
- $x .= extended_record("path", $entry->name);
+ $x .= _extended_record("path", $entry->name);
}
if ($extendedlink) {
- $x .= extended_record("linkpath",$entry->{linkname});
+ $x .= _extended_record("linkpath",$entry->{linkname});
}
if ($x) {
- my $extended = $archive->pack_header(XHDR, length($x), $entry,
+ my $extended = $archive->_pack_header(XHDR, length($x), $entry,
'', $whatever, '', $uname, $gname, $major, $minor);
$whatever++;
if ((length $x) % 512) {
} elsif (-d _) {
$class = "OpenBSD::Ustar::Dir";
}
- $self->new_object($entry, $class);
+ $self->_new_object($entry, $class);
if (!$entry->isFile) {
$entry->{size} = 0;
}
return $entry;
}
-sub pad
+sub _pad
{
my $self = shift;
my $fh = $self->{fh};
- print $fh "\0"x1024 or $self->fatal("Error writing to archive: #1", $!);
+ print $fh "\0"x1024 or $self->_fatal("Error writing to archive: #1", $!);
}
sub close
{
my $self = shift;
if (defined $self->{padout}) {
- $self->pad;
+ $self->_pad;
}
close($self->{fh});
}
->lookup($entry->{gname});
}
-sub fatal
+sub _fatal
{
my ($self, @args) = @_;
- $self->{archive}->fatal(@args);
+ $self->{archive}->_fatal(@args);
}
-sub left_todo
+sub _left_todo
{
my ($self, $toread) = @_;
return if $toread == 0;
$self->{name} = $v;
}
-sub set_modes_on_object
+sub _set_modes_on_object
{
my ($self, $o) = @_;
chown $self->{uid}, $self->{gid}, $o;
}
}
-sub set_modes
+sub _set_modes
{
my $self = shift;
- $self->set_modes_on_object($self->fullname);
+ $self->_set_modes_on_object($self->fullname);
}
-sub ensure_dir
+sub _ensure_dir
{
my ($self, $dir) = @_;
return if -d $dir;
- $self->ensure_dir(File::Basename::dirname($dir));
+ $self->_ensure_dir(File::Basename::dirname($dir));
if (mkdir($dir)) {
return;
}
- $self->fatal("Error making directory #1: #2", $dir, $!);
+ $self->_fatal("Error making directory #1: #2", $dir, $!);
}
-sub make_basedir
+sub _make_basedir
{
my $self = shift;
my $dir = $self->{destdir}.File::Basename::dirname($self->name);
- $self->ensure_dir($dir);
+ $self->_ensure_dir($dir);
}
sub write
my $out = $arc->{fh};
$arc->{padout} = 1;
- my $header = $arc->mkheader($self, $self->type);
- print $out $header or $self->fatal("Error writing to archive: #1", $!);
+ my $header = $arc->_mkheader($self, $self->type);
+ print $out $header or $self->_fatal("Error writing to archive: #1", $!);
$self->write_contents($arc);
my $k = $self->{key};
if (!defined $arc->{key}{$k}) {
my $out = $wrarc->{fh};
$self->resolve_links($wrarc);
$wrarc->{padout} = 1;
- my $header = $wrarc->mkheader($self, $self->type);
- print $out $header or $self->fatal("Error writing to archive: #1", $!);
+ my $header = $wrarc->_mkheader($self, $self->type);
+ print $out $header or $self->_fatal("Error writing to archive: #1", $!);
$self->copy_contents($wrarc);
}
sub create
{
my $self = shift;
- $self->ensure_dir($self->fullname);
- $self->set_modes;
+ $self->_ensure_dir($self->fullname);
+ $self->_set_modes;
}
sub isDir() { 1 }
sub create
{
my $self = shift;
- $self->make_basedir;
+ $self->_make_basedir;
my $linkname = $self->{linkname};
if (defined $self->{cwd}) {
$linkname=$self->{cwd}.'/'.$linkname;
}
link $self->{destdir}.$linkname, $self->fullname or
- $self->fatal("Can't link #1#2 to #1#3: #4",
+ $self->_fatal("Can't link #1#2 to #1#3: #4",
$self->{destdir}, $linkname, $self->name, $!);
}
$self->{linkname} = $arc->{key}{$k};
} else {
print join("\n", keys(%{$arc->{key}})), "\n";
- $self->fatal("Can't copy link over: original for #1 NOT available", $k);
+ $self->_fatal("Can't copy link over: original for #1 NOT available", $k);
}
}
sub create
{
my $self = shift;
- $self->make_basedir;
+ $self->_make_basedir;
symlink $self->{linkname}, $self->fullname or
- $self->fatal("Can't symlink #1 to #2: #3",
+ $self->_fatal("Can't symlink #1 to #2: #3",
$self->{linkname}, $self->fullname, $!);
require POSIX;
POSIX::lchown($self->{uid}, $self->{gid}, $self->fullname);
sub create
{
my $self = shift;
- $self->make_basedir;
+ $self->_make_basedir;
require POSIX;
POSIX::mkfifo($self->fullname, $self->{mode}) or
- $self->fatal("Can't create fifo #1: #2", $self->fullname, $!);
- $self->set_modes;
+ $self->_fatal("Can't create fifo #1: #2", $self->fullname, $!);
+ $self->_set_modes;
}
sub isFifo() { 1 }
sub create
{
my $self = shift;
- $self->make_basedir;
+ $self->_make_basedir;
$self->{archive}{state}->system(OpenBSD::Paths->mknod,
'-m', $self->{mode}, '--', $self->fullname,
$self->devicetype, $self->{major}, $self->{minor});
- $self->set_modes;
+ $self->_set_modes;
}
sub isDevice() { 1 }
sub create
{
my $self = shift;
- $self->make_basedir;
+ $self->_make_basedir;
open(my $fh, '>', $self->fullname) or
- $self->fatal("Can't write to #1: #2", $self->fullname, $!);
+ $self->_fatal("Can't write to #1: #2", $self->fullname, $!);
$self->extract_to_fh($fh);
}
if ($self->{partial}) {
$toread -= length($self->{partial});
unless ($out->write($self->{partial})) {
- $self->fatal("Error writing to #1: #2",
+ $self->_fatal("Error writing to #1: #2",
$self->fullname, $!);
}
}
$maxread = $toread if $maxread > $toread;
my $actual = read($self->{archive}{fh}, $buffer, $maxread);
if (!defined $actual) {
- $self->fatal("Error reading from archive: #1", $!);
+ $self->_fatal("Error reading from archive: #1", $!);
}
if ($actual == 0) {
- $self->fatal("Premature end of archive");
+ $self->_fatal("Premature end of archive");
}
$self->{archive}{swallow} -= $actual;
unless ($out->write($buffer)) {
- $self->fatal("Error writing to #1: #2",
+ $self->_fatal("Error writing to #1: #2",
$self->fullname, $!);
}
$toread -= $actual;
- $self->left_todo($toread);
+ $self->_left_todo($toread);
}
- $self->set_modes_on_object($fh);
- $out->close or $self->fatal("Error closing #1: #2",
+ $self->_set_modes_on_object($fh);
+ $out->close or $self->_fatal("Error closing #1: #2",
$self->fullname, $!);
}
my $sz = $toread;
my $actual = read($self->{archive}{fh}, $buffer, $sz, $offset);
if (!defined $actual) {
- $self->fatal("Error reading from archive: #1", $!);
+ $self->_fatal("Error reading from archive: #1", $!);
}
if ($actual != $sz) {
- $self->fatal("Error: short read from archive");
+ $self->_fatal("Error: short read from archive");
}
$self->{archive}{swallow} -= $actual;
$toread -= $actual;
my $filename = $self->{realname};
my $size = $self->{size};
my $out = $arc->{fh};
- open my $fh, "<", $filename or $self->fatal("Can't read file #1: #2",
+ open my $fh, "<", $filename or $self->_fatal("Can't read file #1: #2",
$filename, $!);
my $buffer;
$maxread = $toread if $maxread > $toread;
my $actual = read($fh, $buffer, $maxread);
if (!defined $actual) {
- $self->fatal("Error reading from file: #1", $!);
+ $self->_fatal("Error reading from file: #1", $!);
}
if ($actual == 0) {
- $self->fatal("Premature end of file");
+ $self->_fatal("Premature end of file");
}
unless (print $out $buffer) {
- $self->fatal("Error writing to archive: #1", $!);
+ $self->_fatal("Error writing to archive: #1", $!);
}
$toread -= $actual;
- $self->left_todo($toread);
+ $self->_left_todo($toread);
}
if ($size % 512) {
print $out "\0" x (512 - $size % 512) or
- $self->fatal("Error writing to archive: #1", $!);
+ $self->_fatal("Error writing to archive: #1", $!);
}
}
$maxread = $toread if $maxread > $toread;
my $actual = read($self->{archive}{fh}, $buffer, $maxread);
if (!defined $actual) {
- $self->fatal("Error reading from archive: #1", $!);
+ $self->_fatal("Error reading from archive: #1", $!);
}
if ($actual == 0) {
- $self->fatal("Premature end of archive");
+ $self->_fatal("Premature end of archive");
}
$self->{archive}{swallow} -= $actual;
unless (print $out $buffer) {
- $self->fatal("Error writing to archive #1", $!);
+ $self->_fatal("Error writing to archive #1", $!);
}
$toread -= $actual;
}
if ($size % 512) {
print $out "\0" x (512 - $size % 512) or
- $self->fatal("Error writing to archive: #1", $!);
+ $self->_fatal("Error writing to archive: #1", $!);
}
$self->alias($arc, $self->name);
}