diff --git a/.cvsignore b/.cvsignore
index 4f04ee6..9e8351f 100644
--- a/.cvsignore
+++ b/.cvsignore
@@ -1 +1,2 @@
 perl-5.10.0.tar.gz
+Tar-Archive.tar.gz
diff --git a/perl-5.10.0-ArchiveTar1.40.patch b/perl-5.10.0-ArchiveTar1.40.patch
new file mode 100644
index 0000000..453e663
--- /dev/null
+++ b/perl-5.10.0-ArchiveTar1.40.patch
@@ -0,0 +1,1756 @@
+diff -up perl-5.10.0/lib/Archive/Tar/bin/ptar.old perl-5.10.0/lib/Archive/Tar/bin/ptar
+--- perl-5.10.0/lib/Archive/Tar/bin/ptar.old	2007-12-18 11:47:07.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/bin/ptar	2008-08-25 05:43:01.000000000 +0200
+@@ -1,12 +1,13 @@
+ #!/usr/bin/perl
+ use strict;
+ 
++use File::Find;
+ use Getopt::Std;
+ use Archive::Tar;
+-use File::Find;
++use Data::Dumper;
+ 
+ my $opts = {};
+-getopts('dcvzthxf:I', $opts) or die usage();
++getopts('Ddcvzthxf:I', $opts) or die usage();
+ 
+ ### show the help message ###
+ die usage() if $opts->{h};
+@@ -33,72 +34,63 @@ if( $opts->{c} ) {
+     find( sub { push @files, $File::Find::name;
+                 print $File::Find::name.$/ if $verbose }, @ARGV );
+ 
+-    Archive::Tar->create_archive( $file, $compress, @files );
+-    exit;
+-}
+-
+-my $tar = Archive::Tar->new($file, $compress);
++    if ($file eq '-') {
++        use IO::Handle;
++        $file = IO::Handle->new();
++        $file->fdopen(fileno(STDOUT),"w");
++    }
+ 
+-if( $opts->{t} ) {
+-    print map { $_->full_path . $/ } $tar->get_files;
++    Archive::Tar->create_archive( $file, $compress, @files );
+ 
+-} elsif( $opts->{x} ) {
+-    print map { $_->full_path . $/ } $tar->get_files
+-        if $verbose;
+-    Archive::Tar->extract_archive($file, $compress);
++} else {
++    if ($file eq '-') {
++        use IO::Handle;
++        $file = IO::Handle->new();
++        $file->fdopen(fileno(STDIN),"r");
++    }
++
++    ### print the files we're finding?
++    my $print = $verbose || $opts->{'t'} || 0;
++
++    my $iter = Archive::Tar->iter( $file );
++        
++    while( my $f = $iter->() ) {
++        print $f->full_path . $/ if $print;
++
++        ### data dumper output
++        print Dumper( $f ) if $opts->{'D'};
++        
++        ### extract it
++        $f->extract if $opts->{'x'};
++    }
+ }
+ 
+-
+-
++### pod & usage in one
+ sub usage {
+-    qq[
+-Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
+-        ptar -x [-v] [-z] [-f ARCHIVE_FILE]
+-        ptar -t [-z] [-f ARCHIVE_FILE]
+-        ptar -h
+-
+-    ptar is a small, tar look-alike program that uses the perl module
+-    Archive::Tar to extract, create and list tar archives.
+-
+-Options:
+-    x   Extract from ARCHIVE_FILE
+-    c   Create ARCHIVE_FILE from FILE
+-    t   List the contents of ARCHIVE_FILE
+-    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+-    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+-    v   Print filenames as they are added or extraced from ARCHIVE_FILE
+-    h   Prints this help message
+-    I   Enable 'Insecure Extract Mode', which allows archives to extract
+-        files outside the current working directory. (Not advised).
+-
+-See Also:
+-    tar(1)
+-    Archive::Tar
+-
+-    \n]
+-}
++    my $usage .= << '=cut';
++=pod
+ 
+ =head1 NAME
+ 
+-ptar - a tar-like program written in perl
++    ptar - a tar-like program written in perl
+ 
+ =head1 DESCRIPTION
+ 
+-ptar is a small, tar look-alike program that uses the perl module
+-Archive::Tar to extract, create and list tar archives.
++    ptar is a small, tar look-alike program that uses the perl module
++    Archive::Tar to extract, create and list tar archives.
+ 
+ =head1 SYNOPSIS
+ 
+-    ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
+-    ptar -x [-v] [-z] [-f ARCHIVE_FILE]
+-    ptar -t [-z] [-f ARCHIVE_FILE]
++    ptar -c [-v] [-z] [-f ARCHIVE_FILE | -] FILE FILE ...
++    ptar -x [-v] [-z] [-f ARCHIVE_FILE | -]
++    ptar -t [-z] [-f ARCHIVE_FILE | -]
+     ptar -h
+ 
+ =head1 OPTIONS
+ 
+-    x   Extract from ARCHIVE_FILE
+-    c   Create ARCHIVE_FILE from FILE
+-    t   List the contents of ARCHIVE_FILE
++    c   Create ARCHIVE_FILE or STDOUT (-) from FILE
++    x   Extract from ARCHIVE_FILE or STDIN (-)
++    t   List the contents of ARCHIVE_FILE or STDIN (-)
+     f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+     z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+     v   Print filenames as they are added or extraced from ARCHIVE_FILE
+@@ -106,6 +98,17 @@ Archive::Tar to extract, create and list
+ 
+ =head1 SEE ALSO
+ 
+-tar(1), L<Archive::Tar>.
++    tar(1), L<Archive::Tar>.
+ 
+ =cut
++
++    ### strip the pod directives
++    $usage =~ s/=pod\n//g;
++    $usage =~ s/=head1 //g;
++    
++    ### add some newlines
++    $usage .= $/.$/;
++    
++    return $usage;
++}
++
+diff -up perl-5.10.0/lib/Archive/Tar/Constant.pm.old perl-5.10.0/lib/Archive/Tar/Constant.pm
+--- perl-5.10.0/lib/Archive/Tar/Constant.pm.old	2007-12-18 11:47:07.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/Constant.pm	2008-09-10 10:42:08.000000000 +0200
+@@ -2,20 +2,16 @@ package Archive::Tar::Constant;
+ 
+ BEGIN {
+     require Exporter;
+-    $VERSION= '0.02';
+-    @ISA    = qw[Exporter];
+-    @EXPORT = qw[
+-                FILE HARDLINK SYMLINK CHARDEV BLOCKDEV DIR FIFO SOCKET UNKNOWN
+-                BUFFER HEAD READ_ONLY WRITE_ONLY UNPACK PACK TIME_OFFSET ZLIB
+-                BLOCK_SIZE TAR_PAD TAR_END ON_UNIX BLOCK CAN_READLINK MAGIC 
+-                TAR_VERSION UNAME GNAME CAN_CHOWN MODE CHECK_SUM UID GID 
+-                GZIP_MAGIC_NUM MODE_READ LONGLINK LONGLINK_NAME PREFIX_LENGTH
+-                LABEL NAME_LENGTH STRIP_MODE ON_VMS
+-            ];
++    
++    $VERSION    = '0.02';
++    @ISA        = qw[Exporter];
+ 
+     require Time::Local if $^O eq "MacOS";
+ }
+ 
++use Package::Constants;
++@EXPORT = Package::Constants->list( __PACKAGE__ );
++
+ use constant FILE           => 0;
+ use constant HARDLINK       => 1;
+ use constant SYMLINK        => 2;
+@@ -32,6 +28,9 @@ use constant BUFFER         => 4096;
+ use constant HEAD           => 512;
+ use constant BLOCK          => 512;
+ 
++use constant COMPRESS_GZIP  => 9;
++use constant COMPRESS_BZIP  => 'bzip2';
++
+ use constant BLOCK_SIZE     => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
+ use constant TAR_PAD        => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
+ use constant TAR_END        => "\0" x BLOCK;
+@@ -61,14 +60,23 @@ use constant TIME_OFFSET    => ($^O eq "
+ use constant MAGIC          => "ustar";
+ use constant TAR_VERSION    => "00";
+ use constant LONGLINK_NAME  => '././@LongLink';
++use constant PAX_HEADER     => 'pax_global_header';
+ 
+-                            ### allow ZLIB to be turned off using ENV
+-                            ### DEBUG only
++                            ### allow ZLIB to be turned off using ENV: DEBUG only
+ use constant ZLIB           => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
+                                         eval { require IO::Zlib };
+-                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 };
+-                                    
++                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 
++                                };
++
++                            ### allow BZIP to be turned off using ENV: DEBUG only                                
++use constant BZIP           => do { !$ENV{'PERL5_AT_NO_BZIP'} and
++                                        eval { require IO::Uncompress::Bunzip2;
++                                               require IO::Compress::Bzip2; };
++                                    $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1 
++                                };
++
+ use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
++use constant BZIP_MAGIC_NUM => qr/^BZh\d/;
+ 
+ use constant CAN_CHOWN      => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
+ use constant CAN_READLINK   => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
+diff -up perl-5.10.0/lib/Archive/Tar/File.pm.old perl-5.10.0/lib/Archive/Tar/File.pm
+--- perl-5.10.0/lib/Archive/Tar/File.pm.old	2007-12-18 11:47:07.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/File.pm	2008-10-13 13:51:50.000000000 +0200
+@@ -1,15 +1,18 @@
+ package Archive::Tar::File;
+ use strict;
+ 
++use Carp                ();
+ use IO::File;
+ use File::Spec::Unix    ();
+ use File::Spec          ();
+ use File::Basename      ();
+ 
++### avoid circular use, so only require;
++require Archive::Tar;
+ use Archive::Tar::Constant;
+ 
+ use vars qw[@ISA $VERSION];
+-@ISA        = qw[Archive::Tar];
++#@ISA        = qw[Archive::Tar];
+ $VERSION    = '0.02';
+ 
+ ### set value to 1 to oct() it during the unpack ###
+@@ -154,13 +157,13 @@ Raw tar header -- not useful for most us
+ 
+ =head1 Methods
+ 
+-=head2 new( file => $path )
++=head2 Archive::Tar::File->new( file => $path )
+ 
+ Returns a new Archive::Tar::File object from an existing file.
+ 
+ Returns undef on failure.
+ 
+-=head2 new( data => $path, $data, $opt )
++=head2 Archive::Tar::File->new( data => $path, $data, $opt )
+ 
+ Returns a new Archive::Tar::File object from data.
+ 
+@@ -171,7 +174,7 @@ tar header), which are described above i
+ 
+ Returns undef on failure.
+ 
+-=head2 new( chunk => $chunk )
++=head2 Archive::Tar::File->new( chunk => $chunk )
+ 
+ Returns a new Archive::Tar::File object from a raw 512-byte tar
+ archive chunk.
+@@ -266,6 +269,29 @@ sub _new_from_file {
+     my @items       = qw[mode uid gid size mtime];
+     my %hash        = map { shift(@items), $_ } (lstat $path)[2,4,5,7,9];
+ 
++    if (ON_VMS) {
++        ### VMS has two UID modes, traditional and POSIX.  Normally POSIX is
++        ### not used.  We currently do not have an easy way to see if we are in
++        ### POSIX mode.  In traditional mode, the UID is actually the VMS UIC.
++        ### The VMS UIC has the upper 16 bits is the GID, which in many cases
++        ### the VMS UIC will be larger than 209715, the largest that TAR can
++        ### handle.  So for now, assume it is traditional if the UID is larger
++        ### than 0x10000.
++
++        if ($hash{uid} > 0x10000) {
++            $hash{uid} = $hash{uid} & 0xFFFF;
++        }
++
++        ### The file length from stat() is the physical length of the file
++        ### However the amount of data read in may be more for some file types.
++        ### Fixed length files are read past the logical EOF to end of the block
++        ### containing.  Other file types get expanded on read because record
++        ### delimiters are added.
++
++        my $data_len = length $data;
++        $hash{size} = $data_len if $hash{size} < $data_len;
++
++    }
+     ### you *must* set size == 0 on symlinks, or the next entry will be
+     ### though of as the contents of the symlink, which is wrong.
+     ### this fixes bug #7937
+@@ -367,6 +393,9 @@ sub _prefix_and_file {
+     ### if it's a directory, then $file might be empty
+     $file = pop @dirs if $self->is_dir and not length $file;
+ 
++    ### splitting ../ gives you the relative path in native syntax
++    map { $_ = '..' if $_  eq '-' } @dirs if ON_VMS;
++
+     my $prefix = File::Spec::Unix->catdir(
+                         grep { length } $vol, @dirs
+                     );
+@@ -411,7 +440,25 @@ sub _downgrade_to_plainfile {
+     return 1;
+ }
+ 
+-=head2 full_path
++=head2 $bool = $file->extract( [ $alternative_name ] )
++
++Extract this object, optionally to an alternative name. 
++
++See C<< Archive::Tar->extract_file >> for details.
++
++Returns true on success and false on failure.
++
++=cut
++
++sub extract {
++    my $self = shift;
++    
++    local $Carp::CarpLevel += 1;
++    
++    return Archive::Tar->_extract_file( $self, @_ );
++}
++
++=head2 $path = $file->full_path
+ 
+ Returns the full path from the tar header; this is basically a
+ concatenation of the C<prefix> and C<name> fields.
+@@ -429,7 +476,7 @@ sub full_path {
+ }
+ 
+ 
+-=head2 validate
++=head2 $bool = $file->validate
+ 
+ Done by Archive::Tar internally when reading the tar file:
+ validate the header against the checksum to ensure integer tar file.
+@@ -448,7 +495,7 @@ sub validate {
+ 	return unpack ("%16C*", $raw) == $self->chksum ? 1 : 0;
+ }
+ 
+-=head2 has_content
++=head2 $bool = $file->has_content
+ 
+ Returns a boolean to indicate whether the current object has content.
+ Some special files like directories and so on never will have any
+@@ -462,7 +509,7 @@ sub has_content {
+     return defined $self->data() && length $self->data() ? 1 : 0;
+ }
+ 
+-=head2 get_content
++=head2 $content = $file->get_content
+ 
+ Returns the current content for the in-memory file
+ 
+@@ -473,7 +520,7 @@ sub get_content {
+     $self->data( );
+ }
+ 
+-=head2 get_content_by_ref
++=head2 $cref = $file->get_content_by_ref
+ 
+ Returns the current content for the in-memory file as a scalar
+ reference. Normal users won't need this, but it will save memory if
+@@ -489,7 +536,7 @@ sub get_content_by_ref {
+     return \$self->{data};
+ }
+ 
+-=head2 replace_content( $content )
++=head2 $bool = $file->replace_content( $content )
+ 
+ Replace the current content of the file with the new content. This
+ only affects the in-memory archive, not the on-disk version until
+@@ -508,7 +555,7 @@ sub replace_content {
+     return 1;
+ }
+ 
+-=head2 rename( $new_name )
++=head2 $bool = $file->rename( $new_name )
+ 
+ Rename the current file to $new_name.
+ 
+@@ -540,49 +587,49 @@ use the following methods:
+ 
+ =over 4
+ 
+-=item is_file
++=item $file->is_file
+ 
+ Returns true if the file is of type C<file>
+ 
+-=item is_dir
++=item $file->is_dir
+ 
+ Returns true if the file is of type C<dir>
+ 
+-=item is_hardlink
++=item $file->is_hardlink
+ 
+ Returns true if the file is of type C<hardlink>
+ 
+-=item is_symlink
++=item $file->is_symlink
+ 
+ Returns true if the file is of type C<symlink>
+ 
+-=item is_chardev
++=item $file->is_chardev
+ 
+ Returns true if the file is of type C<chardev>
+ 
+-=item is_blockdev
++=item $file->is_blockdev
+ 
+ Returns true if the file is of type C<blockdev>
+ 
+-=item is_fifo
++=item $file->is_fifo
+ 
+ Returns true if the file is of type C<fifo>
+ 
+-=item is_socket
++=item $file->is_socket
+ 
+ Returns true if the file is of type C<socket>
+ 
+-=item is_longlink
++=item $file->is_longlink
+ 
+ Returns true if the file is of type C<LongLink>.
+ Should not happen after a successful C<read>.
+ 
+-=item is_label
++=item $file->is_label
+ 
+ Returns true if the file is of type C<Label>.
+ Should not happen after a successful C<read>.
+ 
+-=item is_unknown
++=item $file->is_unknown
+ 
+ Returns true if the file type is C<unknown>
+ 
+diff -up perl-5.10.0/lib/Archive/Tar.pm.old perl-5.10.0/lib/Archive/Tar.pm
+--- perl-5.10.0/lib/Archive/Tar.pm.old	2007-12-18 11:47:07.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar.pm	2008-10-13 15:16:06.000000000 +0200
+@@ -7,16 +7,31 @@
+ package Archive::Tar;
+ require 5.005_03;
+ 
++use Cwd;
++use IO::Zlib;
++use IO::File;
++use Carp                qw(carp croak);
++use File::Spec          ();
++use File::Spec::Unix    ();
++use File::Path          ();
++
++use Archive::Tar::File;
++use Archive::Tar::Constant;
++
++require Exporter;
++
+ use strict;
+ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
+             $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING
+-            $INSECURE_EXTRACT_MODE
++            $INSECURE_EXTRACT_MODE @ISA @EXPORT
+          ];
+ 
++@ISA                    = qw[Exporter];
++@EXPORT                 = ( COMPRESS_GZIP, COMPRESS_BZIP );
+ $DEBUG                  = 0;
+ $WARN                   = 1;
+ $FOLLOW_SYMLINK         = 0;
+-$VERSION                = "1.38";
++$VERSION                = "1.40";
+ $CHOWN                  = 1;
+ $CHMOD                  = 1;
+ $DO_NOT_USE_PREFIX      = 0;
+@@ -28,24 +43,13 @@ BEGIN {
+ 
+     ### try and load IO::String anyway, so you can dynamically
+     ### switch between perlio and IO::String
+-    eval {
++    $HAS_IO_STRING = eval {
+         require IO::String;
+         import IO::String;
+-    };
+-    $HAS_IO_STRING = $@ ? 0 : 1;
+-
++        1;
++    } || 0;
+ }
+ 
+-use Cwd;
+-use IO::File;
+-use Carp                qw(carp croak);
+-use File::Spec          ();
+-use File::Spec::Unix    ();
+-use File::Path          ();
+-
+-use Archive::Tar::File;
+-use Archive::Tar::Constant;
+-
+ =head1 NAME
+ 
+ Archive::Tar - module for manipulations of tar archives
+@@ -55,7 +59,7 @@ Archive::Tar - module for manipulations 
+     use Archive::Tar;
+     my $tar = Archive::Tar->new;
+ 
+-    $tar->read('origin.tgz',1);
++    $tar->read('origin.tgz');
+     $tar->extract();
+ 
+     $tar->add_files('file/foo.pl', 'docs/README');
+@@ -63,7 +67,9 @@ Archive::Tar - module for manipulations 
+ 
+     $tar->rename('oldname', 'new/file/name');
+ 
+-    $tar->write('files.tar');
++    $tar->write('files.tar');                   # plain tar
++    $tar->write('files.tgz', COMPRESSED_GZIP);  # gzip compressed
++    $tar->write('files.tbz', COMPRESSED_BZIP);  # bzip2 compressed
+ 
+ =head1 DESCRIPTION
+ 
+@@ -122,23 +128,25 @@ sub new {
+     return $obj;
+ }
+ 
+-=head2 $tar->read ( $filename|$handle, $compressed, {opt => 'val'} )
++=head2 $tar->read ( $filename|$handle, [$compressed, {opt => 'val'}] )
+ 
+ Read the given tar file into memory.
+ The first argument can either be the name of a file or a reference to
+ an already open filehandle (or an IO::Zlib object if it's compressed)
+-The second argument indicates whether the file referenced by the first
+-argument is compressed.
+ 
+ The C<read> will I<replace> any previous content in C<$tar>!
+ 
+-The second argument may be considered optional if IO::Zlib is
+-installed, since it will transparently Do The Right Thing.
+-Archive::Tar will warn if you try to pass a compressed file if
+-IO::Zlib is not available and simply return.
++The second argument may be considered optional, but remains for 
++backwards compatibility. Archive::Tar now looks at the file
++magic to determine what class should be used to open the file
++and will transparently Do The Right Thing.
++
++Archive::Tar will warn if you try to pass a bzip2 compressed file and the
++IO::Zlib / IO::Uncompress::Bunzip2 modules are not available and simply return.
+ 
+ Note that you can currently B<not> pass a C<gzip> compressed
+-filehandle, which is not opened with C<IO::Zlib>, nor a string
++filehandle, which is not opened with C<IO::Zlib>, a C<bzip2> compressed
++filehandle, which is not opened with C<IO::Uncompress::Bunzip2>, nor a string
+ containing the full archive information (either compressed or
+ uncompressed). These are worth while features, but not currently
+ implemented. See the C<TODO> section.
+@@ -153,12 +161,18 @@ all options are case-sensitive.
+ Do not read more than C<limit> files. This is useful if you have
+ very big archives, and are only interested in the first few files.
+ 
++=item filter
++
++Can be set to a regular expression.  Only files with names that match
++the expression will be read.
++
+ =item extract
+ 
+ If set to true, immediately extract entries when reading them. This
+ gives you the same memory break as the C<extract_archive> function.
+ Note however that entries will not be read into memory, but written
+-straight to disk.
++straight to disk. This means no C<Archive::Tar::File> objects are 
++created for you to inspect.
+ 
+ =back
+ 
+@@ -194,49 +208,97 @@ sub read {
+ }
+ 
+ sub _get_handle {
+-    my $self = shift;
+-    my $file = shift;   return unless defined $file;
+-                        return $file if ref $file;
+-
+-    my $gzip = shift || 0;
+-    my $mode = shift || READ_ONLY->( ZLIB ); # default to read only
+-
+-    my $fh; my $bin;
++    my $self     = shift;
++    my $file     = shift;   return unless defined $file;
++                            return $file if ref $file;
++    my $compress = shift || 0;
++    my $mode     = shift || READ_ONLY->( ZLIB ); # default to read only
+ 
+-    ### only default to ZLIB if we're not trying to /write/ to a handle ###
+-    if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
+ 
+-        ### IO::Zlib will Do The Right Thing, even when passed
+-        ### a plain file ###
+-        $fh = new IO::Zlib;
++    ### get a FH opened to the right class, so we can use it transparently
++    ### throughout the program
++    my $fh;
++    {   ### reading magic only makes sense if we're opening a file for
++        ### reading. otherwise, just use what the user requested.
++        my $magic = '';
++        if( MODE_READ->($mode) ) {
++            open my $tmp, $file or do {
++                $self->_error( qq[Could not open '$file' for reading: $!] );
++                return;
++            };
++        
++            ### read the first 4 bites of the file to figure out which class to
++            ### use to open the file.
++            sysread( $tmp, $magic, 4 );    
++            close $tmp;
++        }
+ 
+-    } else {
+-        if( $gzip ) {
+-            $self->_error(qq[Compression not available - Install IO::Zlib!]);
+-            return;
++        ### is it bzip?
++        ### if you asked specifically for bzip compression, or if we're in
++        ### read mode and the magic numbers add up, use bzip
++        if( BZIP and (
++                ($compress eq COMPRESS_BZIP) or 
++                ( MODE_READ->($mode) and $magic =~ BZIP_MAGIC_NUM )
++            )
++        ) {
++        
++            ### different reader/writer modules, different error vars... sigh
++            if( MODE_READ->($mode) ) {
++                $fh = IO::Uncompress::Bunzip2->new( $file ) or do {
++                    $self->_error( qq[Could not read '$file': ] .
++                        $IO::Uncompress::Bunzip2::Bunzip2Error
++                    );
++                    return;
++                };
++            
++            } else {
++                $fh = IO::Compress::Bzip2->new( $file ) or do {
++                    $self->_error( qq[Could not write to '$file': ] .
++                        $IO::Compress::Bzip2::Bzip2Error
++                    );
++                    return;
++                };
++            }
++            
++        ### is it gzip?
++        ### if you asked for compression, if you wanted to read or the gzip
++        ### magic number is present (redundant with read)
++        } elsif( ZLIB and (
++                    $compress or MODE_READ->($mode) or $magic =~ GZIP_MAGIC_NUM
++                 )        
++        ) {
++            $fh = IO::Zlib->new;
+ 
++            unless( $fh->open( $file, $mode ) ) {
++                $self->_error(qq[Could not create filehandle for '$file': $!]);
++                return;
++            }
++            
++        ### is it plain tar?
+         } else {
+-            $fh = new IO::File;
+-            $bin++;
+-        }
+-    }
++            $fh = IO::File->new;
+ 
+-    unless( $fh->open( $file, $mode ) ) {
+-        $self->_error( qq[Could not create filehandle for '$file': $!!] );
+-        return;
+-    }
++            unless( $fh->open( $file, $mode ) ) {
++                $self->_error(qq[Could not create filehandle for '$file': $!]);
++                return;
++            }
+ 
+-    binmode $fh if $bin;
++            ### enable bin mode on tar archives
++            binmode $fh;
++        }            
++    }
+ 
+     return $fh;
+ }
+ 
++
+ sub _read_tar {
+     my $self    = shift;
+     my $handle  = shift or return;
+     my $opts    = shift || {};
+ 
+     my $count   = $opts->{limit}    || 0;
++    my $filter  = $opts->{filter};
+     my $extract = $opts->{extract}  || 0;
+ 
+     ### set a cap on the amount of files to extract ###
+@@ -372,6 +434,17 @@ sub _read_tar {
+             undef $real_name;
+         }
+ 
++        ### skip this entry if we're filtering
++        if ($filter && $entry->name !~ $filter) {
++            next LOOP;
++        
++        ### skip this entry if it's a pax header. This is a special file added
++        ### by, among others, git-generated tarballs. It holds comments and is
++        ### not meant for extracting. See #38932: pax_global_header extracted 
++        } elsif ( $entry->name eq PAX_HEADER ) {
++            next LOOP;
++        }
++        
+         $self->_extract_file( $entry ) if $extract
+                                             && !$entry->is_longlink
+                                             && !$entry->is_unknown
+@@ -544,7 +617,7 @@ sub _extract_file {
+ 
+     my $dir;
+     ### is $name an absolute path? ###
+-    if( File::Spec->file_name_is_absolute( $dirs ) ) {
++    if( $vol || File::Spec->file_name_is_absolute( $dirs ) ) {
+ 
+         ### absolute names are not allowed to be in tarballs under
+         ### strict mode, so only allow it if a user tells us to do it
+@@ -557,30 +630,65 @@ sub _extract_file {
+         }
+         
+         ### user asked us to, it's fine.
+-        $dir = $dirs;
++        $dir = File::Spec->catpath( $vol, $dirs, "" );
+ 
+     ### it's a relative path ###
+     } else {
+-        my $cwd     = (defined $self->{cwd} ? $self->{cwd} : cwd());
++        my $cwd     = (ref $self and defined $self->{cwd}) 
++                        ? $self->{cwd} 
++                        : cwd();
+ 
+         my @dirs = defined $alt
+             ? File::Spec->splitdir( $dirs )         # It's a local-OS path
+             : File::Spec::Unix->splitdir( $dirs );  # it's UNIX-style, likely
+                                                     # straight from the tarball
+ 
+-        ### paths that leave the current directory are not allowed under
+-        ### strict mode, so only allow it if a user tells us to do this.
+         if( not defined $alt            and 
+-            not $INSECURE_EXTRACT_MODE  and 
+-            grep { $_ eq '..' } @dirs
+-        ) {
+-            $self->_error(
+-                q[Entry ']. $entry->full_path .q[' is attempting to leave the ].
+-                q[current working directory. Not extracting under SECURE ].
+-                q[EXTRACT MODE]
+-            );
+-            return;
+-        }            
++            not $INSECURE_EXTRACT_MODE 
++        ) {            
++
++            ### paths that leave the current directory are not allowed under
++            ### strict mode, so only allow it if a user tells us to do this.
++            if( grep { $_ eq '..' } @dirs ) {
++    
++                $self->_error(
++                    q[Entry ']. $entry->full_path .q[' is attempting to leave ].
++                    q[the current working directory. Not extracting under ].
++                    q[SECURE EXTRACT MODE]
++                );
++                return;
++            } 
++        
++            ### the archive may be asking us to extract into a symlink. This
++            ### is not sane and a possible security issue, as outlined here:
++            ### https://rt.cpan.org/Ticket/Display.html?id=30380
++            ### https://bugzilla.redhat.com/show_bug.cgi?id=295021
++            ### https://issues.rpath.com/browse/RPL-1716
++            my $full_path = $cwd;
++            for my $d ( @dirs ) {
++                $full_path = File::Spec->catdir( $full_path, $d );
++                
++                ### we've already checked this one, and it's safe. Move on.
++                next if ref $self and $self->{_link_cache}->{$full_path};
++
++                if( -l $full_path ) {
++                    my $to   = readlink $full_path;
++                    my $diag = "symlinked directory ($full_path => $to)";
++
++                    $self->_error(
++                        q[Entry ']. $entry->full_path .q[' is attempting to ].
++                        qq[extract to a $diag. This is considered a security ].
++                        q[vulnerability and not allowed under SECURE EXTRACT ].
++                        q[MODE]
++                    );
++                    return;
++                }
++                
++                ### XXX keep a cache if possible, so the stats become cheaper:
++                $self->{_link_cache}->{$full_path} = 1 if ref $self;
++            }
++        }
++
+         
+         ### '.' is the directory delimiter, of which the first one has to
+         ### be escaped/changed.
+@@ -622,7 +730,8 @@ sub _extract_file {
+     unless ( -d _ ) {
+         eval { File::Path::mkpath( $dir, 0, 0777 ) };
+         if( $@ ) {
+-            $self->_error( qq[Could not create directory '$dir': $@] );
++            my $fp = $entry->full_path;
++            $self->_error(qq[Could not create directory '$dir' for '$fp': $@]);
+             return;
+         }
+         
+@@ -672,8 +781,13 @@ sub _extract_file {
+         $self->_make_special_file( $entry, $full ) or return;
+     }
+ 
+-    utime time, $entry->mtime - TIME_OFFSET, $full or
+-        $self->_error( qq[Could not update timestamp] );
++    ### only update the timestamp if it's not a symlink; that will change the
++    ### timestamp of the original. This addresses bug #33669: Could not update
++    ### timestamp warning on symlinks
++    if( not -l $full ) {
++        utime time, $entry->mtime - TIME_OFFSET, $full or
++            $self->_error( qq[Could not update timestamp] );
++    }
+ 
+     if( $CHOWN && CAN_CHOWN ) {
+         chown $entry->uid, $entry->gid, $full or
+@@ -707,8 +821,8 @@ sub _make_special_file {
+                 or $fail++;
+         }
+ 
+-        $err =  qq[Making symbolink link from '] . $entry->linkname .
+-                qq[' to '$file' failed] if $fail;
++        $err =  qq[Making symbolic link '$file' to '] .
++                $entry->linkname .q[' failed] if $fail;
+ 
+     } elsif ( $entry->is_hardlink ) {
+         my $fail;
+@@ -949,17 +1063,23 @@ sub clear {
+ 
+ Write the in-memory archive to disk.  The first argument can either
+ be the name of a file or a reference to an already open filehandle (a
+-GLOB reference). If the second argument is true, the module will use
+-IO::Zlib to write the file in a compressed format.  If IO::Zlib is
+-not available, the C<write> method will fail and return.
++GLOB reference). 
++
++The second argument is used to indicate compression. You can either 
++compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed
++to be the C<gzip> compression level (between 1 and 9), but the use of 
++constants is prefered:
++
++  # write a gzip compressed file
++  $tar->write( 'out.tgz', COMPRESSION_GZIP );
++
++  # write a bzip compressed file  
++  $tar->write( 'out.tbz', COMPRESSION_BZIP );
+ 
+ Note that when you pass in a filehandle, the compression argument
+ is ignored, as all files are printed verbatim to your filehandle.
+ If you wish to enable compression with filehandles, use an
+-C<IO::Zlib> filehandle instead.
+-
+-Specific levels of compression can be chosen by passing the values 2
+-through 9 as the second parameter.
++C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead.
+ 
+ The third argument is an optional prefix. All files will be tucked
+ away in the directory you specify as prefix. So if you have files
+@@ -970,6 +1090,7 @@ If no arguments are given, C<write> retu
+ archive as a string, which could be useful if you'd like to stuff the
+ archive into a socket or a pipe to gzip or something.
+ 
++
+ =cut
+ 
+ sub write {
+@@ -1350,56 +1471,29 @@ sub setcwd {
+     $self->{cwd} = $cwd;
+ }
+ 
+-=head2 $bool = $tar->has_io_string
+-
+-Returns true if we currently have C<IO::String> support loaded.
+-
+-Either C<IO::String> or C<perlio> support is needed to support writing 
+-stringified archives. Currently, C<perlio> is the preferred method, if
+-available.
+-
+-See the C<GLOBAL VARIABLES> section to see how to change this preference.
+-
+-=cut
+-
+-sub has_io_string { return $HAS_IO_STRING; }
+-
+-=head2 $bool = $tar->has_perlio
+-
+-Returns true if we currently have C<perlio> support loaded.
+-
+-This requires C<perl-5.8> or higher, compiled with C<perlio> 
+-
+-Either C<IO::String> or C<perlio> support is needed to support writing 
+-stringified archives. Currently, C<perlio> is the preferred method, if
+-available.
+-
+-See the C<GLOBAL VARIABLES> section to see how to change this preference.
+-
+-=cut
+-
+-sub has_perlio { return $HAS_PERLIO; }
+-
+-
+ =head1 Class Methods
+ 
+-=head2 Archive::Tar->create_archive($file, $compression, @filelist)
++=head2 Archive::Tar->create_archive($file, $compressed, @filelist)
+ 
+ Creates a tar file from the list of files provided.  The first
+ argument can either be the name of the tar file to create or a
+ reference to an open file handle (e.g. a GLOB reference).
+ 
+-The second argument specifies the level of compression to be used, if
+-any.  Compression of tar files requires the installation of the
+-IO::Zlib module.  Specific levels of compression may be
+-requested by passing a value between 2 and 9 as the second argument.
+-Any other value evaluating as true will result in the default
+-compression level being used.
++The second argument is used to indicate compression. You can either 
++compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed
++to be the C<gzip> compression level (between 1 and 9), but the use of 
++constants is prefered:
++
++  # write a gzip compressed file
++  Archive::Tar->create_archive( 'out.tgz', COMPRESSION_GZIP, @filelist );
++
++  # write a bzip compressed file  
++  Archive::Tar->create_archive( 'out.tbz', COMPRESSION_BZIP, @filelist );
+ 
+ Note that when you pass in a filehandle, the compression argument
+ is ignored, as all files are printed verbatim to your filehandle.
+ If you wish to enable compression with filehandles, use an
+-C<IO::Zlib> filehandle instead.
++C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead.
+ 
+ The remaining arguments list the files to be included in the tar file.
+ These files must all exist. Any files which don't exist or can't be
+@@ -1431,7 +1525,63 @@ sub create_archive {
+     return $tar->write( $file, $gzip );
+ }
+ 
+-=head2 Archive::Tar->list_archive ($file, $compressed, [\@properties])
++=head2 Archive::Tar->iter( $filename, [ $compressed, {opt => $val} ] )
++
++Returns an iterator function that reads the tar file without loading
++it all in memory.  Each time the function is called it will return the
++next file in the tarball. The files are returned as
++C<Archive::Tar::File> objects. The iterator function returns the
++empty list once it has exhausted the the files contained.
++
++The second argument can be a hash reference with options, which are
++identical to the arguments passed to C<read()>.
++
++Example usage:
++
++    my $next = Archive::Tar->iter( "example.tar.gz", 1, {filter => qr/\.pm$/} );
++
++    while( my $f = $next->() ) {
++        print $f->name, "\n";
++
++        $f->extract or warn "Extraction failed";
++        
++        # ....
++    }
++
++=cut
++
++
++sub iter {
++    my $class       = shift;
++    my $filename    = shift or return;
++    my $compressed  = shift or 0;
++    my $opts        = shift || {};
++
++    ### get a handle to read from.
++    my $handle = $class->_get_handle(
++        $filename, 
++        $compressed, 
++        READ_ONLY->( ZLIB )
++    ) or return;
++
++    my @data;
++    return sub {
++        return shift(@data)     if @data;       # more than one file returned?
++        return                  unless $handle; # handle exhausted?
++
++        ### read data, should only return file
++        @data = @{ $class->_read_tar($handle, { %$opts, limit => 1 }) };
++
++        ### return one piece of data
++        return shift(@data)     if @data;
++        
++        ### data is exhausted, free the filehandle
++        undef $handle;
++        return;
++    };
++}
++
++=head2 Archive::Tar->list_archive($file, $compressed, [\@properties])
+ 
+ Returns a list of the names of all the files in the archive.  The
+ first argument can either be the name of the tar file to list or a
+@@ -1462,7 +1612,7 @@ sub list_archive {
+     return $tar->list_files( @_ );
+ }
+ 
+-=head2 Archive::Tar->extract_archive ($file, $gzip)
++=head2 Archive::Tar->extract_archive($file, $compressed)
+ 
+ Extracts the contents of the tar file.  The first argument can either
+ be the name of the tar file to create or a reference to an open file
+@@ -1486,11 +1636,57 @@ sub extract_archive {
+     return $tar->read( $file, $gzip, { extract => 1 } );
+ }
+ 
++=head2 $bool = Archive::Tar->has_io_string
++
++Returns true if we currently have C<IO::String> support loaded.
++
++Either C<IO::String> or C<perlio> support is needed to support writing 
++stringified archives. Currently, C<perlio> is the preferred method, if
++available.
++
++See the C<GLOBAL VARIABLES> section to see how to change this preference.
++
++=cut
++
++sub has_io_string { return $HAS_IO_STRING; }
++
++=head2 $bool = Archive::Tar->has_perlio
++
++Returns true if we currently have C<perlio> support loaded.
++
++This requires C<perl-5.8> or higher, compiled with C<perlio> 
++
++Either C<IO::String> or C<perlio> support is needed to support writing 
++stringified archives. Currently, C<perlio> is the preferred method, if
++available.
++
++See the C<GLOBAL VARIABLES> section to see how to change this preference.
++
++=cut
++
++sub has_perlio { return $HAS_PERLIO; }
++
++=head2 $bool = Archive::Tar->has_zlib_support
++
++Returns true if C<Archive::Tar> can extract C<zlib> compressed archives
++
++=cut
++
++sub has_zlib_support { return ZLIB }
++
++=head2 $bool = Archive::Tar->has_bzip2_support
++
++Returns true if C<Archive::Tar> can extract C<bzip2> compressed archives
++
++=cut
++
++sub has_bzip2_support { return BZIP }
++
+ =head2 Archive::Tar->can_handle_compressed_files
+ 
+ A simple checking routine, which will return true if C<Archive::Tar>
+-is able to uncompress compressed archives on the fly with C<IO::Zlib>,
+-or false if C<IO::Zlib> is not installed.
++is able to uncompress compressed archives on the fly with C<IO::Zlib>
++and C<IO::Compress::Bzip2> or false if not both are installed.
+ 
+ You can use this as a shortcut to determine whether C<Archive::Tar>
+ will do what you think before passing compressed archives to its
+@@ -1498,7 +1694,7 @@ C<read> method.
+ 
+ =cut
+ 
+-sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
++sub can_handle_compressed_files { return ZLIB && BZIP ? 1 : 0 }
+ 
+ sub no_string_support {
+     croak("You have to install IO::String to support writing archives to strings");
+@@ -1645,18 +1841,24 @@ Yes it is, see previous answer. Since C<
+ C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
+ choice but to read the archive into memory.
+ This is ok if you want to do in-memory manipulation of the archive.
++
+ If you just want to extract, use the C<extract_archive> class method
+ instead. It will optimize and write to disk immediately.
+ 
+-=item Can't you lazy-load data instead?
++Another option is to use the C<iter> class method to iterate over
++the files in the tarball without reading them all in memory at once.
++
++=item Can you lazy-load data instead?
+ 
+-No, not easily. See previous question.
++In some cases, yes. You can use the C<iter> class method to iterate
++over the files in the tarball without reading them all in memory at once.
+ 
+ =item How much memory will an X kb tar file need?
+ 
+ Probably more than X kb, since it will all be read into memory. If
+ this is a problem, and you don't need to do in memory manipulation
+-of the archive, consider using C</bin/tar> instead.
++of the archive, consider using the C<iter> class method, or C</bin/tar> 
++instead.
+ 
+ =item What do you do with unsupported filetypes in an archive?
+ 
+@@ -1666,8 +1868,9 @@ try to make a copy of the original file,
+ 
+ This does require you to read the entire archive in to memory first,
+ since otherwise we wouldn't know what data to fill the copy with.
+-(This means that you cannot use the class methods on archives that
+-have incompatible filetypes and still expect things to work).
++(This means that you cannot use the class methods, including C<iter> 
++on archives that have incompatible filetypes and still expect things 
++to work).
+ 
+ For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
+ the extraction of this particular item didn't work.
+@@ -1852,12 +2055,12 @@ Please reports bugs to E<lt>bug-archive-
+ 
+ =head1 ACKNOWLEDGEMENTS
+ 
+-Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
+-especially Andrew Savige for their help and suggestions.
++Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney, Gisle Aas
++and especially Andrew Savige for their help and suggestions.
+ 
+ =head1 COPYRIGHT
+ 
+-This module is copyright (c) 2002 - 2007 Jos Boumans 
++This module is copyright (c) 2002 - 2008 Jos Boumans 
+ E<lt>kane@cpan.orgE<gt>. All rights reserved.
+ 
+ This library is free software; you may redistribute and/or modify 
+diff -up perl-5.10.0/lib/Archive/Tar/t/01_use.t.old perl-5.10.0/lib/Archive/Tar/t/01_use.t
+diff -up perl-5.10.0/lib/Archive/Tar/t/02_methods.t.old perl-5.10.0/lib/Archive/Tar/t/02_methods.t
+--- perl-5.10.0/lib/Archive/Tar/t/02_methods.t.old	2007-12-18 11:47:07.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/t/02_methods.t	2008-10-13 15:00:07.000000000 +0200
+@@ -21,9 +21,14 @@ use File::Spec::Unix    ();
+ use File::Basename      ();
+ use Data::Dumper;
+ 
+-use Archive::Tar;
++### need the constants at compile time;
+ use Archive::Tar::Constant;
+ 
++my $Class   = 'Archive::Tar';
++use_ok( $Class );
++
++
++
+ ### XXX TODO:
+ ### * change to fullname
+ ### * add tests for global variables
+@@ -72,22 +77,23 @@ if ($TOO_LONG) {
+ }
+ 
+ my @ROOT        = grep { length }   'src', $TOO_LONG ? 'short' : 'long';
+-
+-my $ZLIB        = eval { require IO::Zlib; 1 } ? 1 : 0;
+ my $NO_UNLINK   = $ARGV[0] ? 1 : 0;
+ 
+-### enable debugging?
+-$Archive::Tar::DEBUG = 1 if $ARGV[1];
++### enable debugging? 
++### pesky warnings
++$Archive::Tar::DEBUG = $Archive::Tar::DEBUG = 1 if $ARGV[1];
+ 
+ ### tests for binary and x/x files
+-my $TARBIN      = Archive::Tar->new;
+-my $TARX        = Archive::Tar->new;
++my $TARBIN      = $Class->new;
++my $TARX        = $Class->new;
+ 
+ ### paths to a .tar and .tgz file to use for tests
+ my $TAR_FILE        = File::Spec->catfile( @ROOT, 'bar.tar' );
+ my $TGZ_FILE        = File::Spec->catfile( @ROOT, 'foo.tgz' );
++my $TBZ_FILE        = File::Spec->catfile( @ROOT, 'foo.tbz' );
+ my $OUT_TAR_FILE    = File::Spec->catfile( @ROOT, 'out.tar' );
+ my $OUT_TGZ_FILE    = File::Spec->catfile( @ROOT, 'out.tgz' );
++my $OUT_TBZ_FILE    = File::Spec->catfile( @ROOT, 'out.tbz' );
+ 
+ my $COMPRESS_FILE = 'copy';
+ $^O eq 'VMS' and $COMPRESS_FILE .= '.';
+@@ -96,15 +102,16 @@ chmod 0644, $COMPRESS_FILE;
+ 
+ ### done setting up environment ###
+ 
++### check for zlib/bzip2 support
++{   for my $meth ( qw[has_zlib_support has_bzip2_support] ) {
++        can_ok( $Class, $meth );
++    }
++}    
+ 
+-### did we probe IO::Zlib support ok? ###
+-{   is( Archive::Tar->can_handle_compressed_files, $ZLIB,
+-                                    "Proper IO::Zlib support detected" );
+-}
+ 
+ 
+ ### tar error tests
+-{   my $tar     = Archive::Tar->new;
++{   my $tar     = $Class->new;
+ 
+     ok( $tar,                       "Object created" );
+     isa_ok( $tar,                   'Archive::Tar');
+@@ -133,7 +140,7 @@ chmod 0644, $COMPRESS_FILE;
+ 
+     ### check if ->error eq $error
+     is( $tar->error, $Archive::Tar::error,
+-                                    '$error matches error() method' );
++                                    "Error '$Archive::Tar::error' matches $Class->error method" );
+                      
+     ### check that 'contains_file' doesn't warn about missing files.                     
+     {   ### turn on warnings in general!
+@@ -149,89 +156,77 @@ chmod 0644, $COMPRESS_FILE;
+ }
+ 
+ ### read tests ###
+-{   ### normal tar + gz compressed file
+-    my $archive         = $TAR_FILE;
+-    my $compressed      = $TGZ_FILE;
+-    my $tar             = Archive::Tar->new;
+-    my $gzip            = 0;
++{   my @to_try = ($TAR_FILE);
++    push @to_try, $TGZ_FILE if $Class->has_zlib_support;
++    push @to_try, $TBZ_FILE if $Class->has_bzip2_support;
+ 
+-    ### check we got the object
+-    ok( $tar,                       "Object created" );
+-    isa_ok( $tar,                   'Archive::Tar');
++    for my $type( @to_try ) {
+ 
+-    for my $type( $archive, $compressed ) {
+-        my $state = $gzip ? 'compressed' : 'uncompressed';
++        ### normal tar + gz compressed file
++        my $tar             = $Class->new;
+ 
+-        SKIP: {
++        ### check we got the object
++        ok( $tar,                       "Object created" );
++        isa_ok( $tar,                   'Archive::Tar');
+ 
+-            ### skip gz compressed archives wihtout IO::Zlib
+-            skip(   "No IO::Zlib - cannot read compressed archives",
+-                    4 + 2 * (scalar @EXPECT_NORMAL)
+-            ) if( $gzip and !$ZLIB);
+-
+-            ### ->read test
+-            {   my @list    = $tar->read( $type );
+-                my $cnt     = scalar @list;
+-                my $expect  = scalar __PACKAGE__->get_expect();
+-
+-                ok( $cnt,           "Reading $state file using 'read()'" );
+-                is( $cnt, $expect,  "   All files accounted for" );
+-
+-                for my $file ( @list ) {
+-                    ok( $file,      "Got File object" );
+-                    isa_ok( $file,  "Archive::Tar::File" );
+-
+-                    ### whitebox test -- make sure find_entry gets the
+-                    ### right files
+-                    for my $test ( $file->full_path, $file ) {
+-                        is( $tar->_find_entry( $test ), $file,
+-                                    "   Found proper object" );
+-                    }
+-                    
+-                    next unless $file->is_file;
+-
+-                    my $name = $file->full_path;
+-                    my($expect_name, $expect_content) =
+-                        get_expect_name_and_contents( $name, \@EXPECT_NORMAL );
++        ### ->read test
++        my @list    = $tar->read( $type );
++        my $cnt     = scalar @list;
++        my $expect  = scalar __PACKAGE__->get_expect();
++
++        ok( $cnt,           "Reading '$type' using 'read()'" );
++        is( $cnt, $expect,  "   All files accounted for" );
++
++        for my $file ( @list ) {
++            ok( $file,      "Got File object" );
++            isa_ok( $file,  "Archive::Tar::File" );
++
++            ### whitebox test -- make sure find_entry gets the
++            ### right files
++            for my $test ( $file->full_path, $file ) {
++                is( $tar->_find_entry( $test ), $file,
++                            "   Found proper object" );
++            }
++            
++            next unless $file->is_file;
+ 
+-                    ### ->fullname!
+-                    ok($expect_name,"   Found expected file '$name'" );
++            my $name = $file->full_path;
++            my($expect_name, $expect_content) =
++                get_expect_name_and_contents( $name, \@EXPECT_NORMAL );
+ 
+-                    like($tar->get_content($name), $expect_content,
+-                                    "   Content OK" );
+-                }
+-            }
++            ### ->fullname!
++            ok($expect_name,"   Found expected file '$name'" );
+ 
++            like($tar->get_content($name), $expect_content,
++                            "   Content OK" );
++        }
+ 
+-            ### list_archive test
+-            {   my @list    = Archive::Tar->list_archive( $archive );
+-                my $cnt     = scalar @list;
+-                my $expect  = scalar __PACKAGE__->get_expect();
+-
+-                ok( $cnt,           "Reading $state file using 'list_archive'");
+-                is( $cnt, $expect,  "   All files accounted for" );
+ 
+-                for my $file ( @list ) {
+-                    next if __PACKAGE__->is_dir( $file ); # directories
++        ### list_archive test
++        {   my @list    = $Class->list_archive( $type );
++            my $cnt     = scalar @list;
++            my $expect  = scalar __PACKAGE__->get_expect();
++
++            ok( $cnt,           "Reading '$type' using 'list_archive'");
++            is( $cnt, $expect,  "   All files accounted for" );
+ 
+-                    my($expect_name, $expect_content) =
+-                        get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
++            for my $file ( @list ) {
++                next if __PACKAGE__->is_dir( $file ); # directories
+ 
+-                    ok( $expect_name,
+-                                    "   Found expected file '$file'" );
+-                }
++                my($expect_name, $expect_content) =
++                    get_expect_name_and_contents( $file, \@EXPECT_NORMAL );
++
++                ok( $expect_name,
++                                "   Found expected file '$file'" );
+             }
+         }
+-
+-        ### now we try gz compressed archives
+-        $gzip++;
+     }
+ }
+ 
+ ### add files tests ###
+ {   my @add     = map { File::Spec->catfile( @ROOT, @$_ ) } ['b'];
+     my @addunix = map { File::Spec::Unix->catfile( @ROOT, @$_ ) } ['b'];
+-    my $tar     = Archive::Tar->new;
++    my $tar     = $Class->new;
+ 
+     ### check we got the object
+     ok( $tar,                       "Object created" );
+@@ -264,7 +259,7 @@ chmod 0644, $COMPRESS_FILE;
+ 
+     ### check adding files doesn't conflict with a secondary archive
+     ### old A::T bug, we should keep testing for it
+-    {   my $tar2    = Archive::Tar->new;
++    {   my $tar2    = $Class->new;
+         my @added   = $tar2->add_files( $COMPRESS_FILE );
+         my @count   = $tar2->list_files;
+ 
+@@ -285,7 +280,7 @@ chmod 0644, $COMPRESS_FILE;
+ {
+     {   ### standard data ###
+         my @to_add  = ( 'a', 'aaaaa' );
+-        my $tar     = Archive::Tar->new;
++        my $tar     = $Class->new;
+ 
+         ### check we got the object
+         ok( $tar,                   "Object created" );
+@@ -330,7 +325,7 @@ chmod 0644, $COMPRESS_FILE;
+ }
+ 
+ ### rename/replace_content tests ###
+-{   my $tar     = Archive::Tar->new;
++{   my $tar     = $Class->new;
+     my $from    = 'c';
+     my $to      = 'e';
+ 
+@@ -362,7 +357,7 @@ chmod 0644, $COMPRESS_FILE;
+ 
+ ### remove tests ###
+ {   my $remove  = 'c';
+-    my $tar     = Archive::Tar->new;
++    my $tar     = $Class->new;
+ 
+     ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );
+ 
+@@ -376,12 +371,14 @@ chmod 0644, $COMPRESS_FILE;
+ }
+ 
+ ### write + read + extract tests ###
+-SKIP: {
++SKIP: {                             ### pesky warnings
+     skip('no IO::String', 326) if   !$Archive::Tar::HAS_PERLIO && 
++                                    !$Archive::Tar::HAS_PERLIO && 
++                                    !$Archive::Tar::HAS_IO_STRING &&
+                                     !$Archive::Tar::HAS_IO_STRING;
+                                     
+-    my $tar = Archive::Tar->new;
+-    my $new = Archive::Tar->new;
++    my $tar = $Class->new;
++    my $new = $Class->new;
+     ok( $tar->read( $TAR_FILE ),    "Read in '$TAR_FILE'" );
+ 
+     for my $aref (  [$tar,    \@EXPECT_NORMAL],
+@@ -421,40 +418,31 @@ SKIP: {
+ 
+ 
+             {   ### create_archive()
+-                ok( Archive::Tar->create_archive( $out, 0, $COMPRESS_FILE ),
++                ok( $Class->create_archive( $out, 0, $COMPRESS_FILE ),
+                                     "Wrote tarfile using 'create_archive'" );
+                 check_tar_file( $out );
+ 
+                 ### now extract it again
+-                ok( Archive::Tar->extract_archive( $out ),
++                ok( $Class->extract_archive( $out ),
+                                     "Extracted file using 'extract_archive'");
+                 rm( $out ) unless $NO_UNLINK;
+             }
+         }
+ 
+         ## write tgz tests
+-        {   my $out = $OUT_TGZ_FILE;
+-
+-            SKIP: {
+-
+-                ### weird errors from scalar(@x,@y,@z), dot it this way...
+-                my $file_cnt;
+-                map { $file_cnt += scalar @$_ } \@EXPECT_NORMAL, \@EXPECTBIN,
+-                                                \@EXPECTX;
+-
+-                my $cnt =   5 +                 # the tests below
+-                            (5*3*2) +           # check_tgz_file
+-                                                # check_tar_object fixed tests
+-                            (3 * 2 * (2 + $file_cnt)) +
+-                            ((4*$file_cnt) + 1);# check_tar_extract tests
++        {   my @out;
++            push @out, [ $OUT_TGZ_FILE => 1             ] if $Class->has_zlib_support;
++            push @out, [ $OUT_TBZ_FILE => COMPRESS_BZIP ] if $Class->has_bzip2_support;
++        
++            for my $entry ( @out ) {
+ 
+-                skip( "No IO::Zlib - cannot write compressed archives", $cnt )
+-                    unless $ZLIB;
++                my( $out, $compression ) = @$entry;
+ 
+                 {   ### write()
+-                    ok($obj->write($out, 1),
+-                                    "Writing compressed file using 'write'" );
+-                    check_tgz_file( $out );
++                    ok($obj->write($out, $compression),
++                                    "Writing compressed file '$out' using 'write'" );
++                    check_compressed_file( $out );
++
+                     check_tar_object( $obj, $struct );
+ 
+                     ### now read it in again
+@@ -471,12 +459,12 @@ SKIP: {
+                 }
+ 
+                 {   ### create_archive()
+-                    ok( Archive::Tar->create_archive( $out, 1, $COMPRESS_FILE ),
+-                                    "Wrote gzip file using 'create_archive'" );
+-                    check_tgz_file( $out );
++                    ok( $Class->create_archive( $out, $compression, $COMPRESS_FILE ),
++                                    "Wrote '$out' using 'create_archive'" );
++                    check_compressed_file( $out );
+ 
+                     ### now extract it again
+-                    ok( Archive::Tar->extract_archive( $out, 1 ),
++                    ok( $Class->extract_archive( $out, $compression ),
+                                     "Extracted file using 'extract_archive'");
+                     rm( $out ) unless $NO_UNLINK;
+                 }
+@@ -487,7 +475,7 @@ SKIP: {
+ 
+ 
+ ### limited read + extract tests ###
+-{   my $tar     = Archive::Tar->new;
++{   my $tar     = $Class->new;
+     my @files   = $tar->read( $TAR_FILE, 0, { limit => 1 } );
+     my $obj     = $files[0];
+ 
+@@ -528,7 +516,7 @@ SKIP: {
+ 
+ 
+ ### clear tests ###
+-{   my $tar     = Archive::Tar->new;
++{   my $tar     = $Class->new;
+     my @files   = $tar->read( $TAR_FILE );
+ 
+     my $cnt = $tar->list_files();
+@@ -540,7 +528,7 @@ SKIP: {
+ }
+ 
+ ### $DO_NOT_USE_PREFIX tests
+-{   my $tar     = Archive::Tar->new;
++{   my $tar     = $Class->new;
+ 
+ 
+     ### first write a tar file without prefix
+@@ -556,7 +544,10 @@ SKIP: {
+         is( $obj->prefix, $dir,     "   Prefix set to '$dir'" );
+ 
+         ### write the tar file without a prefix in it
++        ### pesky warnings
+         local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
++        local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
++
+         ok( $tar->write( $OUT_TAR_FILE ),
+                                     "   Tar file written" );
+ 
+@@ -645,10 +636,10 @@ sub check_tar_file {
+     return $contents;
+ }
+ 
+-sub check_tgz_file {
++sub check_compressed_file {
+     my $file                = shift;
+     my $filesize            = -s $file;
+-    my $contents            = slurp_gzfile( $file );
++    my $contents            = slurp_compressed_file( $file );
+     my $uncompressedsize    = length $contents;
+ 
+     ok( defined( $contents ),   "   File read and uncompressed" );
+@@ -762,18 +753,29 @@ sub slurp_binfile {
+     return <$fh>;
+ }
+ 
+-sub slurp_gzfile {
++sub slurp_compressed_file {
+     my $file = shift;
+-    my $str;
+-    my $buff;
++    my $fh;
++    
++    ### bzip2
++    if( $file =~ /.tbz$/ ) {
++        require IO::Uncompress::Bunzip2;
++        $fh = IO::Uncompress::Bunzip2->new( $file )    
++            or warn( "Error opening '$file' with IO::Uncompress::Bunzip2" ), return
+ 
+-    require IO::Zlib;
+-    my $fh = new IO::Zlib;
+-    $fh->open( $file, READ_ONLY->(1) )
+-        or warn( "Error opening '$file' with IO::Zlib" ), return undef;
++    ### gzip
++    } else {
++        require IO::Zlib;
++        $fh = new IO::Zlib;
++        $fh->open( $file, READ_ONLY->(1) )
++            or warn( "Error opening '$file' with IO::Zlib" ), return
++    }        
+ 
++    my $str;
++    my $buff;
+     $str .= $buff while $fh->read( $buff, 4096 ) > 0;
+     $fh->close();
++
+     return $str;
+ }
+ 
+diff -urN perl-5.10.0/lib/Archive/Tar/t.old/04_resolved_issues.t perl-5.10.0/lib/Archive/Tar/t/04_resolved_issues.t
+--- perl-5.10.0/lib/Archive/Tar/t.old/04_resolved_issues.t	2008-12-11 12:43:35.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/t/04_resolved_issues.t	2008-10-13 13:51:50.000000000 +0200
+@@ -113,7 +113,7 @@
+     ### absolute paths are already taken care of. Only relative paths
+     ### matter
+     my $in_file     = basename($0);
+-    my $out_file    = '../' . $in_file . ".$$";
++    my $out_file    = '../' . $in_file . "_$$";
+     
+     ok( $tar->add_files( $in_file ), 
+                                 "       Added '$in_file'" );
+diff -urN perl-5.10.0/lib/Archive/Tar/t.old/05_iter.t perl-5.10.0/lib/Archive/Tar/t/05_iter.t
+--- perl-5.10.0/lib/Archive/Tar/t.old/05_iter.t	1970-01-01 01:00:00.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/t/05_iter.t	2008-08-25 05:53:18.000000000 +0200
+@@ -0,0 +1,65 @@
++BEGIN {
++    if( $ENV{PERL_CORE} ) {
++        chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
++    }       
++    use lib '../../..';
++}
++
++BEGIN { chdir 't' if -d 't' }
++
++use Test::More 'no_plan';
++use strict;
++use lib '../lib';
++
++my $Class   = 'Archive::Tar';
++my $FClass  = 'Archive::Tar::File';
++my $File    = 'src/long/bar.tar';
++my @Expect = (
++    qr|^c$|,
++    qr|^d$|,
++    qr|^directory/$|,
++    qr|^directory/really.*name/$|,
++    qr|^directory/.*/myfile$|,
++);
++
++use_ok( $Class );
++
++### crazy ref to special case 'all'
++for my $index ( \0, 0 .. $#Expect ) {   
++
++    my %opts    = ();
++    my @expect  = ();
++    
++    ### do a full test vs individual filters
++    if( not ref $index ) {
++        my $regex       = $Expect[$index];
++        $opts{'filter'} = $regex;
++        @expect         = ($regex);
++    } else {
++        @expect         = @Expect;
++    }        
++
++    my $next = $Class->iter( $File, 0, \%opts );
++    
++    my $pp_opts = join " => ", %opts;
++    ok( $next,                  "Iterator created from $File ($pp_opts)" );
++    isa_ok( $next, "CODE",      "   Iterator" );
++
++    my @names;
++    while( my $f = $next->() ) {
++        ok( $f,                 "       File object retrieved" );
++        isa_ok( $f, $FClass,    "           Object" );
++
++        push @names, $f->name;
++    }
++    
++    is( scalar(@names), scalar(@expect),
++                                "   Found correct number of files" );
++    
++    my $i = 0;
++    for my $name ( @names ) {
++        ok( 1,                  "   Inspecting '$name' " );
++        like($name, $expect[$i],"       Matches $Expect[$i]" );
++        $i++;
++    }        
++}
+diff -urN perl-5.10.0/lib/Archive/Tar/t.old/90_symlink.t perl-5.10.0/lib/Archive/Tar/t/90_symlink.t
+--- perl-5.10.0/lib/Archive/Tar/t.old/90_symlink.t	1970-01-01 01:00:00.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/t/90_symlink.t	2008-08-25 05:43:01.000000000 +0200
+@@ -0,0 +1,62 @@
++BEGIN {
++    if( $ENV{PERL_CORE} ) {
++        chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
++    }       
++    use lib '../../..';
++}
++
++BEGIN { chdir 't' if -d 't' }
++
++use lib '../lib';
++
++use strict;
++use File::Spec;
++use File::Path;
++use Test::More;
++
++### developer tests mostly, so enable them with an extra argument
++plan skip_all => "Skipping tests on this platform" unless @ARGV;
++plan 'no_plan';
++
++my $Class   = 'Archive::Tar';
++my $Dir     = File::Spec->catdir( qw[src linktest] );    
++my %Map     = (
++    File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [
++        [ 0, qr/SECURE EXTRACT MODE/ ],
++        [ 1, qr/^$/ ]
++    ],
++    File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [
++        [ 0, qr/SECURE EXTRACT MODE/ ],
++        [ 0, qr/File exists/ ],
++    ],
++);
++
++use_ok( $Class );
++
++{   while( my($file, $aref) = each %Map ) {
++
++        for my $mode ( 0, 1 ) {
++            my $expect = $aref->[$mode]->[0];
++            my $regex  = $aref->[$mode]->[1];
++
++            my $tar  = $Class->new( $file );
++            ok( $tar,                   "Object created from $file" );
++
++            ### damn warnings
++            local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
++            local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
++            
++            ok( 1,                  "   Extracting with insecure mode: $mode" );
++
++            my $warning;
++            local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; };
++
++            my $rv = eval { $tar->extract } || 0;
++            ok( !$@,                "       No fatal error" );
++            is( !!$rv, !!$expect,   "       RV as expected" );
++            like( $warning, $regex, "       Error matches $regex" );
++    
++            rmtree( 'linktest' );
++        }
++    }        
++}    
+diff -urN perl-5.10.0/lib/Archive/Tar/t.old/99_pod.t perl-5.10.0/lib/Archive/Tar/t/99_pod.t
+--- perl-5.10.0/lib/Archive/Tar/t.old/99_pod.t	2008-12-11 12:43:35.000000000 +0100
++++ perl-5.10.0/lib/Archive/Tar/t/99_pod.t	2008-10-13 14:24:42.000000000 +0200
+@@ -8,6 +8,8 @@
+ eval 'use Test::Pod';
+ plan skip_all => "Test::Pod v0.95 required for testing POD"
+     if $@ || $Test::Pod::VERSION < 0.95;
++    
++plan skip_all => "Pod tests disabled under perl core" if $ENV{PERL_CORE};    
+ 
+ my @files;
+ find( sub { push @files, File::Spec->catfile(
diff --git a/perl.spec b/perl.spec
index 4329050..a939b43 100644
--- a/perl.spec
+++ b/perl.spec
@@ -7,7 +7,7 @@
 
 Name:           perl
 Version:        %{perl_version}
-Release:        51%{?dist}
+Release:        52%{?dist}
 Epoch:          %{perl_epoch}
 Summary:        Practical Extraction and Report Language
 Group:          Development/Languages
@@ -16,6 +16,7 @@ Group:          Development/Languages
 License:        (GPL+ or Artistic) and (GPLv2+ or Artistic)
 Url:            http://www.perl.org/
 Source0:        http://search.cpan.org/CPAN/authors/id/R/RG/RGARCIA/perl-%{perl_version}.tar.gz
+Source1:        Tar-Archive.tar.gz
 Source11:       filter-requires.sh
 Source12:       perl-5.8.0-libnet.cfg
 # Specific to Fedora/RHEL
@@ -121,6 +122,8 @@ Patch30:    perl-5.10.0-Change33896.patch
 # http://www.nntp.perl.org/group/perl.perl5.changes/2008/05/msg21733.html
 Patch31:    perl-5.10.0-Change33897.patch
 
+Patch32:	perl-5.10.0-ArchiveTar1.40.patch
+
 BuildRoot:      %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
 BuildRequires:  tcsh, dos2unix, man, groff
 BuildRequires:  gdbm-devel, db4-devel, zlib-devel
@@ -274,7 +277,7 @@ Summary:        A module for Perl manipulation of .tar files
 Group:          Development/Libraries
 License:        GPL+ or Artistic
 Epoch:          0
-Version:        1.38
+Version:        1.40
 Requires:       perl = %{perl_epoch}:%{perl_version}-%{release}
 Requires:       perl(Compress::Zlib), perl(IO::Zlib)
 
@@ -821,7 +824,7 @@ upstream tarball from perl.org.
 
 
 %prep
-%setup -q 
+%setup -q -a 1
 %patch1 -p1
 %patch2 -p1
 %patch3 -p1
@@ -859,6 +862,7 @@ upstream tarball from perl.org.
 %patch29 -p1
 %patch30 -p1
 %patch31 -p1
+%patch32 -p1
 
 #
 # Candidates for doc recoding (need case by case review):
@@ -1092,6 +1096,7 @@ perl -x patchlevel.h '33640 Integrate Changes 33399, 33621, 33622, 33623, 33624'
 perl -x patchlevel.h '33881 Integrate Changes 33825, 33826, 33829'
 perl -x patchlevel.h '33896 Eliminate POSIX::int_macro_int, and all the complex AUTOLOAD fandango'
 perl -x patchlevel.h '33897 Replaced the WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG'
+perl -x patchlevel.h 'Fedora Patch32: CVE-2007-4829 Update Archive::Tar to 1.40'
 
 %clean
 rm -rf $RPM_BUILD_ROOT
@@ -1699,6 +1704,10 @@ make test
 
 # Old changelog entries are preserved in CVS.
 %changelog
+* Thu Dec 12 2008 Marcela Mašláňová <mmaslano@redhat.com> - 4:5.10.0-52
+- 295021 CVE-2007-4829 perl-Archive-Tar directory traversal flaws
+- add another source for binary files, which test untaring links
+
 * Fri Nov 28 2008 Tom "spot" Callaway <tcallawa@redhat.com> - 4:5.10.0-51
 - to fix Fedora bz 473223, which is really perl bug #54186 (http://rt.perl.org/rt3//Public/Bug/Display.html?id=54186)
   we apply Changes 33640, 33881, 33896, 33897
diff --git a/sources b/sources
index 72d3f8a..505a500 100644
--- a/sources
+++ b/sources
@@ -1 +1,2 @@
 d2c39b002ebfd2c3c5dba589365c5a71  perl-5.10.0.tar.gz
+20fc625176668dd02a8b07ef0acd451d  Tar-Archive.tar.gz