1### the gnu tar specification: 2### http://www.gnu.org/software/tar/manual/tar.html 3### 4### and the pax format spec, which tar derives from: 5### http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html 6 7package Archive::Tar; 8require 5.005_03; 9 10use Cwd; 11use IO::Zlib; 12use IO::File; 13use Carp qw(carp croak); 14use File::Spec (); 15use File::Spec::Unix (); 16use File::Path (); 17 18use Archive::Tar::File; 19use Archive::Tar::Constant; 20 21require Exporter; 22 23use strict; 24use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD 25 $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING $SAME_PERMISSIONS 26 $INSECURE_EXTRACT_MODE $ZERO_PAD_NUMBERS @ISA @EXPORT 27 ]; 28 29@ISA = qw[Exporter]; 30@EXPORT = qw[ COMPRESS_GZIP COMPRESS_BZIP ]; 31$DEBUG = 0; 32$WARN = 1; 33$FOLLOW_SYMLINK = 0; 34$VERSION = "1.90"; 35$CHOWN = 1; 36$CHMOD = 1; 37$SAME_PERMISSIONS = $> == 0 ? 1 : 0; 38$DO_NOT_USE_PREFIX = 0; 39$INSECURE_EXTRACT_MODE = 0; 40$ZERO_PAD_NUMBERS = 0; 41 42BEGIN { 43 use Config; 44 $HAS_PERLIO = $Config::Config{useperlio}; 45 46 ### try and load IO::String anyway, so you can dynamically 47 ### switch between perlio and IO::String 48 $HAS_IO_STRING = eval { 49 require IO::String; 50 import IO::String; 51 1; 52 } || 0; 53} 54 55=head1 NAME 56 57Archive::Tar - module for manipulations of tar archives 58 59=head1 SYNOPSIS 60 61 use Archive::Tar; 62 my $tar = Archive::Tar->new; 63 64 $tar->read('origin.tgz'); 65 $tar->extract(); 66 67 $tar->add_files('file/foo.pl', 'docs/README'); 68 $tar->add_data('file/baz.txt', 'This is the contents now'); 69 70 $tar->rename('oldname', 'new/file/name'); 71 $tar->chown('/', 'root'); 72 $tar->chown('/', 'root:root'); 73 $tar->chmod('/tmp', '1777'); 74 75 $tar->write('files.tar'); # plain tar 76 $tar->write('files.tgz', COMPRESS_GZIP); # gzip compressed 77 $tar->write('files.tbz', COMPRESS_BZIP); # bzip2 compressed 78 79=head1 DESCRIPTION 80 81Archive::Tar provides an object oriented mechanism for handling tar 82files. It provides class methods for quick and easy files handling 83while also allowing for the creation of tar file objects for custom 84manipulation. If you have the IO::Zlib module installed, 85Archive::Tar will also support compressed or gzipped tar files. 86 87An object of class Archive::Tar represents a .tar(.gz) archive full 88of files and things. 89 90=head1 Object Methods 91 92=head2 Archive::Tar->new( [$file, $compressed] ) 93 94Returns a new Tar object. If given any arguments, C<new()> calls the 95C<read()> method automatically, passing on the arguments provided to 96the C<read()> method. 97 98If C<new()> is invoked with arguments and the C<read()> method fails 99for any reason, C<new()> returns undef. 100 101=cut 102 103my $tmpl = { 104 _data => [ ], 105 _file => 'Unknown', 106}; 107 108### install get/set accessors for this object. 109for my $key ( keys %$tmpl ) { 110 no strict 'refs'; 111 *{__PACKAGE__."::$key"} = sub { 112 my $self = shift; 113 $self->{$key} = $_[0] if @_; 114 return $self->{$key}; 115 } 116} 117 118sub new { 119 my $class = shift; 120 $class = ref $class if ref $class; 121 122 ### copying $tmpl here since a shallow copy makes it use the 123 ### same aref, causing for files to remain in memory always. 124 my $obj = bless { _data => [ ], _file => 'Unknown', _error => '' }, $class; 125 126 if (@_) { 127 unless ( $obj->read( @_ ) ) { 128 $obj->_error(qq[No data could be read from file]); 129 return; 130 } 131 } 132 133 return $obj; 134} 135 136=head2 $tar->read ( $filename|$handle, [$compressed, {opt => 'val'}] ) 137 138Read the given tar file into memory. 139The first argument can either be the name of a file or a reference to 140an already open filehandle (or an IO::Zlib object if it's compressed) 141 142The C<read> will I<replace> any previous content in C<$tar>! 143 144The second argument may be considered optional, but remains for 145backwards compatibility. Archive::Tar now looks at the file 146magic to determine what class should be used to open the file 147and will transparently Do The Right Thing. 148 149Archive::Tar will warn if you try to pass a bzip2 compressed file and the 150IO::Zlib / IO::Uncompress::Bunzip2 modules are not available and simply return. 151 152Note that you can currently B<not> pass a C<gzip> compressed 153filehandle, which is not opened with C<IO::Zlib>, a C<bzip2> compressed 154filehandle, which is not opened with C<IO::Uncompress::Bunzip2>, nor a string 155containing the full archive information (either compressed or 156uncompressed). These are worth while features, but not currently 157implemented. See the C<TODO> section. 158 159The third argument can be a hash reference with options. Note that 160all options are case-sensitive. 161 162=over 4 163 164=item limit 165 166Do not read more than C<limit> files. This is useful if you have 167very big archives, and are only interested in the first few files. 168 169=item filter 170 171Can be set to a regular expression. Only files with names that match 172the expression will be read. 173 174=item md5 175 176Set to 1 and the md5sum of files will be returned (instead of file data) 177 my $iter = Archive::Tar->iter( $file, 1, {md5 => 1} ); 178 while( my $f = $iter->() ) { 179 print $f->data . "\t" . $f->full_path . $/; 180 } 181 182=item extract 183 184If set to true, immediately extract entries when reading them. This 185gives you the same memory break as the C<extract_archive> function. 186Note however that entries will not be read into memory, but written 187straight to disk. This means no C<Archive::Tar::File> objects are 188created for you to inspect. 189 190=back 191 192All files are stored internally as C<Archive::Tar::File> objects. 193Please consult the L<Archive::Tar::File> documentation for details. 194 195Returns the number of files read in scalar context, and a list of 196C<Archive::Tar::File> objects in list context. 197 198=cut 199 200sub read { 201 my $self = shift; 202 my $file = shift; 203 my $gzip = shift || 0; 204 my $opts = shift || {}; 205 206 unless( defined $file ) { 207 $self->_error( qq[No file to read from!] ); 208 return; 209 } else { 210 $self->_file( $file ); 211 } 212 213 my $handle = $self->_get_handle($file, $gzip, READ_ONLY->( ZLIB ) ) 214 or return; 215 216 my $data = $self->_read_tar( $handle, $opts ) or return; 217 218 $self->_data( $data ); 219 220 return wantarray ? @$data : scalar @$data; 221} 222 223sub _get_handle { 224 my $self = shift; 225 my $file = shift; return unless defined $file; 226 my $compress = shift || 0; 227 my $mode = shift || READ_ONLY->( ZLIB ); # default to read only 228 229 ### Check if file is a file handle or IO glob 230 if ( ref $file ) { 231 return $file if eval{ *$file{IO} }; 232 return $file if eval{ $file->isa(q{IO::Handle}) }; 233 $file = q{}.$file; 234 } 235 236 ### get a FH opened to the right class, so we can use it transparently 237 ### throughout the program 238 my $fh; 239 { ### reading magic only makes sense if we're opening a file for 240 ### reading. otherwise, just use what the user requested. 241 my $magic = ''; 242 if( MODE_READ->($mode) ) { 243 open my $tmp, $file or do { 244 $self->_error( qq[Could not open '$file' for reading: $!] ); 245 return; 246 }; 247 248 ### read the first 4 bites of the file to figure out which class to 249 ### use to open the file. 250 sysread( $tmp, $magic, 4 ); 251 close $tmp; 252 } 253 254 ### is it bzip? 255 ### if you asked specifically for bzip compression, or if we're in 256 ### read mode and the magic numbers add up, use bzip 257 if( BZIP and ( 258 ($compress eq COMPRESS_BZIP) or 259 ( MODE_READ->($mode) and $magic =~ BZIP_MAGIC_NUM ) 260 ) 261 ) { 262 263 ### different reader/writer modules, different error vars... sigh 264 if( MODE_READ->($mode) ) { 265 $fh = IO::Uncompress::Bunzip2->new( $file ) or do { 266 $self->_error( qq[Could not read '$file': ] . 267 $IO::Uncompress::Bunzip2::Bunzip2Error 268 ); 269 return; 270 }; 271 272 } else { 273 $fh = IO::Compress::Bzip2->new( $file ) or do { 274 $self->_error( qq[Could not write to '$file': ] . 275 $IO::Compress::Bzip2::Bzip2Error 276 ); 277 return; 278 }; 279 } 280 281 ### is it gzip? 282 ### if you asked for compression, if you wanted to read or the gzip 283 ### magic number is present (redundant with read) 284 } elsif( ZLIB and ( 285 $compress or MODE_READ->($mode) or $magic =~ GZIP_MAGIC_NUM 286 ) 287 ) { 288 $fh = IO::Zlib->new; 289 290 unless( $fh->open( $file, $mode ) ) { 291 $self->_error(qq[Could not create filehandle for '$file': $!]); 292 return; 293 } 294 295 ### is it plain tar? 296 } else { 297 $fh = IO::File->new; 298 299 unless( $fh->open( $file, $mode ) ) { 300 $self->_error(qq[Could not create filehandle for '$file': $!]); 301 return; 302 } 303 304 ### enable bin mode on tar archives 305 binmode $fh; 306 } 307 } 308 309 return $fh; 310} 311 312 313sub _read_tar { 314 my $self = shift; 315 my $handle = shift or return; 316 my $opts = shift || {}; 317 318 my $count = $opts->{limit} || 0; 319 my $filter = $opts->{filter}; 320 my $md5 = $opts->{md5} || 0; # cdrake 321 my $filter_cb = $opts->{filter_cb}; 322 my $extract = $opts->{extract} || 0; 323 324 ### set a cap on the amount of files to extract ### 325 my $limit = 0; 326 $limit = 1 if $count > 0; 327 328 my $tarfile = [ ]; 329 my $chunk; 330 my $read = 0; 331 my $real_name; # to set the name of a file when 332 # we're encountering @longlink 333 my $data; 334 335 LOOP: 336 while( $handle->read( $chunk, HEAD ) ) { 337 ### IO::Zlib doesn't support this yet 338 my $offset; 339 if ( ref($handle) ne 'IO::Zlib' ) { 340 local $@; 341 $offset = eval { tell $handle } || 'unknown'; 342 $@ = ''; 343 } 344 else { 345 $offset = 'unknown'; 346 } 347 348 unless( $read++ ) { 349 my $gzip = GZIP_MAGIC_NUM; 350 if( $chunk =~ /$gzip/ ) { 351 $self->_error( qq[Cannot read compressed format in tar-mode] ); 352 return; 353 } 354 355 ### size is < HEAD, which means a corrupted file, as the minimum 356 ### length is _at least_ HEAD 357 if (length $chunk != HEAD) { 358 $self->_error( qq[Cannot read enough bytes from the tarfile] ); 359 return; 360 } 361 } 362 363 ### if we can't read in all bytes... ### 364 last if length $chunk != HEAD; 365 366 ### Apparently this should really be two blocks of 512 zeroes, 367 ### but GNU tar sometimes gets it wrong. See comment in the 368 ### source code (tar.c) to GNU cpio. 369 next if $chunk eq TAR_END; 370 371 ### according to the posix spec, the last 12 bytes of the header are 372 ### null bytes, to pad it to a 512 byte block. That means if these 373 ### bytes are NOT null bytes, it's a corrupt header. See: 374 ### www.koders.com/c/fidCE473AD3D9F835D690259D60AD5654591D91D5BA.aspx 375 ### line 111 376 { my $nulls = join '', "\0" x 12; 377 unless( $nulls eq substr( $chunk, 500, 12 ) ) { 378 $self->_error( qq[Invalid header block at offset $offset] ); 379 next LOOP; 380 } 381 } 382 383 ### pass the realname, so we can set it 'proper' right away 384 ### some of the heuristics are done on the name, so important 385 ### to set it ASAP 386 my $entry; 387 { my %extra_args = (); 388 $extra_args{'name'} = $$real_name if defined $real_name; 389 390 unless( $entry = Archive::Tar::File->new( chunk => $chunk, 391 %extra_args ) 392 ) { 393 $self->_error( qq[Couldn't read chunk at offset $offset] ); 394 next LOOP; 395 } 396 } 397 398 ### ignore labels: 399 ### http://www.gnu.org/software/tar/manual/html_chapter/Media.html#SEC159 400 next if $entry->is_label; 401 402 if( length $entry->type and ($entry->is_file || $entry->is_longlink) ) { 403 404 if ( $entry->is_file && !$entry->validate ) { 405 ### sometimes the chunk is rather fux0r3d and a whole 512 406 ### bytes ends up in the ->name area. 407 ### clean it up, if need be 408 my $name = $entry->name; 409 $name = substr($name, 0, 100) if length $name > 100; 410 $name =~ s/\n/ /g; 411 412 $self->_error( $name . qq[: checksum error] ); 413 next LOOP; 414 } 415 416 my $block = BLOCK_SIZE->( $entry->size ); 417 418 $data = $entry->get_content_by_ref; 419 420 my $skip = 0; 421 my $ctx; # cdrake 422 ### skip this entry if we're filtering 423 424 if($md5) { # cdrake 425 $ctx = Digest::MD5->new; # cdrake 426 $skip=5; # cdrake 427 428 } elsif ($filter && $entry->name !~ $filter) { 429 $skip = 1; 430 431 ### skip this entry if it's a pax header. This is a special file added 432 ### by, among others, git-generated tarballs. It holds comments and is 433 ### not meant for extracting. See #38932: pax_global_header extracted 434 } elsif ( $entry->name eq PAX_HEADER or $entry->type =~ /^(x|g)$/ ) { 435 $skip = 2; 436 } elsif ($filter_cb && ! $filter_cb->($entry)) { 437 $skip = 3; 438 } 439 440 if ($skip) { 441 # 442 # Since we're skipping, do not allocate memory for the 443 # whole file. Read it 64 BLOCKS at a time. Do not 444 # complete the skip yet because maybe what we read is a 445 # longlink and it won't get skipped after all 446 # 447 my $amt = $block; 448 my $fsz=$entry->size; # cdrake 449 while ($amt > 0) { 450 $$data = ''; 451 my $this = 64 * BLOCK; 452 $this = $amt if $this > $amt; 453 if( $handle->read( $$data, $this ) < $this ) { 454 $self->_error( qq[Read error on tarfile (missing data) ']. 455 $entry->full_path ."' at offset $offset" ); 456 next LOOP; 457 } 458 $amt -= $this; 459 $fsz -= $this; # cdrake 460 substr ($$data, $fsz) = "" if ($fsz<0); # remove external junk prior to md5 # cdrake 461 $ctx->add($$data) if($skip==5); # cdrake 462 } 463 $$data = $ctx->hexdigest if($skip==5 && !$entry->is_longlink && !$entry->is_unknown && !$entry->is_label ) ; # cdrake 464 } else { 465 466 ### just read everything into memory 467 ### can't do lazy loading since IO::Zlib doesn't support 'seek' 468 ### this is because Compress::Zlib doesn't support it =/ 469 ### this reads in the whole data in one read() call. 470 if ( $handle->read( $$data, $block ) < $block ) { 471 $self->_error( qq[Read error on tarfile (missing data) ']. 472 $entry->full_path ."' at offset $offset" ); 473 next LOOP; 474 } 475 ### throw away trailing garbage ### 476 substr ($$data, $entry->size) = "" if defined $$data; 477 } 478 479 ### part II of the @LongLink munging -- need to do /after/ 480 ### the checksum check. 481 if( $entry->is_longlink ) { 482 ### weird thing in tarfiles -- if the file is actually a 483 ### @LongLink, the data part seems to have a trailing ^@ 484 ### (unprintable) char. to display, pipe output through less. 485 ### but that doesn't *always* happen.. so check if the last 486 ### character is a control character, and if so remove it 487 ### at any rate, we better remove that character here, or tests 488 ### like 'eq' and hashlook ups based on names will SO not work 489 ### remove it by calculating the proper size, and then 490 ### tossing out everything that's longer than that size. 491 492 ### count number of nulls 493 my $nulls = $$data =~ tr/\0/\0/; 494 495 ### cut data + size by that many bytes 496 $entry->size( $entry->size - $nulls ); 497 substr ($$data, $entry->size) = ""; 498 } 499 } 500 501 ### clean up of the entries.. posix tar /apparently/ has some 502 ### weird 'feature' that allows for filenames > 255 characters 503 ### they'll put a header in with as name '././@LongLink' and the 504 ### contents will be the name of the /next/ file in the archive 505 ### pretty crappy and kludgy if you ask me 506 507 ### set the name for the next entry if this is a @LongLink; 508 ### this is one ugly hack =/ but needed for direct extraction 509 if( $entry->is_longlink ) { 510 $real_name = $data; 511 next LOOP; 512 } elsif ( defined $real_name ) { 513 $entry->name( $$real_name ); 514 $entry->prefix(''); 515 undef $real_name; 516 } 517 518 if ($filter && $entry->name !~ $filter) { 519 next LOOP; 520 521 ### skip this entry if it's a pax header. This is a special file added 522 ### by, among others, git-generated tarballs. It holds comments and is 523 ### not meant for extracting. See #38932: pax_global_header extracted 524 } elsif ( $entry->name eq PAX_HEADER or $entry->type =~ /^(x|g)$/ ) { 525 next LOOP; 526 } elsif ($filter_cb && ! $filter_cb->($entry)) { 527 next LOOP; 528 } 529 530 if ( $extract && !$entry->is_longlink 531 && !$entry->is_unknown 532 && !$entry->is_label ) { 533 $self->_extract_file( $entry ) or return; 534 } 535 536 ### Guard against tarfiles with garbage at the end 537 last LOOP if $entry->name eq ''; 538 539 ### push only the name on the rv if we're extracting 540 ### -- for extract_archive 541 push @$tarfile, ($extract ? $entry->name : $entry); 542 543 if( $limit ) { 544 $count-- unless $entry->is_longlink || $entry->is_dir; 545 last LOOP unless $count; 546 } 547 } continue { 548 undef $data; 549 } 550 551 return $tarfile; 552} 553 554=head2 $tar->contains_file( $filename ) 555 556Check if the archive contains a certain file. 557It will return true if the file is in the archive, false otherwise. 558 559Note however, that this function does an exact match using C<eq> 560on the full path. So it cannot compensate for case-insensitive file- 561systems or compare 2 paths to see if they would point to the same 562underlying file. 563 564=cut 565 566sub contains_file { 567 my $self = shift; 568 my $full = shift; 569 570 return unless defined $full; 571 572 ### don't warn if the entry isn't there.. that's what this function 573 ### is for after all. 574 local $WARN = 0; 575 return 1 if $self->_find_entry($full); 576 return; 577} 578 579=head2 $tar->extract( [@filenames] ) 580 581Write files whose names are equivalent to any of the names in 582C<@filenames> to disk, creating subdirectories as necessary. This 583might not work too well under VMS. 584Under MacPerl, the file's modification time will be converted to the 585MacOS zero of time, and appropriate conversions will be done to the 586path. However, the length of each element of the path is not 587inspected to see whether it's longer than MacOS currently allows (32 588characters). 589 590If C<extract> is called without a list of file names, the entire 591contents of the archive are extracted. 592 593Returns a list of filenames extracted. 594 595=cut 596 597sub extract { 598 my $self = shift; 599 my @args = @_; 600 my @files; 601 602 # use the speed optimization for all extracted files 603 local($self->{cwd}) = cwd() unless $self->{cwd}; 604 605 ### you requested the extraction of only certain files 606 if( @args ) { 607 for my $file ( @args ) { 608 609 ### it's already an object? 610 if( UNIVERSAL::isa( $file, 'Archive::Tar::File' ) ) { 611 push @files, $file; 612 next; 613 614 ### go find it then 615 } else { 616 617 my $found; 618 for my $entry ( @{$self->_data} ) { 619 next unless $file eq $entry->full_path; 620 621 ### we found the file you're looking for 622 push @files, $entry; 623 $found++; 624 } 625 626 unless( $found ) { 627 return $self->_error( 628 qq[Could not find '$file' in archive] ); 629 } 630 } 631 } 632 633 ### just grab all the file items 634 } else { 635 @files = $self->get_files; 636 } 637 638 ### nothing found? that's an error 639 unless( scalar @files ) { 640 $self->_error( qq[No files found for ] . $self->_file ); 641 return; 642 } 643 644 ### now extract them 645 for my $entry ( @files ) { 646 unless( $self->_extract_file( $entry ) ) { 647 $self->_error(q[Could not extract ']. $entry->full_path .q['] ); 648 return; 649 } 650 } 651 652 return @files; 653} 654 655=head2 $tar->extract_file( $file, [$extract_path] ) 656 657Write an entry, whose name is equivalent to the file name provided to 658disk. Optionally takes a second parameter, which is the full native 659path (including filename) the entry will be written to. 660 661For example: 662 663 $tar->extract_file( 'name/in/archive', 'name/i/want/to/give/it' ); 664 665 $tar->extract_file( $at_file_object, 'name/i/want/to/give/it' ); 666 667Returns true on success, false on failure. 668 669=cut 670 671sub extract_file { 672 my $self = shift; 673 my $file = shift; return unless defined $file; 674 my $alt = shift; 675 676 my $entry = $self->_find_entry( $file ) 677 or $self->_error( qq[Could not find an entry for '$file'] ), return; 678 679 return $self->_extract_file( $entry, $alt ); 680} 681 682sub _extract_file { 683 my $self = shift; 684 my $entry = shift or return; 685 my $alt = shift; 686 687 ### you wanted an alternate extraction location ### 688 my $name = defined $alt ? $alt : $entry->full_path; 689 690 ### splitpath takes a bool at the end to indicate 691 ### that it's splitting a dir 692 my ($vol,$dirs,$file); 693 if ( defined $alt ) { # It's a local-OS path 694 ($vol,$dirs,$file) = File::Spec->splitpath( $alt, 695 $entry->is_dir ); 696 } else { 697 ($vol,$dirs,$file) = File::Spec::Unix->splitpath( $name, 698 $entry->is_dir ); 699 } 700 701 my $dir; 702 ### is $name an absolute path? ### 703 if( $vol || File::Spec->file_name_is_absolute( $dirs ) ) { 704 705 ### absolute names are not allowed to be in tarballs under 706 ### strict mode, so only allow it if a user tells us to do it 707 if( not defined $alt and not $INSECURE_EXTRACT_MODE ) { 708 $self->_error( 709 q[Entry ']. $entry->full_path .q[' is an absolute path. ]. 710 q[Not extracting absolute paths under SECURE EXTRACT MODE] 711 ); 712 return; 713 } 714 715 ### user asked us to, it's fine. 716 $dir = File::Spec->catpath( $vol, $dirs, "" ); 717 718 ### it's a relative path ### 719 } else { 720 my $cwd = (ref $self and defined $self->{cwd}) 721 ? $self->{cwd} 722 : cwd(); 723 724 my @dirs = defined $alt 725 ? File::Spec->splitdir( $dirs ) # It's a local-OS path 726 : File::Spec::Unix->splitdir( $dirs ); # it's UNIX-style, likely 727 # straight from the tarball 728 729 if( not defined $alt and 730 not $INSECURE_EXTRACT_MODE 731 ) { 732 733 ### paths that leave the current directory are not allowed under 734 ### strict mode, so only allow it if a user tells us to do this. 735 if( grep { $_ eq '..' } @dirs ) { 736 737 $self->_error( 738 q[Entry ']. $entry->full_path .q[' is attempting to leave ]. 739 q[the current working directory. Not extracting under ]. 740 q[SECURE EXTRACT MODE] 741 ); 742 return; 743 } 744 745 ### the archive may be asking us to extract into a symlink. This 746 ### is not sane and a possible security issue, as outlined here: 747 ### https://rt.cpan.org/Ticket/Display.html?id=30380 748 ### https://bugzilla.redhat.com/show_bug.cgi?id=295021 749 ### https://issues.rpath.com/browse/RPL-1716 750 my $full_path = $cwd; 751 for my $d ( @dirs ) { 752 $full_path = File::Spec->catdir( $full_path, $d ); 753 754 ### we've already checked this one, and it's safe. Move on. 755 next if ref $self and $self->{_link_cache}->{$full_path}; 756 757 if( -l $full_path ) { 758 my $to = readlink $full_path; 759 my $diag = "symlinked directory ($full_path => $to)"; 760 761 $self->_error( 762 q[Entry ']. $entry->full_path .q[' is attempting to ]. 763 qq[extract to a $diag. This is considered a security ]. 764 q[vulnerability and not allowed under SECURE EXTRACT ]. 765 q[MODE] 766 ); 767 return; 768 } 769 770 ### XXX keep a cache if possible, so the stats become cheaper: 771 $self->{_link_cache}->{$full_path} = 1 if ref $self; 772 } 773 } 774 775 ### '.' is the directory delimiter on VMS, which has to be escaped 776 ### or changed to '_' on vms. vmsify is used, because older versions 777 ### of vmspath do not handle this properly. 778 ### Must not add a '/' to an empty directory though. 779 map { length() ? VMS::Filespec::vmsify($_.'/') : $_ } @dirs if ON_VMS; 780 781 my ($cwd_vol,$cwd_dir,$cwd_file) 782 = File::Spec->splitpath( $cwd ); 783 my @cwd = File::Spec->splitdir( $cwd_dir ); 784 push @cwd, $cwd_file if length $cwd_file; 785 786 ### We need to pass '' as the last element to catpath. Craig Berry 787 ### explains why (msgid <p0624083dc311ae541393@[172.16.52.1]>): 788 ### The root problem is that splitpath on UNIX always returns the 789 ### final path element as a file even if it is a directory, and of 790 ### course there is no way it can know the difference without checking 791 ### against the filesystem, which it is documented as not doing. When 792 ### you turn around and call catpath, on VMS you have to know which bits 793 ### are directory bits and which bits are file bits. In this case we 794 ### know the result should be a directory. I had thought you could omit 795 ### the file argument to catpath in such a case, but apparently on UNIX 796 ### you can't. 797 $dir = File::Spec->catpath( 798 $cwd_vol, File::Spec->catdir( @cwd, @dirs ), '' 799 ); 800 801 ### catdir() returns undef if the path is longer than 255 chars on 802 ### older VMS systems. 803 unless ( defined $dir ) { 804 $^W && $self->_error( qq[Could not compose a path for '$dirs'\n] ); 805 return; 806 } 807 808 } 809 810 if( -e $dir && !-d _ ) { 811 $^W && $self->_error( qq['$dir' exists, but it's not a directory!\n] ); 812 return; 813 } 814 815 unless ( -d _ ) { 816 eval { File::Path::mkpath( $dir, 0, 0777 ) }; 817 if( $@ ) { 818 my $fp = $entry->full_path; 819 $self->_error(qq[Could not create directory '$dir' for '$fp': $@]); 820 return; 821 } 822 823 ### XXX chown here? that might not be the same as in the archive 824 ### as we're only chown'ing to the owner of the file we're extracting 825 ### not to the owner of the directory itself, which may or may not 826 ### be another entry in the archive 827 ### Answer: no, gnu tar doesn't do it either, it'd be the wrong 828 ### way to go. 829 #if( $CHOWN && CAN_CHOWN ) { 830 # chown $entry->uid, $entry->gid, $dir or 831 # $self->_error( qq[Could not set uid/gid on '$dir'] ); 832 #} 833 } 834 835 ### we're done if we just needed to create a dir ### 836 return 1 if $entry->is_dir; 837 838 my $full = File::Spec->catfile( $dir, $file ); 839 840 if( $entry->is_unknown ) { 841 $self->_error( qq[Unknown file type for file '$full'] ); 842 return; 843 } 844 845 if( length $entry->type && $entry->is_file ) { 846 my $fh = IO::File->new; 847 $fh->open( '>' . $full ) or ( 848 $self->_error( qq[Could not open file '$full': $!] ), 849 return 850 ); 851 852 if( $entry->size ) { 853 binmode $fh; 854 syswrite $fh, $entry->data or ( 855 $self->_error( qq[Could not write data to '$full'] ), 856 return 857 ); 858 } 859 860 close $fh or ( 861 $self->_error( qq[Could not close file '$full'] ), 862 return 863 ); 864 865 } else { 866 $self->_make_special_file( $entry, $full ) or return; 867 } 868 869 ### only update the timestamp if it's not a symlink; that will change the 870 ### timestamp of the original. This addresses bug #33669: Could not update 871 ### timestamp warning on symlinks 872 if( not -l $full ) { 873 utime time, $entry->mtime - TIME_OFFSET, $full or 874 $self->_error( qq[Could not update timestamp] ); 875 } 876 877 if( $CHOWN && CAN_CHOWN->() and not -l $full ) { 878 chown $entry->uid, $entry->gid, $full or 879 $self->_error( qq[Could not set uid/gid on '$full'] ); 880 } 881 882 ### only chmod if we're allowed to, but never chmod symlinks, since they'll 883 ### change the perms on the file they're linking too... 884 if( $CHMOD and not -l $full ) { 885 my $mode = $entry->mode; 886 unless ($SAME_PERMISSIONS) { 887 $mode &= ~(oct(7000) | umask); 888 } 889 chmod $mode, $full or 890 $self->_error( qq[Could not chown '$full' to ] . $entry->mode ); 891 } 892 893 return 1; 894} 895 896sub _make_special_file { 897 my $self = shift; 898 my $entry = shift or return; 899 my $file = shift; return unless defined $file; 900 901 my $err; 902 903 if( $entry->is_symlink ) { 904 my $fail; 905 if( ON_UNIX ) { 906 symlink( $entry->linkname, $file ) or $fail++; 907 908 } else { 909 $self->_extract_special_file_as_plain_file( $entry, $file ) 910 or $fail++; 911 } 912 913 $err = qq[Making symbolic link '$file' to '] . 914 $entry->linkname .q[' failed] if $fail; 915 916 } elsif ( $entry->is_hardlink ) { 917 my $fail; 918 if( ON_UNIX ) { 919 link( $entry->linkname, $file ) or $fail++; 920 921 } else { 922 $self->_extract_special_file_as_plain_file( $entry, $file ) 923 or $fail++; 924 } 925 926 $err = qq[Making hard link from '] . $entry->linkname . 927 qq[' to '$file' failed] if $fail; 928 929 } elsif ( $entry->is_fifo ) { 930 ON_UNIX && !system('mknod', $file, 'p') or 931 $err = qq[Making fifo ']. $entry->name .qq[' failed]; 932 933 } elsif ( $entry->is_blockdev or $entry->is_chardev ) { 934 my $mode = $entry->is_blockdev ? 'b' : 'c'; 935 936 ON_UNIX && !system('mknod', $file, $mode, 937 $entry->devmajor, $entry->devminor) or 938 $err = qq[Making block device ']. $entry->name .qq[' (maj=] . 939 $entry->devmajor . qq[ min=] . $entry->devminor . 940 qq[) failed.]; 941 942 } elsif ( $entry->is_socket ) { 943 ### the original doesn't do anything special for sockets.... ### 944 1; 945 } 946 947 return $err ? $self->_error( $err ) : 1; 948} 949 950### don't know how to make symlinks, let's just extract the file as 951### a plain file 952sub _extract_special_file_as_plain_file { 953 my $self = shift; 954 my $entry = shift or return; 955 my $file = shift; return unless defined $file; 956 957 my $err; 958 TRY: { 959 my $orig = $self->_find_entry( $entry->linkname ); 960 961 unless( $orig ) { 962 $err = qq[Could not find file '] . $entry->linkname . 963 qq[' in memory.]; 964 last TRY; 965 } 966 967 ### clone the entry, make it appear as a normal file ### 968 my $clone = $entry->clone; 969 $clone->_downgrade_to_plainfile; 970 $self->_extract_file( $clone, $file ) or last TRY; 971 972 return 1; 973 } 974 975 return $self->_error($err); 976} 977 978=head2 $tar->list_files( [\@properties] ) 979 980Returns a list of the names of all the files in the archive. 981 982If C<list_files()> is passed an array reference as its first argument 983it returns a list of hash references containing the requested 984properties of each file. The following list of properties is 985supported: name, size, mtime (last modified date), mode, uid, gid, 986linkname, uname, gname, devmajor, devminor, prefix. 987 988Passing an array reference containing only one element, 'name', is 989special cased to return a list of names rather than a list of hash 990references, making it equivalent to calling C<list_files> without 991arguments. 992 993=cut 994 995sub list_files { 996 my $self = shift; 997 my $aref = shift || [ ]; 998 999 unless( $self->_data ) { 1000 $self->read() or return; 1001 } 1002 1003 if( @$aref == 0 or ( @$aref == 1 and $aref->[0] eq 'name' ) ) { 1004 return map { $_->full_path } @{$self->_data}; 1005 } else { 1006 1007 #my @rv; 1008 #for my $obj ( @{$self->_data} ) { 1009 # push @rv, { map { $_ => $obj->$_() } @$aref }; 1010 #} 1011 #return @rv; 1012 1013 ### this does the same as the above.. just needs a +{ } 1014 ### to make sure perl doesn't confuse it for a block 1015 return map { my $o=$_; 1016 +{ map { $_ => $o->$_() } @$aref } 1017 } @{$self->_data}; 1018 } 1019} 1020 1021sub _find_entry { 1022 my $self = shift; 1023 my $file = shift; 1024 1025 unless( defined $file ) { 1026 $self->_error( qq[No file specified] ); 1027 return; 1028 } 1029 1030 ### it's an object already 1031 return $file if UNIVERSAL::isa( $file, 'Archive::Tar::File' ); 1032 1033 for my $entry ( @{$self->_data} ) { 1034 my $path = $entry->full_path; 1035 return $entry if $path eq $file; 1036 } 1037 1038 $self->_error( qq[No such file in archive: '$file'] ); 1039 return; 1040} 1041 1042=head2 $tar->get_files( [@filenames] ) 1043 1044Returns the C<Archive::Tar::File> objects matching the filenames 1045provided. If no filename list was passed, all C<Archive::Tar::File> 1046objects in the current Tar object are returned. 1047 1048Please refer to the C<Archive::Tar::File> documentation on how to 1049handle these objects. 1050 1051=cut 1052 1053sub get_files { 1054 my $self = shift; 1055 1056 return @{ $self->_data } unless @_; 1057 1058 my @list; 1059 for my $file ( @_ ) { 1060 push @list, grep { defined } $self->_find_entry( $file ); 1061 } 1062 1063 return @list; 1064} 1065 1066=head2 $tar->get_content( $file ) 1067 1068Return the content of the named file. 1069 1070=cut 1071 1072sub get_content { 1073 my $self = shift; 1074 my $entry = $self->_find_entry( shift ) or return; 1075 1076 return $entry->data; 1077} 1078 1079=head2 $tar->replace_content( $file, $content ) 1080 1081Make the string $content be the content for the file named $file. 1082 1083=cut 1084 1085sub replace_content { 1086 my $self = shift; 1087 my $entry = $self->_find_entry( shift ) or return; 1088 1089 return $entry->replace_content( shift ); 1090} 1091 1092=head2 $tar->rename( $file, $new_name ) 1093 1094Rename the file of the in-memory archive to $new_name. 1095 1096Note that you must specify a Unix path for $new_name, since per tar 1097standard, all files in the archive must be Unix paths. 1098 1099Returns true on success and false on failure. 1100 1101=cut 1102 1103sub rename { 1104 my $self = shift; 1105 my $file = shift; return unless defined $file; 1106 my $new = shift; return unless defined $new; 1107 1108 my $entry = $self->_find_entry( $file ) or return; 1109 1110 return $entry->rename( $new ); 1111} 1112 1113=head2 $tar->chmod( $file, $mode ) 1114 1115Change mode of $file to $mode. 1116 1117Returns true on success and false on failure. 1118 1119=cut 1120 1121sub chmod { 1122 my $self = shift; 1123 my $file = shift; return unless defined $file; 1124 my $mode = shift; return unless defined $mode && $mode =~ /^[0-7]{1,4}$/; 1125 my @args = ("$mode"); 1126 1127 my $entry = $self->_find_entry( $file ) or return; 1128 my $x = $entry->chmod( @args ); 1129 return $x; 1130} 1131 1132=head2 $tar->chown( $file, $uname [, $gname] ) 1133 1134Change owner $file to $uname and $gname. 1135 1136Returns true on success and false on failure. 1137 1138=cut 1139 1140sub chown { 1141 my $self = shift; 1142 my $file = shift; return unless defined $file; 1143 my $uname = shift; return unless defined $uname; 1144 my @args = ($uname); 1145 push(@args, shift); 1146 1147 my $entry = $self->_find_entry( $file ) or return; 1148 my $x = $entry->chown( @args ); 1149 return $x; 1150} 1151 1152=head2 $tar->remove (@filenamelist) 1153 1154Removes any entries with names matching any of the given filenames 1155from the in-memory archive. Returns a list of C<Archive::Tar::File> 1156objects that remain. 1157 1158=cut 1159 1160sub remove { 1161 my $self = shift; 1162 my @list = @_; 1163 1164 my %seen = map { $_->full_path => $_ } @{$self->_data}; 1165 delete $seen{ $_ } for @list; 1166 1167 $self->_data( [values %seen] ); 1168 1169 return values %seen; 1170} 1171 1172=head2 $tar->clear 1173 1174C<clear> clears the current in-memory archive. This effectively gives 1175you a 'blank' object, ready to be filled again. Note that C<clear> 1176only has effect on the object, not the underlying tarfile. 1177 1178=cut 1179 1180sub clear { 1181 my $self = shift or return; 1182 1183 $self->_data( [] ); 1184 $self->_file( '' ); 1185 1186 return 1; 1187} 1188 1189 1190=head2 $tar->write ( [$file, $compressed, $prefix] ) 1191 1192Write the in-memory archive to disk. The first argument can either 1193be the name of a file or a reference to an already open filehandle (a 1194GLOB reference). 1195 1196The second argument is used to indicate compression. You can either 1197compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed 1198to be the C<gzip> compression level (between 1 and 9), but the use of 1199constants is preferred: 1200 1201 # write a gzip compressed file 1202 $tar->write( 'out.tgz', COMPRESS_GZIP ); 1203 1204 # write a bzip compressed file 1205 $tar->write( 'out.tbz', COMPRESS_BZIP ); 1206 1207Note that when you pass in a filehandle, the compression argument 1208is ignored, as all files are printed verbatim to your filehandle. 1209If you wish to enable compression with filehandles, use an 1210C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead. 1211 1212The third argument is an optional prefix. All files will be tucked 1213away in the directory you specify as prefix. So if you have files 1214'a' and 'b' in your archive, and you specify 'foo' as prefix, they 1215will be written to the archive as 'foo/a' and 'foo/b'. 1216 1217If no arguments are given, C<write> returns the entire formatted 1218archive as a string, which could be useful if you'd like to stuff the 1219archive into a socket or a pipe to gzip or something. 1220 1221 1222=cut 1223 1224sub write { 1225 my $self = shift; 1226 my $file = shift; $file = '' unless defined $file; 1227 my $gzip = shift || 0; 1228 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix; 1229 my $dummy = ''; 1230 1231 ### only need a handle if we have a file to print to ### 1232 my $handle = length($file) 1233 ? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) ) 1234 or return ) 1235 : $HAS_PERLIO ? do { open my $h, '>', \$dummy; $h } 1236 : $HAS_IO_STRING ? IO::String->new 1237 : __PACKAGE__->no_string_support(); 1238 1239 ### Addresses: #41798: Nonempty $\ when writing a TAR file produces a 1240 ### corrupt TAR file. Must clear out $\ to make sure no garbage is 1241 ### printed to the archive 1242 local $\; 1243 1244 for my $entry ( @{$self->_data} ) { 1245 ### entries to be written to the tarfile ### 1246 my @write_me; 1247 1248 ### only now will we change the object to reflect the current state 1249 ### of the name and prefix fields -- this needs to be limited to 1250 ### write() only! 1251 my $clone = $entry->clone; 1252 1253 1254 ### so, if you don't want use to use the prefix, we'll stuff 1255 ### everything in the name field instead 1256 if( $DO_NOT_USE_PREFIX ) { 1257 1258 ### you might have an extended prefix, if so, set it in the clone 1259 ### XXX is ::Unix right? 1260 $clone->name( length $ext_prefix 1261 ? File::Spec::Unix->catdir( $ext_prefix, 1262 $clone->full_path) 1263 : $clone->full_path ); 1264 $clone->prefix( '' ); 1265 1266 ### otherwise, we'll have to set it properly -- prefix part in the 1267 ### prefix and name part in the name field. 1268 } else { 1269 1270 ### split them here, not before! 1271 my ($prefix,$name) = $clone->_prefix_and_file( $clone->full_path ); 1272 1273 ### you might have an extended prefix, if so, set it in the clone 1274 ### XXX is ::Unix right? 1275 $prefix = File::Spec::Unix->catdir( $ext_prefix, $prefix ) 1276 if length $ext_prefix; 1277 1278 $clone->prefix( $prefix ); 1279 $clone->name( $name ); 1280 } 1281 1282 ### names are too long, and will get truncated if we don't add a 1283 ### '@LongLink' file... 1284 my $make_longlink = ( length($clone->name) > NAME_LENGTH or 1285 length($clone->prefix) > PREFIX_LENGTH 1286 ) || 0; 1287 1288 ### perhaps we need to make a longlink file? 1289 if( $make_longlink ) { 1290 my $longlink = Archive::Tar::File->new( 1291 data => LONGLINK_NAME, 1292 $clone->full_path, 1293 { type => LONGLINK } 1294 ); 1295 1296 unless( $longlink ) { 1297 $self->_error( qq[Could not create 'LongLink' entry for ] . 1298 qq[oversize file '] . $clone->full_path ."'" ); 1299 return; 1300 }; 1301 1302 push @write_me, $longlink; 1303 } 1304 1305 push @write_me, $clone; 1306 1307 ### write the one, optionally 2 a::t::file objects to the handle 1308 for my $clone (@write_me) { 1309 1310 ### if the file is a symlink, there are 2 options: 1311 ### either we leave the symlink intact, but then we don't write any 1312 ### data OR we follow the symlink, which means we actually make a 1313 ### copy. if we do the latter, we have to change the TYPE of the 1314 ### clone to 'FILE' 1315 my $link_ok = $clone->is_symlink && $Archive::Tar::FOLLOW_SYMLINK; 1316 my $data_ok = !$clone->is_symlink && $clone->has_content; 1317 1318 ### downgrade to a 'normal' file if it's a symlink we're going to 1319 ### treat as a regular file 1320 $clone->_downgrade_to_plainfile if $link_ok; 1321 1322 ### get the header for this block 1323 my $header = $self->_format_tar_entry( $clone ); 1324 unless( $header ) { 1325 $self->_error(q[Could not format header for: ] . 1326 $clone->full_path ); 1327 return; 1328 } 1329 1330 unless( print $handle $header ) { 1331 $self->_error(q[Could not write header for: ] . 1332 $clone->full_path); 1333 return; 1334 } 1335 1336 if( $link_ok or $data_ok ) { 1337 unless( print $handle $clone->data ) { 1338 $self->_error(q[Could not write data for: ] . 1339 $clone->full_path); 1340 return; 1341 } 1342 1343 ### pad the end of the clone if required ### 1344 print $handle TAR_PAD->( $clone->size ) if $clone->size % BLOCK 1345 } 1346 1347 } ### done writing these entries 1348 } 1349 1350 ### write the end markers ### 1351 print $handle TAR_END x 2 or 1352 return $self->_error( qq[Could not write tar end markers] ); 1353 1354 ### did you want it written to a file, or returned as a string? ### 1355 my $rv = length($file) ? 1 1356 : $HAS_PERLIO ? $dummy 1357 : do { seek $handle, 0, 0; local $/; <$handle> }; 1358 1359 ### make sure to close the handle if we created it 1360 if ( $file ne $handle ) { 1361 unless( close $handle ) { 1362 $self->_error( qq[Could not write tar] ); 1363 return; 1364 } 1365 } 1366 1367 return $rv; 1368} 1369 1370sub _format_tar_entry { 1371 my $self = shift; 1372 my $entry = shift or return; 1373 my $ext_prefix = shift; $ext_prefix = '' unless defined $ext_prefix; 1374 my $no_prefix = shift || 0; 1375 1376 my $file = $entry->name; 1377 my $prefix = $entry->prefix; $prefix = '' unless defined $prefix; 1378 1379 ### remove the prefix from the file name 1380 ### not sure if this is still needed --kane 1381 ### no it's not -- Archive::Tar::File->_new_from_file will take care of 1382 ### this for us. Even worse, this would break if we tried to add a file 1383 ### like x/x. 1384 #if( length $prefix ) { 1385 # $file =~ s/^$match//; 1386 #} 1387 1388 $prefix = File::Spec::Unix->catdir($ext_prefix, $prefix) 1389 if length $ext_prefix; 1390 1391 ### not sure why this is... ### 1392 my $l = PREFIX_LENGTH; # is ambiguous otherwise... 1393 substr ($prefix, 0, -$l) = "" if length $prefix >= PREFIX_LENGTH; 1394 1395 my $f1 = "%06o"; my $f2 = $ZERO_PAD_NUMBERS ? "%011o" : "%11o"; 1396 1397 ### this might be optimizable with a 'changed' flag in the file objects ### 1398 my $tar = pack ( 1399 PACK, 1400 $file, 1401 1402 (map { sprintf( $f1, $entry->$_() ) } qw[mode uid gid]), 1403 (map { sprintf( $f2, $entry->$_() ) } qw[size mtime]), 1404 1405 "", # checksum field - space padded a bit down 1406 1407 (map { $entry->$_() } qw[type linkname magic]), 1408 1409 $entry->version || TAR_VERSION, 1410 1411 (map { $entry->$_() } qw[uname gname]), 1412 (map { sprintf( $f1, $entry->$_() ) } qw[devmajor devminor]), 1413 1414 ($no_prefix ? '' : $prefix) 1415 ); 1416 1417 ### add the checksum ### 1418 my $checksum_fmt = $ZERO_PAD_NUMBERS ? "%06o\0" : "%06o\0"; 1419 substr($tar,148,7) = sprintf("%6o\0", unpack("%16C*",$tar)); 1420 1421 return $tar; 1422} 1423 1424=head2 $tar->add_files( @filenamelist ) 1425 1426Takes a list of filenames and adds them to the in-memory archive. 1427 1428The path to the file is automatically converted to a Unix like 1429equivalent for use in the archive, and, if on MacOS, the file's 1430modification time is converted from the MacOS epoch to the Unix epoch. 1431So tar archives created on MacOS with B<Archive::Tar> can be read 1432both with I<tar> on Unix and applications like I<suntar> or 1433I<Stuffit Expander> on MacOS. 1434 1435Be aware that the file's type/creator and resource fork will be lost, 1436which is usually what you want in cross-platform archives. 1437 1438Instead of a filename, you can also pass it an existing C<Archive::Tar::File> 1439object from, for example, another archive. The object will be clone, and 1440effectively be a copy of the original, not an alias. 1441 1442Returns a list of C<Archive::Tar::File> objects that were just added. 1443 1444=cut 1445 1446sub add_files { 1447 my $self = shift; 1448 my @files = @_ or return; 1449 1450 my @rv; 1451 for my $file ( @files ) { 1452 1453 ### you passed an Archive::Tar::File object 1454 ### clone it so we don't accidentally have a reference to 1455 ### an object from another archive 1456 if( UNIVERSAL::isa( $file,'Archive::Tar::File' ) ) { 1457 push @rv, $file->clone; 1458 next; 1459 } 1460 1461 eval { 1462 if( utf8::is_utf8( $file )) { 1463 utf8::encode( $file ); 1464 } 1465 }; 1466 1467 unless( -e $file || -l $file ) { 1468 $self->_error( qq[No such file: '$file'] ); 1469 next; 1470 } 1471 1472 my $obj = Archive::Tar::File->new( file => $file ); 1473 unless( $obj ) { 1474 $self->_error( qq[Unable to add file: '$file'] ); 1475 next; 1476 } 1477 1478 push @rv, $obj; 1479 } 1480 1481 push @{$self->{_data}}, @rv; 1482 1483 return @rv; 1484} 1485 1486=head2 $tar->add_data ( $filename, $data, [$opthashref] ) 1487 1488Takes a filename, a scalar full of data and optionally a reference to 1489a hash with specific options. 1490 1491Will add a file to the in-memory archive, with name C<$filename> and 1492content C<$data>. Specific properties can be set using C<$opthashref>. 1493The following list of properties is supported: name, size, mtime 1494(last modified date), mode, uid, gid, linkname, uname, gname, 1495devmajor, devminor, prefix, type. (On MacOS, the file's path and 1496modification times are converted to Unix equivalents.) 1497 1498Valid values for the file type are the following constants defined by 1499Archive::Tar::Constant: 1500 1501=over 4 1502 1503=item FILE 1504 1505Regular file. 1506 1507=item HARDLINK 1508 1509=item SYMLINK 1510 1511Hard and symbolic ("soft") links; linkname should specify target. 1512 1513=item CHARDEV 1514 1515=item BLOCKDEV 1516 1517Character and block devices. devmajor and devminor should specify the major 1518and minor device numbers. 1519 1520=item DIR 1521 1522Directory. 1523 1524=item FIFO 1525 1526FIFO (named pipe). 1527 1528=item SOCKET 1529 1530Socket. 1531 1532=back 1533 1534Returns the C<Archive::Tar::File> object that was just added, or 1535C<undef> on failure. 1536 1537=cut 1538 1539sub add_data { 1540 my $self = shift; 1541 my ($file, $data, $opt) = @_; 1542 1543 my $obj = Archive::Tar::File->new( data => $file, $data, $opt ); 1544 unless( $obj ) { 1545 $self->_error( qq[Unable to add file: '$file'] ); 1546 return; 1547 } 1548 1549 push @{$self->{_data}}, $obj; 1550 1551 return $obj; 1552} 1553 1554=head2 $tar->error( [$BOOL] ) 1555 1556Returns the current errorstring (usually, the last error reported). 1557If a true value was specified, it will give the C<Carp::longmess> 1558equivalent of the error, in effect giving you a stacktrace. 1559 1560For backwards compatibility, this error is also available as 1561C<$Archive::Tar::error> although it is much recommended you use the 1562method call instead. 1563 1564=cut 1565 1566{ 1567 $error = ''; 1568 my $longmess; 1569 1570 sub _error { 1571 my $self = shift; 1572 my $msg = $error = shift; 1573 $longmess = Carp::longmess($error); 1574 if (ref $self) { 1575 $self->{_error} = $error; 1576 $self->{_longmess} = $longmess; 1577 } 1578 1579 ### set Archive::Tar::WARN to 0 to disable printing 1580 ### of errors 1581 if( $WARN ) { 1582 carp $DEBUG ? $longmess : $msg; 1583 } 1584 1585 return; 1586 } 1587 1588 sub error { 1589 my $self = shift; 1590 if (ref $self) { 1591 return shift() ? $self->{_longmess} : $self->{_error}; 1592 } else { 1593 return shift() ? $longmess : $error; 1594 } 1595 } 1596} 1597 1598=head2 $tar->setcwd( $cwd ); 1599 1600C<Archive::Tar> needs to know the current directory, and it will run 1601C<Cwd::cwd()> I<every> time it extracts a I<relative> entry from the 1602tarfile and saves it in the file system. (As of version 1.30, however, 1603C<Archive::Tar> will use the speed optimization described below 1604automatically, so it's only relevant if you're using C<extract_file()>). 1605 1606Since C<Archive::Tar> doesn't change the current directory internally 1607while it is extracting the items in a tarball, all calls to C<Cwd::cwd()> 1608can be avoided if we can guarantee that the current directory doesn't 1609get changed externally. 1610 1611To use this performance boost, set the current directory via 1612 1613 use Cwd; 1614 $tar->setcwd( cwd() ); 1615 1616once before calling a function like C<extract_file> and 1617C<Archive::Tar> will use the current directory setting from then on 1618and won't call C<Cwd::cwd()> internally. 1619 1620To switch back to the default behaviour, use 1621 1622 $tar->setcwd( undef ); 1623 1624and C<Archive::Tar> will call C<Cwd::cwd()> internally again. 1625 1626If you're using C<Archive::Tar>'s C<extract()> method, C<setcwd()> will 1627be called for you. 1628 1629=cut 1630 1631sub setcwd { 1632 my $self = shift; 1633 my $cwd = shift; 1634 1635 $self->{cwd} = $cwd; 1636} 1637 1638=head1 Class Methods 1639 1640=head2 Archive::Tar->create_archive($file, $compressed, @filelist) 1641 1642Creates a tar file from the list of files provided. The first 1643argument can either be the name of the tar file to create or a 1644reference to an open file handle (e.g. a GLOB reference). 1645 1646The second argument is used to indicate compression. You can either 1647compress using C<gzip> or C<bzip2>. If you pass a digit, it's assumed 1648to be the C<gzip> compression level (between 1 and 9), but the use of 1649constants is preferred: 1650 1651 # write a gzip compressed file 1652 Archive::Tar->create_archive( 'out.tgz', COMPRESS_GZIP, @filelist ); 1653 1654 # write a bzip compressed file 1655 Archive::Tar->create_archive( 'out.tbz', COMPRESS_BZIP, @filelist ); 1656 1657Note that when you pass in a filehandle, the compression argument 1658is ignored, as all files are printed verbatim to your filehandle. 1659If you wish to enable compression with filehandles, use an 1660C<IO::Zlib> or C<IO::Compress::Bzip2> filehandle instead. 1661 1662The remaining arguments list the files to be included in the tar file. 1663These files must all exist. Any files which don't exist or can't be 1664read are silently ignored. 1665 1666If the archive creation fails for any reason, C<create_archive> will 1667return false. Please use the C<error> method to find the cause of the 1668failure. 1669 1670Note that this method does not write C<on the fly> as it were; it 1671still reads all the files into memory before writing out the archive. 1672Consult the FAQ below if this is a problem. 1673 1674=cut 1675 1676sub create_archive { 1677 my $class = shift; 1678 1679 my $file = shift; return unless defined $file; 1680 my $gzip = shift || 0; 1681 my @files = @_; 1682 1683 unless( @files ) { 1684 return $class->_error( qq[Cowardly refusing to create empty archive!] ); 1685 } 1686 1687 my $tar = $class->new; 1688 $tar->add_files( @files ); 1689 return $tar->write( $file, $gzip ); 1690} 1691 1692=head2 Archive::Tar->iter( $filename, [ $compressed, {opt => $val} ] ) 1693 1694Returns an iterator function that reads the tar file without loading 1695it all in memory. Each time the function is called it will return the 1696next file in the tarball. The files are returned as 1697C<Archive::Tar::File> objects. The iterator function returns the 1698empty list once it has exhausted the files contained. 1699 1700The second argument can be a hash reference with options, which are 1701identical to the arguments passed to C<read()>. 1702 1703Example usage: 1704 1705 my $next = Archive::Tar->iter( "example.tar.gz", 1, {filter => qr/\.pm$/} ); 1706 1707 while( my $f = $next->() ) { 1708 print $f->name, "\n"; 1709 1710 $f->extract or warn "Extraction failed"; 1711 1712 # .... 1713 } 1714 1715=cut 1716 1717 1718sub iter { 1719 my $class = shift; 1720 my $filename = shift or return; 1721 my $compressed = shift || 0; 1722 my $opts = shift || {}; 1723 1724 ### get a handle to read from. 1725 my $handle = $class->_get_handle( 1726 $filename, 1727 $compressed, 1728 READ_ONLY->( ZLIB ) 1729 ) or return; 1730 1731 my @data; 1732 return sub { 1733 return shift(@data) if @data; # more than one file returned? 1734 return unless $handle; # handle exhausted? 1735 1736 ### read data, should only return file 1737 my $tarfile = $class->_read_tar($handle, { %$opts, limit => 1 }); 1738 @data = @$tarfile if ref $tarfile && ref $tarfile eq 'ARRAY'; 1739 1740 ### return one piece of data 1741 return shift(@data) if @data; 1742 1743 ### data is exhausted, free the filehandle 1744 undef $handle; 1745 return; 1746 }; 1747} 1748 1749=head2 Archive::Tar->list_archive($file, $compressed, [\@properties]) 1750 1751Returns a list of the names of all the files in the archive. The 1752first argument can either be the name of the tar file to list or a 1753reference to an open file handle (e.g. a GLOB reference). 1754 1755If C<list_archive()> is passed an array reference as its third 1756argument it returns a list of hash references containing the requested 1757properties of each file. The following list of properties is 1758supported: full_path, name, size, mtime (last modified date), mode, 1759uid, gid, linkname, uname, gname, devmajor, devminor, prefix, type. 1760 1761See C<Archive::Tar::File> for details about supported properties. 1762 1763Passing an array reference containing only one element, 'name', is 1764special cased to return a list of names rather than a list of hash 1765references. 1766 1767=cut 1768 1769sub list_archive { 1770 my $class = shift; 1771 my $file = shift; return unless defined $file; 1772 my $gzip = shift || 0; 1773 1774 my $tar = $class->new($file, $gzip); 1775 return unless $tar; 1776 1777 return $tar->list_files( @_ ); 1778} 1779 1780=head2 Archive::Tar->extract_archive($file, $compressed) 1781 1782Extracts the contents of the tar file. The first argument can either 1783be the name of the tar file to create or a reference to an open file 1784handle (e.g. a GLOB reference). All relative paths in the tar file will 1785be created underneath the current working directory. 1786 1787C<extract_archive> will return a list of files it extracted. 1788If the archive extraction fails for any reason, C<extract_archive> 1789will return false. Please use the C<error> method to find the cause 1790of the failure. 1791 1792=cut 1793 1794sub extract_archive { 1795 my $class = shift; 1796 my $file = shift; return unless defined $file; 1797 my $gzip = shift || 0; 1798 1799 my $tar = $class->new( ) or return; 1800 1801 return $tar->read( $file, $gzip, { extract => 1 } ); 1802} 1803 1804=head2 $bool = Archive::Tar->has_io_string 1805 1806Returns true if we currently have C<IO::String> support loaded. 1807 1808Either C<IO::String> or C<perlio> support is needed to support writing 1809stringified archives. Currently, C<perlio> is the preferred method, if 1810available. 1811 1812See the C<GLOBAL VARIABLES> section to see how to change this preference. 1813 1814=cut 1815 1816sub has_io_string { return $HAS_IO_STRING; } 1817 1818=head2 $bool = Archive::Tar->has_perlio 1819 1820Returns true if we currently have C<perlio> support loaded. 1821 1822This requires C<perl-5.8> or higher, compiled with C<perlio> 1823 1824Either C<IO::String> or C<perlio> support is needed to support writing 1825stringified archives. Currently, C<perlio> is the preferred method, if 1826available. 1827 1828See the C<GLOBAL VARIABLES> section to see how to change this preference. 1829 1830=cut 1831 1832sub has_perlio { return $HAS_PERLIO; } 1833 1834=head2 $bool = Archive::Tar->has_zlib_support 1835 1836Returns true if C<Archive::Tar> can extract C<zlib> compressed archives 1837 1838=cut 1839 1840sub has_zlib_support { return ZLIB } 1841 1842=head2 $bool = Archive::Tar->has_bzip2_support 1843 1844Returns true if C<Archive::Tar> can extract C<bzip2> compressed archives 1845 1846=cut 1847 1848sub has_bzip2_support { return BZIP } 1849 1850=head2 Archive::Tar->can_handle_compressed_files 1851 1852A simple checking routine, which will return true if C<Archive::Tar> 1853is able to uncompress compressed archives on the fly with C<IO::Zlib> 1854and C<IO::Compress::Bzip2> or false if not both are installed. 1855 1856You can use this as a shortcut to determine whether C<Archive::Tar> 1857will do what you think before passing compressed archives to its 1858C<read> method. 1859 1860=cut 1861 1862sub can_handle_compressed_files { return ZLIB && BZIP ? 1 : 0 } 1863 1864sub no_string_support { 1865 croak("You have to install IO::String to support writing archives to strings"); 1866} 1867 18681; 1869 1870__END__ 1871 1872=head1 GLOBAL VARIABLES 1873 1874=head2 $Archive::Tar::FOLLOW_SYMLINK 1875 1876Set this variable to C<1> to make C<Archive::Tar> effectively make a 1877copy of the file when extracting. Default is C<0>, which 1878means the symlink stays intact. Of course, you will have to pack the 1879file linked to as well. 1880 1881This option is checked when you write out the tarfile using C<write> 1882or C<create_archive>. 1883 1884This works just like C</bin/tar>'s C<-h> option. 1885 1886=head2 $Archive::Tar::CHOWN 1887 1888By default, C<Archive::Tar> will try to C<chown> your files if it is 1889able to. In some cases, this may not be desired. In that case, set 1890this variable to C<0> to disable C<chown>-ing, even if it were 1891possible. 1892 1893The default is C<1>. 1894 1895=head2 $Archive::Tar::CHMOD 1896 1897By default, C<Archive::Tar> will try to C<chmod> your files to 1898whatever mode was specified for the particular file in the archive. 1899In some cases, this may not be desired. In that case, set this 1900variable to C<0> to disable C<chmod>-ing. 1901 1902The default is C<1>. 1903 1904=head2 $Archive::Tar::SAME_PERMISSIONS 1905 1906When, C<$Archive::Tar::CHMOD> is enabled, this setting controls whether 1907the permissions on files from the archive are used without modification 1908of if they are filtered by removing any setid bits and applying the 1909current umask. 1910 1911The default is C<1> for the root user and C<0> for normal users. 1912 1913=head2 $Archive::Tar::DO_NOT_USE_PREFIX 1914 1915By default, C<Archive::Tar> will try to put paths that are over 1916100 characters in the C<prefix> field of your tar header, as 1917defined per POSIX-standard. However, some (older) tar programs 1918do not implement this spec. To retain compatibility with these older 1919or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX> 1920variable to a true value, and C<Archive::Tar> will use an alternate 1921way of dealing with paths over 100 characters by using the 1922C<GNU Extended Header> feature. 1923 1924Note that clients who do not support the C<GNU Extended Header> 1925feature will not be able to read these archives. Such clients include 1926tars on C<Solaris>, C<Irix> and C<AIX>. 1927 1928The default is C<0>. 1929 1930=head2 $Archive::Tar::DEBUG 1931 1932Set this variable to C<1> to always get the C<Carp::longmess> output 1933of the warnings, instead of the regular C<carp>. This is the same 1934message you would get by doing: 1935 1936 $tar->error(1); 1937 1938Defaults to C<0>. 1939 1940=head2 $Archive::Tar::WARN 1941 1942Set this variable to C<0> if you do not want any warnings printed. 1943Personally I recommend against doing this, but people asked for the 1944option. Also, be advised that this is of course not threadsafe. 1945 1946Defaults to C<1>. 1947 1948=head2 $Archive::Tar::error 1949 1950Holds the last reported error. Kept for historical reasons, but its 1951use is very much discouraged. Use the C<error()> method instead: 1952 1953 warn $tar->error unless $tar->extract; 1954 1955Note that in older versions of this module, the C<error()> method 1956would return an effectively global value even when called an instance 1957method as above. This has since been fixed, and multiple instances of 1958C<Archive::Tar> now have separate error strings. 1959 1960=head2 $Archive::Tar::INSECURE_EXTRACT_MODE 1961 1962This variable indicates whether C<Archive::Tar> should allow 1963files to be extracted outside their current working directory. 1964 1965Allowing this could have security implications, as a malicious 1966tar archive could alter or replace any file the extracting user 1967has permissions to. Therefor, the default is to not allow 1968insecure extractions. 1969 1970If you trust the archive, or have other reasons to allow the 1971archive to write files outside your current working directory, 1972set this variable to C<true>. 1973 1974Note that this is a backwards incompatible change from version 1975C<1.36> and before. 1976 1977=head2 $Archive::Tar::HAS_PERLIO 1978 1979This variable holds a boolean indicating if we currently have 1980C<perlio> support loaded. This will be enabled for any perl 1981greater than C<5.8> compiled with C<perlio>. 1982 1983If you feel strongly about disabling it, set this variable to 1984C<false>. Note that you will then need C<IO::String> installed 1985to support writing stringified archives. 1986 1987Don't change this variable unless you B<really> know what you're 1988doing. 1989 1990=head2 $Archive::Tar::HAS_IO_STRING 1991 1992This variable holds a boolean indicating if we currently have 1993C<IO::String> support loaded. This will be enabled for any perl 1994that has a loadable C<IO::String> module. 1995 1996If you feel strongly about disabling it, set this variable to 1997C<false>. Note that you will then need C<perlio> support from 1998your perl to be able to write stringified archives. 1999 2000Don't change this variable unless you B<really> know what you're 2001doing. 2002 2003=head2 $Archive::Tar::ZERO_PAD_NUMBERS 2004 2005This variable holds a boolean indicating if we will create 2006zero padded numbers for C<size>, C<mtime> and C<checksum>. 2007The default is C<0>, indicating that we will create space padded 2008numbers. Added for compatibility with C<busybox> implementations. 2009 2010=head1 FAQ 2011 2012=over 4 2013 2014=item What's the minimum perl version required to run Archive::Tar? 2015 2016You will need perl version 5.005_03 or newer. 2017 2018=item Isn't Archive::Tar slow? 2019 2020Yes it is. It's pure perl, so it's a lot slower then your C</bin/tar> 2021However, it's very portable. If speed is an issue, consider using 2022C</bin/tar> instead. 2023 2024=item Isn't Archive::Tar heavier on memory than /bin/tar? 2025 2026Yes it is, see previous answer. Since C<Compress::Zlib> and therefore 2027C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little 2028choice but to read the archive into memory. 2029This is ok if you want to do in-memory manipulation of the archive. 2030 2031If you just want to extract, use the C<extract_archive> class method 2032instead. It will optimize and write to disk immediately. 2033 2034Another option is to use the C<iter> class method to iterate over 2035the files in the tarball without reading them all in memory at once. 2036 2037=item Can you lazy-load data instead? 2038 2039In some cases, yes. You can use the C<iter> class method to iterate 2040over the files in the tarball without reading them all in memory at once. 2041 2042=item How much memory will an X kb tar file need? 2043 2044Probably more than X kb, since it will all be read into memory. If 2045this is a problem, and you don't need to do in memory manipulation 2046of the archive, consider using the C<iter> class method, or C</bin/tar> 2047instead. 2048 2049=item What do you do with unsupported filetypes in an archive? 2050 2051C<Unix> has a few filetypes that aren't supported on other platforms, 2052like C<Win32>. If we encounter a C<hardlink> or C<symlink> we'll just 2053try to make a copy of the original file, rather than throwing an error. 2054 2055This does require you to read the entire archive in to memory first, 2056since otherwise we wouldn't know what data to fill the copy with. 2057(This means that you cannot use the class methods, including C<iter> 2058on archives that have incompatible filetypes and still expect things 2059to work). 2060 2061For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that 2062the extraction of this particular item didn't work. 2063 2064=item I'm using WinZip, or some other non-POSIX client, and files are not being extracted properly! 2065 2066By default, C<Archive::Tar> is in a completely POSIX-compatible 2067mode, which uses the POSIX-specification of C<tar> to store files. 2068For paths greater than 100 characters, this is done using the 2069C<POSIX header prefix>. Non-POSIX-compatible clients may not support 2070this part of the specification, and may only support the C<GNU Extended 2071Header> functionality. To facilitate those clients, you can set the 2072C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the 2073C<GLOBAL VARIABLES> section for details on this variable. 2074 2075Note that GNU tar earlier than version 1.14 does not cope well with 2076the C<POSIX header prefix>. If you use such a version, consider setting 2077the C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. 2078 2079=item How do I extract only files that have property X from an archive? 2080 2081Sometimes, you might not wish to extract a complete archive, just 2082the files that are relevant to you, based on some criteria. 2083 2084You can do this by filtering a list of C<Archive::Tar::File> objects 2085based on your criteria. For example, to extract only files that have 2086the string C<foo> in their title, you would use: 2087 2088 $tar->extract( 2089 grep { $_->full_path =~ /foo/ } $tar->get_files 2090 ); 2091 2092This way, you can filter on any attribute of the files in the archive. 2093Consult the C<Archive::Tar::File> documentation on how to use these 2094objects. 2095 2096=item How do I access .tar.Z files? 2097 2098The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via 2099the C<IO::Zlib> module) to access tar files that have been compressed 2100with C<gzip>. Unfortunately tar files compressed with the Unix C<compress> 2101utility cannot be read by C<Compress::Zlib> and so cannot be directly 2102accesses by C<Archive::Tar>. 2103 2104If the C<uncompress> or C<gunzip> programs are available, you can use 2105one of these workarounds to read C<.tar.Z> files from C<Archive::Tar> 2106 2107Firstly with C<uncompress> 2108 2109 use Archive::Tar; 2110 2111 open F, "uncompress -c $filename |"; 2112 my $tar = Archive::Tar->new(*F); 2113 ... 2114 2115and this with C<gunzip> 2116 2117 use Archive::Tar; 2118 2119 open F, "gunzip -c $filename |"; 2120 my $tar = Archive::Tar->new(*F); 2121 ... 2122 2123Similarly, if the C<compress> program is available, you can use this to 2124write a C<.tar.Z> file 2125 2126 use Archive::Tar; 2127 use IO::File; 2128 2129 my $fh = new IO::File "| compress -c >$filename"; 2130 my $tar = Archive::Tar->new(); 2131 ... 2132 $tar->write($fh); 2133 $fh->close ; 2134 2135=item How do I handle Unicode strings? 2136 2137C<Archive::Tar> uses byte semantics for any files it reads from or writes 2138to disk. This is not a problem if you only deal with files and never 2139look at their content or work solely with byte strings. But if you use 2140Unicode strings with character semantics, some additional steps need 2141to be taken. 2142 2143For example, if you add a Unicode string like 2144 2145 # Problem 2146 $tar->add_data('file.txt', "Euro: \x{20AC}"); 2147 2148then there will be a problem later when the tarfile gets written out 2149to disk via C<$tar->write()>: 2150 2151 Wide character in print at .../Archive/Tar.pm line 1014. 2152 2153The data was added as a Unicode string and when writing it out to disk, 2154the C<:utf8> line discipline wasn't set by C<Archive::Tar>, so Perl 2155tried to convert the string to ISO-8859 and failed. The written file 2156now contains garbage. 2157 2158For this reason, Unicode strings need to be converted to UTF-8-encoded 2159bytestrings before they are handed off to C<add_data()>: 2160 2161 use Encode; 2162 my $data = "Accented character: \x{20AC}"; 2163 $data = encode('utf8', $data); 2164 2165 $tar->add_data('file.txt', $data); 2166 2167A opposite problem occurs if you extract a UTF8-encoded file from a 2168tarball. Using C<get_content()> on the C<Archive::Tar::File> object 2169will return its content as a bytestring, not as a Unicode string. 2170 2171If you want it to be a Unicode string (because you want character 2172semantics with operations like regular expression matching), you need 2173to decode the UTF8-encoded content and have Perl convert it into 2174a Unicode string: 2175 2176 use Encode; 2177 my $data = $tar->get_content(); 2178 2179 # Make it a Unicode string 2180 $data = decode('utf8', $data); 2181 2182There is no easy way to provide this functionality in C<Archive::Tar>, 2183because a tarball can contain many files, and each of which could be 2184encoded in a different way. 2185 2186=back 2187 2188=head1 CAVEATS 2189 2190The AIX tar does not fill all unused space in the tar archive with 0x00. 2191This sometimes leads to warning messages from C<Archive::Tar>. 2192 2193 Invalid header block at offset nnn 2194 2195A fix for that problem is scheduled to be released in the following levels 2196of AIX, all of which should be coming out in the 4th quarter of 2009: 2197 2198 AIX 5.3 TL7 SP10 2199 AIX 5.3 TL8 SP8 2200 AIX 5.3 TL9 SP5 2201 AIX 5.3 TL10 SP2 2202 2203 AIX 6.1 TL0 SP11 2204 AIX 6.1 TL1 SP7 2205 AIX 6.1 TL2 SP6 2206 AIX 6.1 TL3 SP3 2207 2208The IBM APAR number for this problem is IZ50240 (Reported component ID: 22095765G0300 / AIX 5.3). It is possible to get an ifix for that problem. 2210If you need an ifix please contact your local IBM AIX support. 2211 2212=head1 TODO 2213 2214=over 4 2215 2216=item Check if passed in handles are open for read/write 2217 2218Currently I don't know of any portable pure perl way to do this. 2219Suggestions welcome. 2220 2221=item Allow archives to be passed in as string 2222 2223Currently, we only allow opened filehandles or filenames, but 2224not strings. The internals would need some reworking to facilitate 2225stringified archives. 2226 2227=item Facilitate processing an opened filehandle of a compressed archive 2228 2229Currently, we only support this if the filehandle is an IO::Zlib object. 2230Environments, like apache, will present you with an opened filehandle 2231to an uploaded file, which might be a compressed archive. 2232 2233=back 2234 2235=head1 SEE ALSO 2236 2237=over 4 2238 2239=item The GNU tar specification 2240 2241C<http://www.gnu.org/software/tar/manual/tar.html> 2242 2243=item The PAX format specification 2244 2245The specification which tar derives from; C< http://www.opengroup.org/onlinepubs/007904975/utilities/pax.html> 2246 2247=item A comparison of GNU and POSIX tar standards; C<http://www.delorie.com/gnu/docs/tar/tar_114.html> 2248 2249=item GNU tar intends to switch to POSIX compatibility 2250 2251GNU Tar authors have expressed their intention to become completely 2252POSIX-compatible; C<http://www.gnu.org/software/tar/manual/html_node/Formats.html> 2253 2254=item A Comparison between various tar implementations 2255 2256Lists known issues and incompatibilities; C<http://gd.tuwien.ac.at/utils/archivers/star/README.otherbugs> 2257 2258=back 2259 2260=head1 AUTHOR 2261 2262This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. 2263 2264Please reports bugs to E<lt>bug-archive-tar@rt.cpan.orgE<gt>. 2265 2266=head1 ACKNOWLEDGEMENTS 2267 2268Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney, Gisle Aas, 2269Rainer Tammer and especially Andrew Savige for their help and suggestions. 2270 2271=head1 COPYRIGHT 2272 2273This module is copyright (c) 2002 - 2009 Jos Boumans 2274E<lt>kane@cpan.orgE<gt>. All rights reserved. 2275 2276This library is free software; you may redistribute and/or modify 2277it under the same terms as Perl itself. 2278 2279=cut 2280