explicitly rename internal methods with an _
authorespie <espie@openbsd.org>
Tue, 16 May 2023 16:55:32 +0000 (16:55 +0000)
committerespie <espie@openbsd.org>
Tue, 16 May 2023 16:55:32 +0000 (16:55 +0000)
usr.sbin/pkg_add/OpenBSD/ArcCheck.pm
usr.sbin/pkg_add/OpenBSD/Ustar.pm

index d267af6..7c72aba 100644 (file)
@@ -1,5 +1,5 @@
 # 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>
 #
@@ -43,7 +43,7 @@ use POSIX;
 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};
@@ -53,7 +53,7 @@ sub check_linkname
        return $c eq $linkname;
 }
 
-sub errsay
+sub _errsay
 {
        my ($self, @args) = @_;
        $self->{archive}{state}->errsay(@args);
@@ -66,59 +66,59 @@ sub validate_meta
        $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) = @_;
 
@@ -147,7 +147,7 @@ sub strip_modes
        return $result;
 }
 
-sub printable_mode
+sub _printable_mode
 {
        my $o = shift;
        return sprintf("%4o", 
@@ -161,23 +161,23 @@ sub verify_modes
 
        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;
@@ -246,7 +246,7 @@ sub prepare_long
                    $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};
        }
index 253c2b3..bb958cb 100644 (file)
@@ -1,5 +1,5 @@
 # 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>
 #
@@ -88,7 +88,7 @@ sub set_callback
        $self->{callback} = $code;
 }
 
-sub fatal
+sub _fatal
 {
        my ($self, $msg, @args) = @_;
        $self->{state}->fatal("Ustar [#1][#2]: #3",
@@ -96,7 +96,7 @@ sub fatal
            $self->{state}->f($msg, @args));
 }
 
-sub new_object
+sub _new_object
 {
        my ($self, $h, $class) = @_;
        $h->{archive} = $self;
@@ -117,10 +117,10 @@ sub skip
                }
                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;
        }
@@ -145,7 +145,7 @@ my $unsupported = {
 };
        
 # helpers for the XHDR type
-sub read_records
+sub _read_records
 {
        my ($self, $size) = @_;
        my $toread = $self->{swallow};
@@ -156,10 +156,10 @@ sub read_records
                $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;
@@ -168,7 +168,7 @@ sub read_records
        return substr($result, 0, $size);
 }
 
-sub parse_records
+sub _parse_records
 {
        my ($self, $result, $h) = @_;
        open(my $fh, '<', \$h);
@@ -193,7 +193,7 @@ sub next
        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;
@@ -203,14 +203,14 @@ sub 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;
@@ -254,19 +254,19 @@ sub next
                $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});
        }
 
@@ -275,7 +275,7 @@ sub next
 }
 
 # helper for prepare: ustar has strong limitations wrt directory/filename
-sub split_name
+sub _split_name
 {
        my $name = shift;
        my $prefix = '';
@@ -293,7 +293,7 @@ sub split_name
 }
 
 # helper for prepare
-sub extended_record
+sub _extended_record
 {
        my ($k, $v) = @_;
        my $string = " $k=$v\n";
@@ -307,7 +307,7 @@ sub extended_record
        }
 }
 
-sub pack_header
+sub _pack_header
 {
        my ($archive, $type, $size, $entry, $prefix, $name, $linkname, 
                $uname, $gname, $major, $minor) = @_;
@@ -338,10 +338,10 @@ sub pack_header
 
 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};
@@ -386,22 +386,22 @@ sub mkheader
                $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) {
@@ -453,25 +453,25 @@ sub prepare
        } 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});
 }
@@ -509,13 +509,13 @@ sub recheck_owner
            ->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;
@@ -541,7 +541,7 @@ sub set_name
        $self->{name} = $v;
 }
 
-sub set_modes_on_object
+sub _set_modes_on_object
 {
        my ($self, $o) = @_;
        chown $self->{uid}, $self->{gid}, $o;
@@ -551,28 +551,28 @@ sub set_modes_on_object
        }
 }
 
-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
@@ -582,8 +582,8 @@ 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}) {
@@ -622,8 +622,8 @@ sub copy
        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);
 }
@@ -642,8 +642,8 @@ our @ISA=qw(OpenBSD::Ustar::Object);
 sub create
 {
        my $self = shift;
-       $self->ensure_dir($self->fullname);
-       $self->set_modes;
+       $self->_ensure_dir($self->fullname);
+       $self->_set_modes;
 }
 
 sub isDir() { 1 }
@@ -656,13 +656,13 @@ our @ISA=qw(OpenBSD::Ustar::Object);
 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, $!);
 }
 
@@ -675,7 +675,7 @@ sub resolve_links
                $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);
        }
 }
 
@@ -690,9 +690,9 @@ our @ISA=qw(OpenBSD::Ustar::Object);
 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);
@@ -709,11 +709,11 @@ our @ISA=qw(OpenBSD::Ustar::Object);
 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 }
@@ -725,11 +725,11 @@ our @ISA=qw(OpenBSD::Ustar::Object);
 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 }
@@ -822,9 +822,9 @@ our @ISA=qw(OpenBSD::Ustar::Object);
 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);
 }
 
@@ -837,7 +837,7 @@ sub extract_to_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, $!);
                }
        }
@@ -846,22 +846,22 @@ sub extract_to_fh
                $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, $!);
 }
 
@@ -881,10 +881,10 @@ sub contents
                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;
@@ -901,7 +901,7 @@ sub write_contents
        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;
@@ -911,21 +911,21 @@ sub write_contents
                $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", $!);
        }
 }
 
@@ -941,21 +941,21 @@ sub copy_contents
                $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);
 }