File Coverage

blib/lib/Filesys/POSIX/Userland/Tar.pm

Criterion	Covered	Total	%
statement	80	87	91.9
branch	24	32	75.0
condition	5	6	83.3
subroutine	13	13	100.0
pod	1	1	100.0
total	123	139	88.4

# Copyright (c) 2014, cPanel, Inc.
# All rights reserved.
# http://cpanel.net/
#
# This is free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.  See the LICENSE file for further details.

package Filesys::POSIX::Userland::Tar;

use strict;
use warnings;

use Filesys::POSIX::Bits;
use Filesys::POSIX::Module ();

use Filesys::POSIX::Path                  ();
use Filesys::POSIX::Userland::Find        ();
use Filesys::POSIX::Userland::Tar::Header ();

use Errno;
use Carp ();

my @METHODS = qw(tar);

Filesys::POSIX::Module->export_methods( __PACKAGE__, @METHODS );

=head1 NAME

Filesys::POSIX::Userland::Tar - Generate ustar archives from L

=head1 SYNOPSIS

    use Filesys::POSIX;
    use Filesys::POSIX::Mem;
    use Filesys::POSIX::IO::Handle;
    use Filesys::POSIX::Userland::Tar;

    my $fs = Filesys::POSIX->new(Filesys::POSIX::Mem->new,
        'noatime' => 1
    );

    $fs->mkdir('foo');
    $fs->touch('foo/bar');

    $fs->tar(Filesys::POSIX::IO::Handle->new(\*STDOUT), '.');

=head1 DESCRIPTION

This module provides an implementation of the ustar standard on top of the
virtual filesystem layer, a mechanism intended to take advantage of the many
possible mapping and manipulation capabilities inherent in this mechanism.
Internally, it uses the L module to perform
depth- last recursion to locate inodes for packaging.

As mentioned, archives are written in the ustar format, with pathnames of the
extended maximum length of 256 characters, supporting file sizes up to 4GB.
Currently, only user and group IDs are stored; names are not resolved and
stored as of the time of this writing.  All inode types are supported for
archival.

=head1 USAGE

=over

=cut

our $BLOCK_SIZE = 512;
our $BUF_MAX    = 20 * $BLOCK_SIZE;

#
# NOTE: I'm only using $inode->open() calls to avoid having to call stat().
# This is not necessarily something that should be done by end user software.
#
sub _write_file {
    my ( $fh, $inode, $handle, $size ) = @_;

    my $total_written = 0;
    my $remaining     = $size;
    my $modulo        = $size % $BLOCK_SIZE;
    my $padding       = $modulo ? $BLOCK_SIZE - $modulo : 0;

    while ($remaining) {
        my $readlen;
        my $writelen;
        my $buf;

        my $wanted = ( $remaining >= $BUF_MAX ) ? $BUF_MAX : $remaining;

        if ( ( $readlen = $fh->read( $buf, $wanted ) ) <= 0 ) {
            last;
        }

        if ( ( $writelen = $handle->write( $buf, $readlen ) ) < $readlen ) {
            last;
        }

        $total_written += $writelen;
        $remaining -= $writelen;
    }

    if ($remaining) {
        warn sprintf(
            "Only streamed %d of %d bytes of file",
            $total_written, $size
        );

        $padding += $remaining;
    }
    elsif ( !$fh->eof ) {
        warn "File grew as we read it; truncated";
    }

    $handle->write( "\x00" x $padding, $padding );

    $fh->close;

    $total_written += $padding;

    return $total_written;
}

sub _archive {
    my ( $inode, $handle, $path, $opts ) = @_;

    my $written = 0;

    my $header = Filesys::POSIX::Userland::Tar::Header->from_inode( $inode, $path );
    my $blocks = '';

    if ( $header->{'truncated'} ) {

        if ( $opts->{'gnu_extensions'} ) {
            $blocks .= $header->encode_longlink;
        }
        elsif ( $opts->{'posix_extensions'} ) {
            $blocks .= $header->encode_posix;
        }
        else {
            die('Filename too long');
        }
    }

    $blocks .= $header->encode;

    local $@;

    eval {
        # Acquire the file handle before writing the header so we don't corrupt
        # the tarball if the file is missing.
        my $header_len = length $blocks;

        unless ( $handle->write( $blocks, $header_len ) == $header_len ) {
            Carp::confess('Short write while dumping tar header to file handle');
        }

        if ( $inode->file && $header->{'size'} > 0 ) {
            my $fh = $inode->open( $O_RDONLY | $O_NONBLOCK );    # Case 82969: No block on pipes

            $written += _write_file( $fh, $inode, $handle, $header->{'size'} );
        }

        $written += $header_len;
    };

    if ($!) {
        if ( !$opts->{'ignore_missing'} || $! != &Errno::ENOENT ) {
            die $@;
        }
        $opts->{'ignore_missing'}->($path)
          if ref $opts->{'ignore_missing'} eq 'CODE';
    }

    return $written;
}

=item C<$fs-Etar($handle, @items)>

=item C<$fs-Etar($handle, $opts, @items)>

Locate files and directories in each path specified in the C<@items> array,
writing results to the I/O handle wrapper specified by C<$handle>, an instance
of L.  When an anonymous HASH argument, C<$opts>, is
specified, the data is passed unmodified to L.
In this way, for instance, the behavior of following symlinks can be specified.

In addition to options supported by L, the
following options are recognized uniquely by C<$fs-Etar()>:

=over

=item C

When set, certain GNU extensions to the tar output format are enabled, namely
support for arbitrarily long filenames.

=back

=item C

When set, ignore if a file is missing when writing it to the tarball.  This can
happen if a file is removed between the time the find functionality finds it and
the time it is actually written to the output.  If the value is a coderef, calls
that function with the name of the missing file.

=back

=cut

sub tar {
    my $self     = shift;
    my $handle   = shift;
    my $opts     = ref $_[0] eq 'HASH' ? shift : {};
    my @items    = @_;
    my $unpadded = 0;

    $self->find(
        sub {
            my ( $path, $inode ) = @_;

            return if $inode->sock;

            $unpadded += _archive( $inode, $handle, $path->full, $opts );
            $unpadded %= $BUF_MAX;
        },
        $opts,
        @items
    );

    my $padlen = $BUF_MAX - ( $unpadded % $BUF_MAX );
    $handle->write( "\x00" x $padlen, $padlen );

    return;
}

=back

=cut

1;

__END__