diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Archive/Tar.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Archive/Tar.pm | 84 |
1 files changed, 72 insertions, 12 deletions
diff --git a/Master/tlpkg/tlperl/lib/Archive/Tar.pm b/Master/tlpkg/tlperl/lib/Archive/Tar.pm index 0a35cf77cc7..4ed3ae0386e 100644 --- a/Master/tlpkg/tlperl/lib/Archive/Tar.pm +++ b/Master/tlpkg/tlperl/lib/Archive/Tar.pm @@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "1.76"; +$VERSION = "1.82"; $CHOWN = 1; $CHMOD = 1; $SAME_PERMISSIONS = $> == 0 ? 1 : 0; @@ -68,6 +68,9 @@ Archive::Tar - module for manipulations of tar archives $tar->add_data('file/baz.txt', 'This is the contents now'); $tar->rename('oldname', 'new/file/name'); + $tar->chown('/', 'root'); + $tar->chown('/', 'root:root'); + $tar->chmod('/tmp', '1777'); $tar->write('files.tar'); # plain tar $tar->write('files.tgz', COMPRESS_GZIP); # gzip compressed @@ -168,6 +171,14 @@ very big archives, and are only interested in the first few files. Can be set to a regular expression. Only files with names that match the expression will be read. +=item md5 + +Set to 1 and the md5sum of files will be returned (instead of file data) + my $iter = Archive::Tar->iter( $file, 1, {md5 => 1} ); + while( my $f = $iter->() ) { + print $f->data . "\t" . $f->full_path . $/; + } + =item extract If set to true, immediately extract entries when reading them. This @@ -306,6 +317,7 @@ sub _read_tar { my $count = $opts->{limit} || 0; my $filter = $opts->{filter}; + my $md5 = $opts->{md5} || 0; # cdrake my $filter_cb = $opts->{filter_cb}; my $extract = $opts->{extract} || 0; @@ -332,7 +344,7 @@ sub _read_tar { $self->_error( qq[Cannot read compressed format in tar-mode] ); return; } - + ### size is < HEAD, which means a corrupted file, as the minimum ### length is _at least_ HEAD if (length $chunk != HEAD) { @@ -399,8 +411,14 @@ sub _read_tar { $data = $entry->get_content_by_ref; my $skip = 0; + my $ctx; # cdrake ### skip this entry if we're filtering - if ($filter && $entry->name !~ $filter) { + + if($md5) { # cdrake + $ctx = Digest::MD5->new; # cdrake + $skip=5; # cdrake + + } elsif ($filter && $entry->name !~ $filter) { $skip = 1; ### skip this entry if it's a pax header. This is a special file added @@ -415,11 +433,12 @@ sub _read_tar { if ($skip) { # # Since we're skipping, do not allocate memory for the - # whole file. Read it 64 BLOCKS at a time. Do not + # whole file. Read it 64 BLOCKS at a time. Do not # complete the skip yet because maybe what we read is a # longlink and it won't get skipped after all # my $amt = $block; + my $fsz=$entry->size; # cdrake while ($amt > 0) { $$data = ''; my $this = 64 * BLOCK; @@ -430,9 +449,11 @@ sub _read_tar { next LOOP; } $amt -= $this; + $fsz -= $this; # cdrake + substr ($$data, $fsz) = "" if ($fsz<0); # remove external junk prior to md5 # cdrake + $ctx->add($$data) if($skip==5); # cdrake } - ### throw away trailing garbage ### - substr ($$data, $entry->size) = "" if defined $$data && $block < 64 * BLOCK; + $$data = $ctx->hexdigest if($skip==5 && !$entry->is_longlink && !$entry->is_unknown && !$entry->is_label ) ; # cdrake } else { ### just read everything into memory @@ -1082,6 +1103,45 @@ sub rename { return $entry->rename( $new ); } +=head2 $tar->chmod( $file, $mode ) + +Change mode of $file to $mode. + +Returns true on success and false on failure. + +=cut + +sub chmod { + my $self = shift; + my $file = shift; return unless defined $file; + my $mode = shift; return unless defined $mode && $mode =~ /^[0-7]{1,4}$/; + my @args = ("$mode"); + + my $entry = $self->_find_entry( $file ) or return; + my $x = $entry->chmod( @args ); + return $x; +} + +=head2 $tar->chown( $file, $uname [, $gname] ) + +Change owner $file to $uname and $gname. + +Returns true on success and false on failure. + +=cut + +sub chown { + my $self = shift; + my $file = shift; return unless defined $file; + my $uname = shift; return unless defined $uname; + my @args = ($uname); + push(@args, shift); + + my $entry = $self->_find_entry( $file ) or return; + my $x = $entry->chown( @args ); + return $x; +} + =head2 $tar->remove (@filenamelist) Removes any entries with names matching any of the given filenames @@ -1645,7 +1705,7 @@ Example usage: sub iter { my $class = shift; my $filename = shift or return; - my $compressed = shift or 0; + my $compressed = shift || 0; my $opts = shift || {}; ### get a handle to read from. @@ -1930,7 +1990,7 @@ doing. =head2 $Archive::Tar::ZERO_PAD_NUMBERS This variable holds a boolean indicating if we will create -zero padded numbers for C<size>, C<mtime> and C<checksum>. +zero padded numbers for C<size>, C<mtime> and C<checksum>. The default is C<0>, indicating that we will create space padded numbers. Added for compatibility with C<busybox> implementations. @@ -2114,7 +2174,7 @@ encoded in a different way. =head1 CAVEATS -The AIX tar does not fill all unused space in the tar archive with 0x00. +The AIX tar does not fill all unused space in the tar archive with 0x00. This sometimes leads to warning messages from C<Archive::Tar>. Invalid header block at offset nnn @@ -2126,14 +2186,14 @@ of AIX, all of which should be coming out in the 4th quarter of 2009: AIX 5.3 TL8 SP8 AIX 5.3 TL9 SP5 AIX 5.3 TL10 SP2 - + AIX 6.1 TL0 SP11 AIX 6.1 TL1 SP7 AIX 6.1 TL2 SP6 AIX 6.1 TL3 SP3 -The IBM APAR number for this problem is IZ50240 (Reported component ID: -5765G0300 / AIX 5.3). It is possible to get an ifix for that problem. +The IBM APAR number for this problem is IZ50240 (Reported component ID: +5765G0300 / AIX 5.3). It is possible to get an ifix for that problem. If you need an ifix please contact your local IBM AIX support. =head1 TODO |