[603] in Info-AFS_Redistribution
pckg
daemon@ATHENA.MIT.EDU (Daniel Edward Lovinger)
Wed Feb 12 18:16:44 1992
Date: Wed, 12 Feb 1992 16:52:28 -0500 (EST)
From: Daniel Edward Lovinger <dl2n+@andrew.cmu.edu>
To: Info-AFS@transarc.com
Pckg is a perl script that generates a package description for
a tree of files - most notably an OS tree (what we use it for here).
It'll also do the right thing if you point it at /dev or similar.
Some may remember a while back I posted a pair of scripts
pckg-tree and dev-tree. Please kill them. I wrote 'em before I learned
Perl and it shows ... pckg does everything they did and more. In
particular:
* will resolve symbolic links inside of a tree properly (it
must be able to figure out the OS tree root to be useful - see
the comments)
* will resolve hard links in the OS tree into symbolic links
for package
* gets major/minor right on systems that use a longword for
devices (like AIX)
* uses cached stat information (_)
* is waaay faster (I calculated a 30x speedup)
Reference: it did our entire SunOS 4.1.1a tree from AFS w/
nothing particular in the cache (~150 megs) in 21 minutes flat on a
Sparc IPX. Fast.
Let me know if you find it useful ...
Dan Lovinger Computing & Communications Carnegie Mellon U.
Internet: dl2n+@andrew.cmu.edu Bitnet: dl2n+%andrew.cmu.edu@carnegie
"... and in the stillness, they heard the cry of the golden banana ..."
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 1)."
# Contents: pckg
# Wrapped by dl2n@freehold.andrew.cmu.edu on Wed Feb 12 16:49:40 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f pckg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"pckg\"
else
echo shar: Extracting \"pckg\" \(5157 characters\)
sed "s/^X//" >pckg <<'END_OF_pckg'
X#!/usr/local/bin/perl
X
X# pckg - generate a package description of a filesystem tree
X#
X# requires Perl 4.x (possibly 4.10 or greater)
X#
X# usage:
X# pckg [directory]
X#
X# local andrew.cmu.edu caveats:
X#
X# We have the convention of an OS tree, which is an image
X# of the vendor supplied OS from / on down. It resides on
X# AFS, and via package we can selectively link or copy
X# files across. This script is designed to create a complete
X# package description for an OS tree, which can then be edited
X# down for local purposes.
X#
X# Here, we mount OS trees as
X#
X# /afs/andrew.cmu.edu/@sys/os
X#
X# pckg will attempt to discover where the root of the OS tree that you
X# point it at is. If you do not use .../os, you will need to modify how
X# it pulls apart $ARGV[0] to get it right for your purposes. If it does
X# not think you've pointed it at an OS tree, it will just generate. This
X# is useful for creating package descriptions for /dev ala
X#
X# pckg /dev
X#
X# We also have the convention of the mpp macro ${machine} which will
X# resolve to the start of the appropriate OS tree. Again, you may
X# want to change it for local use. Another convention is that we
X# tend to map most ownerships down to root/wheel. If pckg cannot
X# figure out who owns the file (in the case that some vendor shipped
X# things owned by some bizzare userid), it will render the user down
X# to root and groups down to wheel. This may not suit all, but is
X# easy to change in the code.
X#
X# Obplug: please look around /afs/andrew.cmu.edu/wsadmin/lib to see how
X# we do things after six years of dealing with package. It may provide
X# some ideas. wsadmin/public/src/public.proto is used by mpp (ignore
X# the public.@sys files)
X#
X# general notes:
X# since package cannot handle hard links, pckg will turn them into
X# symbolic ones on the fly.
X
X# TODO
X# pretty output? mondo difficult in finite horizontal space
X# lookup table of type/owner/group/perm for ${magicmode}
X# be able to specify a trim table so /usr/man isn't traversed, etc.
X
X# force flushes
Xselect(STDOUT);
X$| = 1;
X
X($os_tree, $start_dir) = $ARGV[0] =~ /(.*os)(.*$)/;
X
Xif (! defined $os_tree) {
X $os_tree = "";
X $start_dir = $ARGV[0];
X}
X
X&traverse($start_dir);
X
Xsub traverse {
X local($dir)=@_;
X local($d);
X local(%inoar) = ();
X local(@dircache) = ();
X
X $rdir= $os_tree . $dir;
X
X opendir(DIR, $rdir);
X local(@dir) = readdir(DIR);
X closedir(DIR);
X
X foreach $d (@dir) {
X next if ($d eq "." || $d eq "..");
X
X $file = "$dir/$d";
X $rfile = "$os_tree$file";
X
X ($mydev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
X $atime, $mtime, $ctime, $blksize, $blocks)
X = lstat($rfile);
X
X # optimization!
X if ($uid == 0) {
X $oname = "root";
X } else {
X ($oname) = getpwuid($uid); # sloooow
X }
X ($gname) = getgrgid($gid);
X $mode = $mode & 0007777;
X
X # just in case, handle unknown users/groups
X $oname = "root" if ($oname eq "");
X
X #or common translations
X $gname = "wheel" if ($gname eq "" || $gname eq "staff");
X
X # symlinks
X if (-l _)
X {
X $link = readlink($rfile);
X
X @linkar = split(/\//, $link);
X
X # don't do anything with an absolute link
X if ($linkar[0] ne "") {
X $up = 0;
X # rip off "." and ".." counting ".."s in $up
X while (1) {
X # link to ./something - rip off ./
X if ($linkar[0] eq ".") {
X shift(@linkar);
X next;
X }
X if ($linkar[0] eq "..") {
X shift(@linkar);
X $up++;
X next;
X }
X #drop out when we have no .|..
X last;
X }
X
X @dirar = split(/\//, $dir);
X while ($up--) {
X #rip from bottom this time
X pop(@dirar);
X }
X
X $link = join('/', @dirar, @linkar);
X if ($#dirar == -1) {
X #link went above /. odd, but legal
X $link = "/$link";
X }
X }
X printf("LA\t%s\t\t%s", $file, $link);
X printf("\t%s %s %o\n", $oname, $gname, $mode);
X next;
X }
X
X # device entry
X if (-b _ || -c _) {
X # some systems use longwords - detect
X if ($rdev & 0xffff0000) {
X $major_dev = ($rdev >> 16) & 0x0000ffff;
X $minor_dev = ($rdev) & 0x0000ffff;
X } else {
X $major_dev = ($rdev >> 8) & 0x000000ff;
X $minor_dev = ($rdev) & 0x000000ff;
X }
X
X if (-b _) {
X print("B\t");
X } else {
X print("C\t");
X }
X
X printf("%s\t%d\t%d\t%s %s %o\n", $rfile,
X $major_dev, $minor_dev,
X $oname, $gname, $mode);
X next;
X }
X
X # make hard links into symbolic links
X # (package can't do hard links - sigh)
X if (defined $inoar{$ino}) {
X printf("LA\t%s\t\t%s", $file, $inoar{$ino});
X printf("\t%s %s %o\n", $oname, $gname, $mode);
X next;
X }
X
X # cache directory entries do we don't get huge %inoar wastage
X if (-d _)
X {
X push(@dircache, join('\\', $file, $oname,
X $gname, $mode));
X next;
X }
X
X # has hard links to it
X if ($nlink > 1) {
X $inoar{$ino} = $file;
X }
X
X # normal files
X if (-f _)
X {
X printf("F\t%s\t\t%s", $file, '${machine}');
X printf("\t%s %s %o\n", $oname, $gname, $mode);
X next;
X }
X }
X
X # clear inode array
X %inoar = ();
X
X # now traverse directories
X for (@dircache) {
X ($file, $oname, $gname, $mode) = split(/\\/);
X printf("DR\t%s\t\t\t\t%s %s %o\n",$file,$oname,$gname,$mode);
X &traverse($file);
X }
X
X # clear directory cache
X @dircache = ();
X}
X
END_OF_pckg
if test 5157 -ne `wc -c <pckg`; then
echo shar: \"pckg\" unpacked with wrong size!
fi
chmod +x pckg
# end of overwriting check
fi
echo shar: End of archive 1 \(of 1\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 1 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
