File Coverage

blib/lib/Filter/Crypto/CryptFile.pm

Criterion	Covered	Total	%
statement	99	134	73.8
branch	47	110	42.7
condition	20	27	74.0
subroutine	16	16	100.0
pod	1	1	100.0
total	183	288	63.5

#===============================================================================
#
# CryptFile/lib/Filter/Crypto/CryptFile.pm
#
# DESCRIPTION
#   Module providing the means to convert files to/from an encrypted state in
#   which they can be run via Filter::Crypto::Decrypt.
#
# COPYRIGHT
#   Copyright (C) 2004-2009, 2012-2014 Steve Hay.  All rights reserved.
#
# LICENCE
#   This module is free software; you can redistribute it and/or modify it under
#   the same terms as Perl itself, i.e. under the terms of either the GNU
#   General Public License or the Artistic License, as specified in the LICENCE
#   file.
#
#===============================================================================

package Filter::Crypto::CryptFile;

use 5.008001;

use strict;
use warnings;

use Carp qw(carp croak);
use Exporter qw();
use Fcntl qw(:DEFAULT :flock);
use Scalar::Util qw(reftype);
use XSLoader qw();

## no critic (Subroutines::ProhibitSubroutinePrototypes)

sub crypt_file($;$$);
sub _isa_cryptmode($);
sub _isa_filehandle($);
sub _isa_filename($);

#===============================================================================
# MODULE INITIALIZATION
#===============================================================================

our(@ISA, @EXPORT, @EXPORT_OK, $VERSION);

BEGIN {
    @ISA = qw(Exporter);

    @EXPORT = qw(
        CRYPT_MODE_AUTO
        CRYPT_MODE_ENCRYPT
        CRYPT_MODE_DECRYPT
        CRYPT_MODE_ENCRYPTED
        CRYPT_MODE_DECRYPTED
        crypt_file
    );

    @EXPORT_OK = qw(
        $ErrStr
    );

    $VERSION = '2.09';

    XSLoader::load(__PACKAGE__, $VERSION);
}

# Last error message.
our $ErrStr = '';

#===============================================================================
# PUBLIC API
#===============================================================================

# Autoload the CRYPT_MODE_* flags from the constant() XS function.

sub AUTOLOAD {
    our $AUTOLOAD;

    # Get the name of the constant to generate a subroutine for.
    (my $constant = $AUTOLOAD) =~ s/^.*:://o;

    # Avoid deep recursion on AUTOLOAD() if constant() is not defined.
    croak('Unexpected error in AUTOLOAD(): constant() is not defined')
        if $constant eq 'constant';

    my($error, $value) = constant($constant);

    # Handle any error from looking up the constant.
    croak($error) if $error;

    # Generate an in-line subroutine returning the required value.
    {
    no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
    *$AUTOLOAD = sub { return $value };
    }

    # Switch to the subroutine that we have just generated.
    goto &$AUTOLOAD;
}

sub crypt_file($;$$) {
    $ErrStr = '';
    my $num_bytes = 0;

    if ( @_ == 1 or
        (@_ == 2 and (not defined $_[1] or $_[1] eq '' or
                      _isa_cryptmode($_[1])              )))
    {
        my($fh, $file, $opened, $flocked);
        if (_isa_filehandle($_[0])) {
            $fh = $_[0];
            $opened = 0;
        }
        elsif (_isa_filename($_[0])) {
            $file = $_[0];
            unless (sysopen $fh, $file, O_RDWR | O_BINARY) {
                $ErrStr = "Can't open file '$file' for updating: $!";
                return;
            }
            $opened = 1;
        }
        else {
            croak("'$_[0]' is not a filehandle or a file name");
        }

        if (-f $fh) {
            unless (flock $fh, LOCK_EX | LOCK_NB) {
                $ErrStr = "Can't acquire exclusive lock on update " .
                          "filehandle: $!";
                local($!, $^E);
                close $fh if $opened;
                return;
            }
            $flocked = 1;
        }

        my $crypt_mode = (@_ == 2 and defined $_[1] and $_[1] ne '')
                         ? $_[1] : CRYPT_MODE_AUTO();

        unless (_crypt_fh($fh, $crypt_mode, $num_bytes)) {
            local($!, $^E);
            $opened ? close $fh : $flocked ? flock $fh, LOCK_UN : 1;
            return;
        }

        if ($opened) {
            close $fh or
                carp("Can't close file '$file' after updating: $!");
        }
        elsif ($flocked) {
            flock $fh, LOCK_UN or
                carp("Can't release lock on filehandle after updating: $!");
        }
    }
    else {
        my($in_fh, $in_file, $in_opened, $in_flocked);
        if (_isa_filehandle($_[0])) {
            $in_fh = $_[0];
            $in_opened = 0;
        }
        elsif (_isa_filename($_[0])) {
            $in_file = $_[0];
            unless (sysopen $in_fh, $in_file, O_RDONLY | O_BINARY) {
                $ErrStr = "Can't open input file '$in_file' for reading: $!";
                return;
            }
            $in_opened = 1;
        }
        else {
            croak("'$_[0]' is not a filehandle or a file name");
        }

        if (-f $in_fh) {
            unless (flock $in_fh, LOCK_SH | LOCK_NB) {
                $ErrStr = "Can't acquire shared lock on input filehandle: $!";
                local($!, $^E);
                close $in_fh if $in_opened;
                return;
            }
            $in_flocked = 1;
        }

        my($out_fh, $out_file, $out_opened, $out_flocked);
        if (_isa_filehandle($_[1])) {
            $out_fh = $_[1];
            $out_opened = 0;
        }
        elsif (_isa_filename($_[1])) {
            $out_file = $_[1];
            unless (sysopen $out_fh, $out_file,
                    O_WRONLY | O_CREAT | O_TRUNC | O_BINARY)
            {
                $ErrStr = "Can't open output file '$out_file' for writing: $!";
                local($!, $^E);
                $in_opened ? close $in_fh
                           : $in_flocked ? flock $in_fh, LOCK_UN : 1;
                return;
            }
            $out_opened = 1;
        }
        else {
            local($!, $^E);
            $in_opened ? close $in_fh : $in_flocked ? flock $in_fh, LOCK_UN : 1;
            croak("'$_[1]' is not a valid crypt mode or a filehandle or a " .
                  "file name");
        }

        if (-f $out_fh) {
            unless (flock $out_fh, LOCK_EX | LOCK_NB) {
                $ErrStr = "Can't acquire exclusive lock on output " .
                          "filehandle: $!";
                local($!, $^E);
                $in_opened ? close $in_fh
                           : $in_flocked ? flock $in_fh, LOCK_UN : 1;
                close $out_fh if $out_opened;
                return;
            }
            $out_flocked = 1;
        }

        my $crypt_mode;
        if (@_ == 3 and defined $_[2] and $_[2] ne '') {
            if (_isa_cryptmode($_[2])) {
                $crypt_mode = $_[2];
            }
            else {
                local($!, $^E);
                $in_opened  ? close $in_fh
                            : $in_flocked  ? flock $in_fh,  LOCK_UN : 1;
                $out_opened ? close $out_fh
                            : $out_flocked ? flock $out_fh, LOCK_UN : 1;
                croak("'$_[2]' is not a valid crypt mode");
            }
        }
        else {
            $crypt_mode = CRYPT_MODE_AUTO();
        }

        unless (_crypt_fhs($in_fh, $out_fh, $crypt_mode, $num_bytes)) {
            local($!, $^E);
            $in_opened  ? close $in_fh
                        : $in_flocked  ? flock $in_fh,  LOCK_UN : 1;
            $out_opened ? close $out_fh
                        : $out_flocked ? flock $out_fh, LOCK_UN : 1;
            return;
        }

        if ($in_opened) {
            close $in_fh or
                carp("Can't close input file '$in_file' after reading: $!");
        }
        elsif ($in_flocked) {
            flock $in_fh, LOCK_UN or
                carp("Can't release lock on input filehandle after " .
                     "reading: $!");
        }

        if ($out_opened) {
            close $out_fh or
                carp("Can't close output file '$out_file' after writing: $!");
        }
        elsif ($out_flocked) {
            flock $out_fh, LOCK_UN or
                carp("Can't release lock on output filehandle after " .
                     "writing: $!");
        }
    }

    return $num_bytes ? $num_bytes : '0E0';
}

#===============================================================================
# PRIVATE API
#===============================================================================

sub _isa_cryptmode($) {
    my $mode = shift;

    return(($mode eq CRYPT_MODE_AUTO()      or
            $mode eq CRYPT_MODE_ENCRYPT()   or
            $mode eq CRYPT_MODE_DECRYPT()   or
            $mode eq CRYPT_MODE_ENCRYPTED() or
            $mode eq CRYPT_MODE_DECRYPTED()   ));
}

sub _isa_filehandle($) {
    my $fh = shift;

    return(((    ref $fh and reftype($fh)  eq 'GLOB') or
            (not ref $fh and reftype(\$fh) eq 'GLOB')   ) and
           defined fileno $fh);
}

sub _isa_filename($) {
    my $name = shift;

    return(not ref $name and reftype(\$name) eq 'SCALAR');
}

1;

__END__