#
# 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;
        }
}

[download]

In reply to ustar2tar by dmitri

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.