Category: Utility
Author/Contact Info Dmitri Tikhonov, dtikhonov@yahoo.com
Description: Filter to convert tarballs from ustar (POSIX) format to GNU format. This script was implemented because of wild differences in the way the two formats support filenames that are longer than 100 characters.

See also tar2ustar.

#
# 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 heade
+r
#
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} && !$oc
+tal;

        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;
        }
}
Replies are listed 'Best First'.
Re: ustar2tar
by myocom (Deacon) on Mar 19, 2001 at 21:34 UTC

    I can't help but think that this script and tar2ustar should perhaps be part of the same script (with behavior determined by a command line option, for example). It seems to me that if a person wanted to regularly convert from ustar to tar, they'd also want to do the reverse.

      You are right. Eventually I will do that. But these were just one-time scripts for me, so I did not bother. The two will not be difficult to merge, though.