#!/usr/local/bin/perl
#
# print out a table of contents for a tar file
#
# pat@jaameri.gsfc.nasa.gov (patrick m. ryan)
#

eval "exec /usr/bin/perl -S $0 $*"
    if $running_under_some_shell;

require 'getopts.pl';
require 'ctime.pl';

&Getopts('vd');			# v == verbose, d == debug

if ($opt_d) { $debug=1; }

$tar_header =
    join(' ',
	 ("a100".		# name
	  "a8".			# mode
	  "a8".			# uid
	  "a8".			# gid
	  "a12".		# size
	  "a12".		# mtime
	  "a8".			# chksum
	  "a1".			# linkflag
	  "a100".		# linkname
	  "a8".			# magic
	  "a32".		# uname
	  "a32".		# gname
	  "a8".			# devmajor
	  "a8"));		# devminor

$tblock = 512;

$fname=shift;
open(F,"<$fname") ||
    die "$fname: no such file; stopped";


while (sysread(F,$_,$tblock))
{
    if (/^\0+$/) { last; }	# tar EOF
    
    ($name,$mode,$uid,$gid,$size,$mtime,$chksum,$linkflag,$linkname,$magic,
     $uname,$gname,$devmajor,$devminor) = unpack($tar_header,$_);
    
    $uid = oct($uid);
    $gid = oct($gid);
    $mode = oct($mode);
    $size = oct($size);
    $mtime = oct($mtime);
    $chksum = oct($chksum);
    $linkflag = oct($linkflag);
    chop($c=&ctime($mtime));
    
    ##printf "%5d/%5d ",$uid,$gid;
    $login_name = getpwuid($uid);
    if ($login_name) {
	printf "%8s/",$login_name;
    } else {
	printf "%8d/",$uid;
    }
    $group_name = getgrgid($gid);
    if ($group_name) {
	printf "%-8s",$group_name;
    } else {
	printf "%8d",$gid;
    }
    printf "%7d ",$size;
    print $c," ";
    print "$name";
    print "\n";
    
    if ($opt_v)
    {
	printf "mode     = %04o\n",$mode;
	print "uid      = $uid\n";
	print "gid      = $gid\n";
	print "size     = $size\n";
	print "mtime    = $c ($mtime)\n";
	print "chksum   = $chksum\n";
	if ($linkflag)
	{
	    print "linkflag = $linkflag\n";
	    print "linkname = $linkname\n";
	}
	if ($magic =~ /^ustar/)
	{
	    print "uname    = $uname\n";
	    print "gname    = $gname\n";
	}
#	    if ($devmajor !~ /^\s+$/)
#	      {
#		  print "devmajor = $devmajor\n";
#		  print "devminor = $devminor\n";
#	      }
    }
    
    $nblocks = int($size / $tblock);
    $extra = $size % $tblock;
    
    if ($extra) { $nblocks += 1; }
    $off = $nblocks * $tblock;
    seek(F,$off,1);		# skip to the next file
    
}

exit 0;
    
# Local Variables:
# mode: perl
# End: