:
#!/usr/bin/perl
# @(#) $Id: scotar.pl,v 1.3 1991/12/09 17:00:55 ronald Exp $
# (C) Copyright 1991 Ronald Khoo <ronald@ibmpcug.co.uk>
# Permission granted to do what you will with this program provided that
# the author be held harmless from any damage that may result from use of
# this program, that modifications be clearly marked, and that this notice
# be retained in all copies.
#
# SCO have an undocumented compressed tar format for installation packages
# where *individual* files are compressed in the tarfile, with a flag to
# instruct tar to decompress in-place on extraction.
# I don't seem to be able to find an option to tell tar to do the
# compression itself when *generating* these files
# (tar C will set the flag, but you must compress the files yourself)
# so I threw this script together to do it.  Yes, it's a gross hack,
# but it works well enough for putting custom format packages together.
# Error checking ? Hah! No such luck.
#
# usage is simple: feed it a list of files from stdin, and a tar image
# appears on stdout.  The "scovol" script may be of use in generating
# the input file list.  There's also builtin knowledge about ./tmp/_lbl
# files which need not exist -- they are created out of the aether.
# Also, ./etc/perms is magically renamed to ./tmp/perms and compression
# is suppressed for files under ./tmp so that you can use it on XENIX
# systems older than 2.3.4: just make sure you put a copy of zcat into
# ./tmp, and teach the init.* scripts to go through and uncompress the files.
#
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if 0;
die "Get a newer Perl\n" if $] < 3.044; # is this when checksums first made it?
$nullblock = "\0" x 512;
$S_IFREG   = 0100000;		# should be require 'sys/stat.h'
$temp = "/tmp/scotar$$";
# a PATH that includes where "compress" is found
$ENV{"PATH"}="/usr/local/bin:/bin:/usr/bin:/usr/ucb";
shift @ARGV if ($nocomp = ($ARGV[0] eq "-n"));

sub doit {
	local($name,$link) = (@_[0], '');
	local($dev,$ino,$mode,$uid,$gid,$size,$mtime)
		= (stat($name))[0,1,2,4,5,7,9];
	print STDERR $name;
	if ($name =~ m#./tmp/_lbl/#) {
		print STDERR " created\n";
		$mode = 444;
		$size = 0;
		$uid = $gid = 3;
		$mtime = time;
	} elsif (($mode & $S_IFREG) != $S_IFREG) {
		printf STDERR " skipped, mode = 0%o\n", $mode;
		return;
	}

	if ($seen{$name}++) {
		print STDERR " skipped, already seen\n";
		return;
	}
	if ($paths{"$dev:$ino"}) {
		print STDERR " linked to ", $paths{"$dev:$ino"}, "\n";
		$link = pack("a1a100", "1", $paths{"$dev:$ino"});
	} else {
		$paths{"$dev:$ino"} = $name;
		if ($nocomp || ( $name =~ m#\./(tmp|etc/perms)/#)) {
			$file = $name;
			$pack = "\0";
			print STDERR " added\n" unless $name =~ m#./tmp/_lbl/#;
		} else {
			system "compress < $name > $temp";
			if ($? == 0) {
				$osize = $size;
				$size = (stat($temp))[7];
				$file = $temp;
				$pack = '1';
				printf STDERR " %.2f%% compression\n",
					100 - (($size/$osize) * 100);
			} else {
				$file = $name;
				$pack = "\0";
				print STDERR " added\n";
			}
		}
	}
	$name =~ m#./etc/perms# && $name =~ s/etc/tmp/;
	$hdr =  pack("a100", $name);
	$hdr .= sprintf("%6o \0", $mode & 07777);
	$hdr .= sprintf("%6o \0", $uid);
	$hdr .= sprintf("%6o \0", $gid);
	$hdr .= sprintf("%11o ", $size);
	$hdr .= sprintf("%11o ", $mtime);
	$hdr .= " " x 8 . $link . $nullblock;
	$hdr = substr($hdr, 0, 512);
	substr($hdr, 277, 1) = $pack;
	$c = sprintf( "% 6o\0 ", unpack("%16C*", $hdr));
	substr($hdr, 148, 8) = $c;
	print $hdr;
	do {
		local($n);
		system '/bin/cat', $file;
		die unless $? == 0;
		(($n = 512 - ($size % 512)) < 512) &&
			print substr($nullblock, 0, $n);
	} unless $size == 0 || $link;
}

$| = 1;
while(<>) {
	chop;
	&doit($_);
}
print $nullblock;
unlink($temp);
