#
# this program converts tar files from ustar format to old format.
#
# author: Dmitri
#
# $Id: ustar2tar,v 1.1 2001/03/15 13:20:44 dmitri Exp $
#
# $Log: ustar2tar,v $
# Revision 1.1  2001/03/15 13:20:44  dmitri
# Filter that does the opposite of what tar2ustar does.  It is needed to feed
# tar files to smbclient.
#

use integer;
use strict;

my $block;
my $blocksize = 512;
my $blknum = 0;

my %info = (
        name => { length => 100, offset => 0, octal => 0},
        mode => { length => 8, offset => 100, octal => 1},
        uid => { length => 8, offset => 108, octal => 1},
        gid => { length => 8, offset => 116, octal => 1},
        size => { length => 12, offset => 124, octal => 1},
        mtime => { length => 12, offset => 136, octal => 1},
        chksum => { length => 8, offset => 148, octal => 1},
        link => { length => 1, offset => 156, octal => 0},
        linkname => { length => 100, offset => 157, octal => 0}
        );


#
# run checksum on the block, return the modified and ready-to-go header
#
sub checksum {
        my ($block) = @_;
        my $chksum = 0;

        substr $block, 148, 8, '        ';

        for (split '', $block) { $chksum += ord }
        $chksum = sprintf("%o%c ", $chksum, 0);
        $chksum = ' 'x(8 - length($chksum)) . $chksum;

        substr $block, 148, 8, $chksum;

        return $block;
}


#
# return size of file, as found in header
#
sub size {
        my ($block) = @_;
        my $size = substr $block, 124, 12;
        $size =~ s/[ \000]//g;
        return oct $size;
}


#
# return empty block
#
sub empty_block {
        return sprintf("%c" x 512, 0);
}


#
# set specified field to the specified value
#
# if $octal is true, then $value is already in octal and no conversion is
# needed
#
sub set_field {
        my ($block, $fname, $value, $octal) = @_;

        $value = sprintf("%o", $value) if $info{$fname}{octal} && !$octal;

        if ($info{$fname}{octal}) {
                $value = " "x($info{$fname}{length} - length($value)).
                         $value;
        } else {
                $value = $value .
                         sprintf(
                         "%c"x($info{$fname}{length} - length($value)), 0);
        }

        substr $block, $info{$fname}{offset}, $info{$fname}{length}, $value;

        return $block;
}

sub parse_block {
        my ($block) = @_;

        return $block if 0 == ord substr $block, 0, 1;

        my $size = size $block;

        $blknum += 1 + $size / 512;
        ++$blknum if $size % 512 != 0;

        if (0 != ord substr $block, 345, 1) {
                my $prefix = substr $block, 345;
                $prefix =~ s/\000.*$//;
                my $name = substr $block, 0, 100;
                $name =~ s/\000.*$//;

                $name = $prefix . "/" . $name;
                $name =~ s|^/|\./|;     # no absolute filenames

                my $block_1 = empty_block;
                $block_1 = set_field $block_1, "name", '././@LongLink';
                $block_1 = set_field $block_1, "mode", "0 ".sprintf("%c", 0), 1;
                $block_1 = set_field $block_1, "uid", "0 ".sprintf("%c", 0), 1;
                $block_1 = set_field $block_1, "gid", "0 ".sprintf("%c", 0), 1;
                $block_1 = set_field $block_1, "size", sprintf("%o", (length($name)))." ", 1;
                $block_1 = set_field $block_1, "mtime", "0";
                $block_1 = set_field $block_1, "link", "L";
                substr $block_1, 257, 7, "ustar  ";
                $block_1 = checksum $block_1;

                my $block_2 = empty_block;
                substr $block_2, 0, length($name), $name;

                my $block_3 = $block;
                substr $block_3, 0, 100, substr($name, 0, 99).sprintf("%c", 0);
                substr $block_3, 345, 155, sprintf("%c", 0) x 155;
                substr $block_3, 257, 7, "ustar  ";
                $block_3 = checksum $block_3;

                return $block_1 . $block_2 . $block_3;
        } else {
                substr $block, 257, 7, "ustar  ";
                if ($block =~ m|^/|) {
                        $block = "." . $block;
                        substr $block, 100, 1, '';
                }
                        
                return checksum $block;
        }
}
        

for (my $i = 0; read(STDIN, $block, $blocksize); ++$i) {
        if ($blknum == $i) {
                # if header block, convert.
                print parse_block $block;
        } else {
                print $block;
        }
}