#!/usr/bin/perl
#
# ustar: Perl script to convert tar command line to pax
#
# Author: Tony Sanders <sanders@bsdi.com>
# Date: Jan 11 1993
# Version: 1.0
# Free software; you may redistribute and/or modify this program.
#
# ustar [-]{crtux}[bBefhmpv] [tarfile] [blocksize] [pax_flags] files...
#     c = create new tarfile
#     r = append files to tarfile
#     t = table of contents
#     u = update tarfile (add files if not in archive or have changed)
#     x = extract named files
#
#     b = set blocking factor (requires blocksize arg)
#     B = force blocking, ignored
#     e = exit on error
#     f = tarfile name (requires tarfile argument) default is $TAPE
#     h = follow symlinks as if they were normal files or directories
#     m = set modification time of extracted files to time extracted
#     p = preserve file permissions etc.
#     v = verbose
#
# Ignored (warnings):
#     i = ignore directory checksum errors
#     o = suppress archiving information about owner and modes
#
# Unsupported (fatal errors):
#     l = print error messages if all links to archived files no resolved
#     w = wait for confirmation
#     F = filter dirs named SCCS, FF = filter SCCS, *.o, errs, core, a.out
#     X = specify exclude file (containing list of files to be excluded)
#     014578 = specify device
#     -Cdir = chdir
#     -Ifile = open file and read list of filenames from it (opposit of -X)
#
# Assortment of pax options (see pax(1) for details):
#     -c = match all members except those specified by operands
#     -d = extract directory only (not recursive)
#     -k = prevent overwriting of existing files
#     -s /old/new/[gp] = apply substitution on member names
#     -t = don't update access times on files read by pax
#     -C records = Limit number of records written per volume
#     -T from to = select files based on modification time [yy[mm[dd[hh]]]]m[.ss]
#     -X = don't cross device boundries
# 
# Examples:
#       ustar cvf tarfile files...  -> pax -x ustar -wvf tarfile files...
#       ustar rvf tarfile files...  -> pax -wavf tarfile files...
#       ustar tvf tarfile           -> pax -vf tarfile
#       ustar uvf tarfile files...  -> pax -wuf tarfile files...
#       ustar xvf tarfile files...  -> pax -rvf tarfile files...
#       ustar cvf tarfile -X -s ',^/var,,' /   backup / except for /var
#

eval '&doit';			# only returns if error
print STDERR $@ if $@;
die "Usage: ustar [-]{crtux}[bBefhmpv] [tarfile] [blocksize] [pax_flags] files...\n";

sub tarfile {
    die "Tarfile expected\n" unless ($tarfile = shift @ARGV);
}
sub blocksize {
    die "Block size expected\n" unless ($blocksize = shift @ARGV);
    die "Invalid block size specification $blocksize\n"
        unless $blocksize =~ /^[0-9]+[kb]{0,1}/;
    $blocksize =~ /[kK]$/ && $blocksize *= 1024;
    $blocksize =~ /[bB]$/ && $blocksize *= 512;
    warn "Block size larger than POSIX.2 max: 32256\n" if $blocksize > 32256;
}
sub mode {
    die "Only one of [ctrux] allowed: -$mode conflicts with -$a\n" if $mode;
    $mode = $a;
}
sub ignored { warn "option -$a is ignored\n"; }
sub unsupported { die "option -$a is unsuppored\n"; }
sub doit {
    return if $#ARGV < 0;

    $args = shift @ARGV;        		# option cluster
    @option_stack = ();				# eval'ed to parse options
    $mode = undef;              		# one of crtux
    $tarfile = $ENV{'TAPE'} || '-';		# default $TAPE or stdio
    $blocksize = 10*1024;                       # default blocksize (POSIX.2)

    # we read the options backwards with chop and shift argument
    # processors onto @option_stack which gets eval'ed later to read
    # the options (like for tarfile and blocksize).
    arg:
    while ($a = (chop $args)) {
        $a eq 'n' && do { $nflag++; next arg; };         # just print pax cmd
        $a eq '-' && do { next arg; };

        $a eq 'c' && do { &mode; $cmd = "pax -w -x ustar"; next arg; };
        $a eq 'r' && do { &mode; $cmd = "pax -wa";         next arg; };
        $a eq 't' && do { &mode; $cmd = "pax";             next arg; };
        $a eq 'u' && do { &mode; $cmd = "pax -wu";         next arg; };
        $a eq 'x' && do { &mode; $cmd = "pax -r";	   next arg; };

        $a eq 'b' && do { unshift(@option_stack, '&blocksize;'); next arg; };
        $a eq 'B' && do { next arg; };          	# ignored
        $a eq 'e' && do { $eflag++; next arg; };	# exit on error
        $a eq 'f' && do { unshift(@option_stack, '&tarfile;'); next arg; };
        $a eq 'h' && do { $hflag++; next arg; };        # follow symlinks
        $a eq 'i' && do { &ignored; next arg; };	# ignore checksum errors
        $a eq 'l' && do { &unsupported; next arg; };	# resolve all links
        $a eq 'm' && do { $mflag++; next arg; };	# extract mtime
        $a eq 'o' && do { &ignored; next arg; };	# suppress owner and modes
        $a eq 'p' && do { $pflag++; next arg; };	# extract owner and modes
        $a eq 'v' && do { $vflag++; next arg; };        # verbose
        $a eq 'w' && do { &unsupported; next arg; };	# wait for confirmation

	$a eq 'F' && do { &unsupported; };
	$a eq 'X' && do { &unsupported; };
	$a =~ /\d/ && do { &unsupported; };
        die "Invalid option ``$a''\n";
    }

    if (@flist = grep(/^-[CI]/, @ARGV)) {
	die "Invalid filename specification: @flist\n" 
    }

    $mode || die "No mode selected, pick one of crtux\n";

    $pflag && ($perms = "e");		# extract everything
    $mflag && ($perms .= "am");		# if -m then subtract a and m
    $mode eq 'x' && $perms && $cmd .= " -p $perms";

    $vflag && $cmd .= " -v";
    $eflag && $cmd .= " -E 0";
    $hflag && $cmd .= " -L";

    # process options off the stack
    foreach (@option_stack) { eval $_; die $@ if $@; }

    # only need blocksize on create
    $mode eq 'c' && $cmd .= " -b $blocksize";

    # - means stdin/stdout
    $tarfile ne '-' && $cmd .= " -f $tarfile";

    # command line arguments
    $cmd .= " " . join(' ', @ARGV);

    print STDERR $cmd,"\n";

    $nflag ? exit(0) : exec($cmd);
}
