File Coverage

blib/lib/Crypt/FileHandle.pm

Criterion	Covered	Total	%
statement	207	274	75.5
branch	83	138	60.1
condition	19	32	59.3
subroutine	27	28	96.4
pod	3	3	100.0
total	339	475	71.3

package Crypt::FileHandle;

require 5.006000;

use strict;
use warnings;
use FileHandle;
use Carp qw(croak carp);

use vars qw($VERSION);
$VERSION = "0.03";

# ensure errors are properly reported to caller
$Carp::Internal{"Crypt::FileHandle"}++;

# internal variable names
our $V_FH = 'fh';
our $V_CIPHER = 'cipher';
our $V_STATE = 'state';
our $V_READ_BUFFER = 'read_buffer';
our $V_TOTAL_BYTES = 'total_bytes';
our $V_EOF = 'eof';

# internal state values
our $STATE_CLOSED = 0;
our $STATE_ENCRYPT = 1;
our $STATE_DECRYPT = 2;

# global variables
our $READSIZE = 4096;

############################################################

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	# create tied FileHandle object
	# tie() automatically attaches this class type to it via TIEHANDLE()
	# all methods defined below will be called in place of the real methods
	my $fh = new FileHandle;
	my $self = tie(*$fh, $class, @_);

	# WARNING: do not store tied FileHandle object as this will
	# create a second hidden reference that prevents the tied object
	# from being destroyed; untie() cannot be called automatically

	# return tied FileHandle
	return $fh;
}

############################################################

# global method
# verifies that the given cipher supports the necessary methods
#
sub verify_cipher {
	my $class = shift;
	my $cipher = shift;

	# check parameters
	if (! defined $cipher) {
		return !1;
	}

	# must at least be a reference to something
	if (! ref($cipher)) {
		return !1;
	}

	# verify required methods exist
	if (! $cipher->can("start")) {
		return !1;
	}
	if (! $cipher->can("crypt")) {
		return !1;
	}
	if (! $cipher->can("finish")) {
		return !1;
	}

	return 1;
}

############################################################

# global access method
# affects ALL instances of Crypt::FileHandle
# WARNING: should not be less than minimum encrypted header length
#
sub readsize {
	my $class = shift;
	my $readsize = shift;
	if (!defined $readsize || $readsize <= 0) {
		return $READSIZE;
	}
	# provide warning if READSIZE is smaller than minimum
	# must be able to read at least header on first read
	# "Salted__" or "RandomIV" plus 8 byte IV equals 16 bytes
	if ($readsize < 16) {
		carp "readsize may be too small for encrypted header"
	}
	return $READSIZE = $readsize;
}

############################################################

sub DESTROY {
	my $self = shift;

	# close the real FileHandle
	if ($self->{$V_STATE} != $STATE_CLOSED) {
		$self->CLOSE();
	}

	return 1;
}

############################################################

sub TIEHANDLE {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	# required parameters
	my $cipher = shift;

	# create new empty hash reference, bless as class
	my $self = {};
	bless($self, $class);

	# verify cipher
	if (!$self->verify_cipher($cipher)) {
		croak "invalid cipher or cipher not defined";
	}

	# default options
	$self->{$V_CIPHER} = $cipher;
	$self->{$V_STATE} = $STATE_CLOSED;
	$self->{$V_READ_BUFFER} = "";
	$self->{$V_TOTAL_BYTES} = 0;
	$self->{$V_EOF} = 0;

	# create real FileHandle
	# read/write methods below will utilize this FileHandle
	my $fh = new FileHandle;
	$self->{$V_FH} = $fh;

	# automatically call open if additional options are provided
	if (scalar @_ > 0) {
		$self->OPEN(@_) || croak $!;
	}

	return $self;
}

############################################################

# untie gotcha
#
sub UNTIE {
	my ($obj, $c) = @_;
	carp "untie attempted while $c inner references still exist" if $c;
}

############################################################

# open() FileHandle
#
sub OPEN {
	my $self = shift;
	my $fh = $self->{$V_FH};

	# reset variables
	$self->{$V_READ_BUFFER} = "";
	$self->{$V_TOTAL_BYTES} = 0;
	$self->{$V_EOF} = 0;

	# open real FileHandle
	# utilize multiple parameters without directly passing @_
	# perlio complains if undef is inadvertently passed to open()
	my $rtnval;

	# open FILEHANDLE,MODE,EXPR,LIST
	if (scalar @_ >= 3) {
		my $mode = shift;
		my $expr = shift;
		my $list = shift;

		$self->_parse_open_mode($mode);

		$rtnval = open($fh, $mode, $expr, $list);
	}

	# open FILEHANDLE,MODE,EXPR
	elsif (scalar @_ == 2) {
		my $mode = shift;
		my $expr = shift;

		$self->_parse_open_mode($mode);

		$rtnval = open($fh, $mode, $expr);
	}

	# open FILEHANDLE,EXPR
	elsif (scalar @_ == 1) {
		my $expr = shift;

		# determine mode from expr
		my $mode = undef;
		if (defined $expr) {
			if ($expr =~ /(?:^([<>\+\-\|]+)|(\|)$)/) {
				$mode = $1;
			}
		}

		$self->_parse_open_mode($mode);

		$rtnval = open($fh, $expr);
	}

	# open FILEHANDLE
	else {
		croak "Use of uninitialized value in open";
	}

	# determine FileHandle flags to start encryption/decryption
	if ($fh->opened()) {

		# automatically set real FileHandle to binary mode
		# necessary for some systems
		binmode($fh);

		# open for encrypting
		if ($self->{$V_STATE} eq $STATE_ENCRYPT) {
			$self->{$V_CIPHER}->start('encrypting');

			# an error is presented if no data is ever written
			# so force an empty string of data to be encrypted
			$self->_encrypt_write("");
		}

		# open for decrypting
		elsif ($self->{$V_STATE} eq $STATE_DECRYPT) {
			$self->{$V_CIPHER}->start('decrypting');
		}

		# unknown
		else {
			# this should never occur
			croak "Bad state";
		}
	}

	return $rtnval;
}

############################################################

# sets binary mode
#
sub BINMODE {
	my $self = shift;

	# set binary mode on real FileHandle
	my $fh = $self->{$V_FH};
	return binmode($fh, @_) if (@_);
	return binmode($fh);
}

############################################################

# print() to FileHandle
#
sub PRINT {
	my $self = shift;

	# check state
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		carp "print() on closed filehandle";
		return !1;
	}
	if ($self->{$V_STATE} == $STATE_DECRYPT) {
		carp "Filehandle opened only for input";
		return !1;
	}

	# encrypt and write data to real FileHandle
	if ($self->_encrypt_write(@_)) {
		return 1;
	}

	return !1;
}

############################################################

# printf() to FileHandle
#
sub PRINTF {
	my $self = shift;
	my $fmt = shift;

	return $self->PRINT(sprintf($fmt, @_));
}

############################################################

# write() to FileHandle
#
sub WRITE {
	my $self = shift;

	# check state
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		carp "syswrite() on closed filehandle";
		return undef;
	}
	if ($self->{$V_STATE} == $STATE_DECRYPT) {
		carp "Filehandle opened only for input";
		return undef;
	}

	# get parameters
	my ($buf, $len, $off) = @_;

	# check parameters
	if (! defined $buf) {
		carp "Use of uninitialized value";
		return undef;
	}
	if (! defined $len) {
		$len = length($buf);
	}
	if ($len < 0) {
		carp "Negative length";
		return undef;
	}
	if (! defined $off) {
		$off = 0;
	}

	# truncate to length
	$buf = substr($buf, $off, $len);

	# encrypt and write data to real FileHandle
	return $self->_encrypt_write($buf);
}

############################################################

# readline() from FileHandle
#
sub READLINE {
	my $self = shift;

	# check state
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		carp "readline() on closed filehandle";
		return undef;
	}
	if ($self->{$V_STATE} == $STATE_ENCRYPT) {
		carp "Filehandle opened only for output";
		return undef;
	}

	# EOF and buffer is empty
	if ($self->{$V_EOF} && length($self->{$V_READ_BUFFER}) == 0) {
		return undef;
	}

	# utilize INPUT_RECORD_SEPARATOR ($/) to determine end of line
	my $index = -1;
	if (defined $/) {
		# loop reading data until buffer contains $/
		$index = index($self->{$V_READ_BUFFER}, $/);
		while (($index < 0) && $self->_decrypt_read()) {
			$index = index($self->{$V_READ_BUFFER}, $/);
		}
	}
	else {
		# special case if $/ is undef
		# continue looping until entire file is read
		while($self->_decrypt_read()) {
		}
	}

	# if index was found, include $/ in length
	# otherwise an undef length will extract entire buffer
	# return value (extracted length) is unused when reading lines
	my $len = ($index >= 0 ? ($index + length($/)) : undef);
	my $buf;
	$self->_extract_read_buffer($buf, $len);

	return $buf;
}

############################################################

# read() from FileHandle
#
sub READ {
	my $self = shift;

	# check state
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		carp "sysread() on closed filehandle";
		return undef;
	}
	if ($self->{$V_STATE} == $STATE_ENCRYPT) {
		carp "Filehandle opened only for output";
		return undef;
	}

	# get parameters
	# acquire reference to provided scalar
	my $buf = \shift;
	my ($len, $off) = @_;

	# check parameters
	if (! defined $buf) {
		carp "Use of uninitialized value";
		return undef;
	}
	if (! defined $len) {
		carp "Use of uninitialized length";
		return undef;
	}
	if ($len < 0) {
		carp "Negative length";
		return undef;
	}
	if (! defined $off) {
		$off = 0;
	}

	# read more data until buffer is large enough
	while ($len > length($self->{$V_READ_BUFFER})) {
		last if (! $self->_decrypt_read());
	}

	# extract data from buffer
	return $self->_extract_read_buffer($$buf, $len, $off);
}

############################################################

# getc() from FileHandle
#
sub GETC {
	my $self = shift;

	my $buf;
	$self->READ($buf, 1) || return undef;
	return $buf;
}

############################################################

# not implemented
#
#sub SEEK { }

############################################################

# returns the total number of cleartext bytes read or
# written, or -1 if the file is closed
#
sub TELL {
	my $self = shift;

	# check state
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		return -1;
	}

	# return total number of bytes
	return $self->{$V_TOTAL_BYTES};
}

############################################################

# closes the real file
#
sub CLOSE {
	my $self = shift;

	# finish writing leftover data prior to close
	$self->_finish();

	# change state
	$self->{$V_STATE} = $STATE_CLOSED;

	# close the real FileHandle
	my $fh = $self->{$V_FH};
	if (defined $fh) {
		return $fh->close();
	}

	return !1;
}

############################################################

# returns FILENO for real FileHandle
# utilized by a call to opened() on tied FileHandle
#
sub FILENO {
	my $self = shift;
	return fileno($self->{$V_FH});
}

############################################################

# returns true if EOF or CLOSED
#
sub EOF {
	my $self = shift;

	# CLOSED
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		return 1;
	}

	# EOF if real FileHandle is EOF and the buffer is empty
	if ($self->{$V_EOF} && length($self->{$V_READ_BUFFER}) == 0) {
		return 1;
	}

	return !1;
}

############################################################

# finishes up the encryption if there is leftover data to be written
#
sub _finish {
	my $self = shift;

	# check state
	# only necessary if encrypting
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		return !1;
	}
	if ($self->{$V_STATE} == $STATE_DECRYPT) {
		return !1;
	}

	# finish up the encryption
	my $ciphertext = $self->{$V_CIPHER}->finish();

	# write to real FileHandle
	my $fh = $self->{$V_FH};
	my $bytes_written = syswrite($fh, $ciphertext, length($ciphertext));

	return 1;
}

############################################################

# parse the mode provided to open()
#
sub _parse_open_mode {
	my $self = shift;
	my $mode = shift;

	# determine cipher mode (encrypt or decrypt)
	if (! defined $mode || $mode =~ /^
		# update state to reading
		$self->{$V_STATE} = $STATE_DECRYPT;
	}

	elsif ($mode =~ /^>(?!>)/ || $mode =~ /^\|/) {
		# update state to writing
		$self->{$V_STATE} = $STATE_ENCRYPT;
	}

	elsif ($mode =~ /^\+?>>/) {
		croak "APPEND mode not supported";
	}

	elsif ($mode =~ /^\+[<>]/) {
		croak "READ/WRITE mode not supported";
	}

	else {
		croak "Unknown mode";
	}

	return 1;
}

############################################################

# encrypts the provided parameters and writes to real FileHandle
# returns the number of cleartext bytes processed
#
sub _encrypt_write {
	my $self = shift;

	# check parameters
	return undef unless (@_);

	# check state
	if ($self->{$V_STATE} == $STATE_CLOSED) {
		carp "crypt() on closed FileHandle";
		return undef;
	}
	if ($self->{$V_STATE} == $STATE_DECRYPT) {
		carp "FileHandle opened only for input";
		return undef;
	}

	# append data
	my $cleartext = "";
	foreach (@_) {
		$cleartext .= $_ if (defined $_);
	}

	# encrypt data
	# must call crypt() even if cleartext is empty to ensure
	# header is written to an "empty" file
	my $ciphertext = $self->{$V_CIPHER}->crypt($cleartext);

	# ciphertext is only defined if there is at least one full block
	# after performing the encryption above
	if (defined $ciphertext) {

		# write data to real FileHandle
		my $fh = $self->{$V_FH};
		my $bw = syswrite($fh, $ciphertext, length($ciphertext));

		# check bytes written for errors
		if (! defined $bw) {
			carp $!;
			return undef;
		}
		if ($bw < 0) {
			return undef;
		}
		if ($bw == 0 && length($ciphertext) > 0) {
			return undef;
		}
	}

	# increment total number of cleartext bytes
	$self->{$V_TOTAL_BYTES} += length($cleartext);

	# return the number of cleartext characters processed
	return length($cleartext);
}

############################################################

# performs a single read from the real FileHandle
# decrypts the data and adds it to the buffer
# should be used when more data is needed in the buffer
# returns true on success, or false if EOF or error
#
sub _decrypt_read {
	my $self = shift;

	# end of file
	if ($self->{$V_EOF}) {
		return !1;
	}

	# reference to buffer
	my $rbuf = \$self->{$V_READ_BUFFER};

	# read and decrypt additional data from real Filehandle
	# always read in blocks of READSIZE encrypted bytes
	my $ciphertext;
	my $br = sysread($self->{$V_FH}, $ciphertext, $READSIZE);

	# check bytes read for errors
	if (! defined $br) {
		carp $!;
		return !1;
	}
	if ($br == 0) {
		# end of file (real FileHandle)
		$self->{$V_EOF} = 1;

		# finish decryption, if necessary
		# should only run once based on loop parameters above
		$$rbuf .= $self->{$V_CIPHER}->finish();
	}
	else {
		# decrypt data and append to buffer
		# cleartext length may be less than bytes read
		$$rbuf .= $self->{$V_CIPHER}->crypt($ciphertext) || "";
	}

	return 1;
}

############################################################

# extracts len bytes from the stored buffer
# assumes buffer has already been sufficiently populated with _decrypt_read()
# returns number of bytes extracted or undef on error
#
sub _extract_read_buffer {
	my $self = shift;

	# get parameters
	# acquire reference to provided scalar
	my $buf = \shift;
	my ($len, $off) = @_;

	# check parameters
	if (! defined $buf) {
		carp "Use of uninitialized value";
		return undef;
	}
	if (! defined $len) {
		# return entire buffer
		$len = length($self->{$V_READ_BUFFER});
	}
	if ($len < 0) {
		carp "Negative length";
		return undef;
	}
	if (! defined $off) {
		$off = 0;
	}

	# reference to buffer
	my $rbuf = \$self->{$V_READ_BUFFER};

	# extract requested bytes from buffer and replace with empty string
	# store extracted data in provided scalar at offset position
	# if offset is 0, same as writing over provided scalar
	# should be valid even for 0 byte requests
	# save length of extracted data for increment below
	my $xl;
	if (! defined $$buf) {
		# offset is ignored if provided scalar is not defined
		$$buf = substr($$rbuf, 0, $len, "");
		$xl = length($$buf);
	}
	else {
		$xl = length(substr($$buf, $off) = substr($$rbuf, 0, $len, ""));
	}

	# increment total number of bytes extracted
	# may differ from requested length if _decrypt_read() not called or EOF
	$self->{$V_TOTAL_BYTES} += $xl;

	return $xl;
}

############################################################

1;

__END__