#
# this program converts file names in tar files.
#
# author: Dmitri
#
# $Id: tar-conv,v 1.1 2001/03/12 11:57:02 dmitri Exp $
#
# $Log: tar-conv,v $
# Revision 1.1  2001/03/12 11:57:02  dmitri
# This is a filter that modifies pathnames in tar files produced by
# smbclient's evil tar command.
#

use integer;
use strict;

my $block;
my $blocksize = 512;
my $blknum = 0;
my $url = $ARGV[0];

$url =~ s|^/*.+?/+.+?/+||;
$url =~ s|/*[^/]+/*$||;


sub checksum {
        my ($block) = @_;
        my $chksum = 0;

        substr $block, 148, 8, '        ';

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

        substr $block, 148, 8, $chksum;

        return $block;
}


sub make_short_block {
        my ($retval) = @_;
        my ($block, $filename, $diff);

        read(STDIN, $block, $blocksize);
        ($filename = $block) =~ s|^\./($url/)|\./|i;
        $filename =~ s/\000*$//;

        $filename =  $filename . sprintf("%c"x(100 - length $filename)
+, 0);

        read(STDIN, $block, $blocksize);
        substr $block, 0, 100, $filename;
        $retval = checksum $block;

        my $size = substr $retval, 124, 10;
        $blknum += $size/$blocksize + 1 + ($size%$blocksize ? 1 : 0);

        return $retval;
}


sub make_long_block {
        my ($retval) = @_;
        my ($block, $filename, $diff);

        read(STDIN, $block, $blocksize);
        ($filename = $block) =~ s|^\./($url/)|\./|i;

        $filename =  $filename . sprintf("%c"x(512 - length $filename)
+, 0);
        $retval = $block . $filename;

        read(STDIN, $block, $blocksize);
        substr $block, 0, 100, substr $filename, 0, 100;
        $block = checksum $block;

        my $size = substr $block, 124, 10;
        $blknum += $size/$blocksize + 1 + ($size%$blocksize ? 1 : 0);

        $retval = $retval . $block;
        return $retval;
}


sub parse_block {
        my ($block) = @_;
        my ($filename, $chksum, $size, $diff, $link);

        # let's see if it's a header block
        ++$blknum && return $block
        unless
        $block =~ /^(.{100})                # filename
                    [0-7 ]{6}.{2}        # mode
                    [0-7 ]{6}.{2}        # uid
                    [0-7 ]{6}.{2}        # gid
                    ([0-7]{11}).        # size
                    [0-7]{11}.                # mtime
                    ([0-7]{6}).{2}        # checksum
                    (.)                        # indicatior for links
                  /x;

        $filename = $1;
        $size = oct $2;
        $chksum = oct $3;
        $link = $4;

        # check for long file name
        if ($filename =~ m|^\./\./\@LongLink| && $link eq "L") {
                if ($size - length $url > 100) {
                        return make_long_block $block;
                } else {
                        return make_short_block $block;
                }
        }

        ++$blknum && return '' if $block =~ m|^\./$url/\000|i;

        # calculate the next block that contains next header.
        $blknum += $size/$blocksize + 1 + ($size%$blocksize ? 1 : 0);

        $filename =~ s/\000+$//;
        $filename =~ s|^\./($url/)|\./|i;
        $diff = $1;

        # pad with NUL's to 100 bytes.
        $filename =  $filename . sprintf("%c"x(100 - length $filename)
+, 0);

        # update checksum.
        for (split '', $diff) { $chksum -= ord }
        $chksum = sprintf("%o", $chksum);
        $chksum = '0'x(6 - length($chksum)) . $chksum;

        $block =~ s/^.{100}
                    (
                    [0-7]{6}.{2}
                    [0-7]{6}.{2}
                    [0-7]{6}.{2}
                    [0-7]{11}.
                    [0-7]{11}.
                    )                
                    [0-7]{6}
                   /$filename$1$chksum/x;

        return $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]

---

---

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! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

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:
	&		&
	<		&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.