| 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 | |
by dmitri (Priest) on Mar 19, 2001 at 22:18 UTC |