File Coverage

blib/lib/Crypt/Mimetic.pm

Criterion	Covered	Total	%
statement	68	169	40.2
branch	4	42	9.5
condition	8	24	33.3
subroutine	23	37	62.1
pod	15	17	88.2
total	118	289	40.8

=pod

=head1 NAME

Crypt::Mimetic - Crypt a file and mask it behind another file


=head1 SYNOPSIS

 use Crypt::Mimetic;

 Crypt::Mimetic::Mask($original_file, $mask_file, $destination_file, $algorithm);
 Crypt::Mimetic::Unmask($mimetic_file);

 Crypt::Mimetic::Main($original_file, $mask_file, $destination_file, [$algorithm]);
 Crypt::Mimetic::Main($mimetic_file);


=head1 DESCRIPTION

This module allows you to hide a file by encrypting in and then attaching
it to another file of your choice.
This mimetic file then looks and behaves like a normal file,
and can be stored, used or emailed without attracting attention.


=head1 EXAMPLES

=head2 Here your first running example

 use Crypt::Mimetic;
 use Error;
 $Error::Debug = 1;

 &Crypt::Mimetic::Main(@ARGV);

You should already have it in your bin/ files: write I and follow instructions.

=head2 How to make a test of all encryption algorithms

 use Crypt::Mimetic;

 use Error qw(:try);
 $Error::Debug = 1;

 print "\nPerforming tests for Crypt::Mimetic\n";
 print "Looking for available encryption algorithms, please wait... ";
 select((select(STDOUT), $| = 1)[0]); #flush stdout

 @algo = Crypt::Mimetic::GetEncryptionAlgorithms();
 print @algo ." algorithms found.\n\n";

 $str = "This is a test string";
 $failed = 0;
 $warn = 0;

 foreach my $algo (@algo) {

    try {

       print ''. Crypt::Mimetic::ShortDescr($algo) ."\n";
       print " Encrypting string '$str' with $algo...";
       select((select(STDOUT), $| = 1)[0]); #flush stdout

       ($enc,@info) = Crypt::Mimetic::EncryptString($str,$algo,"my stupid password");
       print " done.\n";

       print " Decrypting encrypted string with $algo...";
       select((select(STDOUT), $| = 1)[0]);

       $dec = Crypt::Mimetic::DecryptString($enc,$algo,"my stupid password",@info);
       print " '$dec'.\n";

       if ($dec eq $str) {
          print "Algorithm $algo: ok.\n\n";
       } else {
          print "Algorithm $algo: failed. Decrypted string '$dec' not equals to original string '$str'\n\n";
          $failed++;
       }#if-else

    } catch Error::Mimetic with {
       my $x = shift;

       if ($x->type() eq "error") {
          print "Algorithm $algo: error. ". $x->stringify() ."\n";
          $failed++;
       } elsif ($x->type() eq "warning") {
          print "Algorithm $algo: warning. ". $x->stringify() ."\n";
          $warn++;
       }#if-else

    }#try-catch

 }#foreach

 print @algo ." tests performed: ". (@algo - $failed) ." passed, $failed failed ($warn warnings).\n\n";
 exit $failed;

Script I used by I in this distribution
do exactly the same thing.

=cut

package Crypt::Mimetic;
use strict;
use vars qw($VERSION);

use Error qw(:try);
use Error::Mimetic;
use Term::ReadKey;
use File::Copy;
use File::Find ();

$VERSION = '0.02';

=pod

=head1 PROCEDURAL INTERFACE

=over 4

=item @array I ()

Return an array with names of encryption algorithms. Each algorithm is
implemented in module Crypt::Mimetic::

=cut

sub GetEncryptionAlgorithms {
	# Set the variable $File::Find::dont_use_nlink if you're using AFS,
	# since AFS cheats.

	# for the convenience of &wanted calls, including -eval statements:
	use vars qw/*name *dir *prune/;
	*name   = *File::Find::name;
	*dir    = *File::Find::dir;
	*prune  = *File::Find::prune;

	my (@dirs, %algo);
	my $wanted = sub {
		my ($dev,$ino,$mode,$nlink,$uid,$gid);

		/^Mimetic\z/os &&
		(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
		-d _ &&
		push(@dirs,"$name");
	};

	# Traverse desired filesystems
	File::Find::find({wanted => $wanted}, @INC);

	$wanted = sub {
		my ($dev,$ino,$mode,$nlink,$uid,$gid);

		/^.*\.pm\z/os &&
		(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
		-f _ || return;
		s/^(.+)\.pm$/$1/o;
		$algo{$_} = $_;
	};

	File::Find::find({wanted => $wanted}, @dirs);
	return ( keys %algo );
}

=pod

=item string I ($prompt)

Ask for a password with a given prompt (default "Password: ")
and return it.

=cut

sub GetPasswd {
	my ($prompt) = @_;
	$prompt = "Password: " unless $prompt;
	print STDERR $prompt;
	ReadMode('noecho');
	my $key = ReadLine(0);
	ReadMode('restore');
	print "\n";
	$key =~ s/[\r\n]*$//o;
	return $key;
}

=pod

=item string I ()

Ask for a password twice and return it only if it's correct.

Throws an I if passwords don't match

=cut

sub GetConfirmedPasswd {
	my $passwd = GetPasswd();
	return "" if ($passwd eq "");
	my $confirm = GetPasswd("Again: ");
	return $passwd if ($passwd eq $confirm);
	throw Error::Mimetic "Passwords don't match at ". __FILE__ ." line ". __LINE__;
}

#
# @array ExternalCall($algoritm,$func)
#
sub ExternalCall {
	my ($algorithm,$func,@args) = @_;
	eval('use Crypt::Mimetic::' . $algorithm);
	throw Error::Mimetic ("Error using algorithm '$algorithm' at ". __FILE__ ." line ". __LINE__, $@) if $@;
	no strict 'refs';
	return &{ 'Crypt::Mimetic::' . $algorithm . '::' . $func }(@args);
}

=pod

=item string I ($algorithm)

Return a short description of $algorithm

=cut

sub ShortDescr {
	my ($algorithm) = @_;
	try {
		return ExternalCall($algorithm,'ShortDescr');
	} catch Error::Mimetic with {
		my $x = shift;
		$x->{'-type'} = "warning";
		throw $x;
	}
}

=pod

=item boolean I ($algorithm)

Return true if password is needed by this $algorithm, false otherwise.

=cut

sub PasswdNeeded {
	my ($algorithm) = @_;
	return ExternalCall($algorithm,'PasswdNeeded');
}

=pod

=item ($len,$blocklen,$padlen,[string]) I ($filename,$output,$algorithm,$key,@info)

Call specific routine to encrypt $filename according to $algorithm. Return 3 int:
 $len      - is the total output length
 $blocklen - length of an encrypted block (if needed)
 $padlen   - length of last encrypted block (if needed)

If $output is null then the output is returned as string.
Ask for a password if key not given.

Throws an I if cannot open files or if password is not correctly given.

=cut

sub EncryptFile {
	my ($filename,$output,$algorithm,$key,@info) = @_;
	return ExternalCall($algorithm,'EncryptFile',$filename,$output,$algorithm,$key,@info);
}

=pod

=item string I ($string,$algorithm,$key,@info)

Call specific routine to encrypt $string according to $algorithm and return an encrypted string.
Ask for a password if key not given.

Throws an I if password is not correctly given.

=cut

sub EncryptString {
	my ($string,$algorithm,$key,@info) = @_;
	return ExternalCall($algorithm,'EncryptString',$string,$algorithm,$key,@info);
}

=pod

=item [string] I ($filename,$output,$offset,$len,$algorithm,$key,@info)

Call specific routine to decrypt $filename according to $algorithm. Return decrypted file as string if $output is not given, void otherwise.
Ask for a password if key not given.

Throws an I if cannot open files or if password is not given

=cut

sub DecryptFile {
	my ($filename,$output,$offset,$len,$algorithm,$key,@info) = @_;
	return ExternalCall($algorithm,'DecryptFile',$filename,$output,$offset,$len,$algorithm,$key,@info);
}

=pod

=item string I ($string,$algorithm,$key,@info)

Call specific routine to decrypt $string according to $algorithm and return a decrypted string.
Ask for a password if key not given.

Throws an I if password is not correctly given.

=cut

sub DecryptString {
	my ($string,$algorithm,$key,@info) = @_;
	return ExternalCall($algorithm,'DecryptString',$string,$algorithm,$key,@info);
}

=pod

=item string I ($original_file,$mask_file,$dlen,$algorithm,$key,@info)

Create following sign (all on the same line):
 Mimetic\0
 version\0
 mask_file_name\0
 mask_file_length\0
 original_file_name\0
 encrypted_file_length\0
 @info

than encrypt it and calculate length of encrypted sign.
Return a string composed by concatenation of encrypted sign, algorithm (32 bytes null padding string) and its length (8 bytes hex number).

=cut

sub Sign {
	my ($original_file,$mask_file,$dlen,$algorithm,$key,@info) = @_;
	my $mlen = (stat($mask_file))[7];
	my $sign = join "\0", "Mimetic", $VERSION, $mask_file, $mlen, $original_file, $dlen, @info;
	$sign = EncryptString($sign,$algorithm,$key,@info);
	my $slen = pack "a8", sprintf "%x", length($sign);
	my $algo = pack "A32", $algorithm;
	return join '', $sign, ~$algo, ~$slen;
}

=pod

=item (string,int) I ($mimetic_file)

Return the algorithm and the length of the sing read from last 40 bytes of $mimetic_file.

Throws an I if cannot open file

=cut

sub GetSignInfo {
	my ($mimetic_file) = @_;
	my $len = (stat($mimetic_file))[7];
	my $offset = $len - 40;
	open (FH, "$mimetic_file") or throw Error::Mimetic "Cannot open $mimetic_file: $!";
	my ($algo,$slen) = ("","");
	seek FH, $offset, 0;
	read FH, $algo, 32;
	read FH, $slen, 8;
	close(FH);
	return (unpack ("A32", ~$algo) , hex(~$slen));
}

=pod

=item ($Mimetic,$version,$mask_file,$mlen,$original_file,$olen,@pinfo) = I ($mimetic_file,$slen,$algorithm,$key,@info);

Extract information from sign of $mimetic_file.
You can obtain $slen and $algorithm from I($mimetic_file) and key from I(void)
This sub returns an array:
 $Mimetic        - constant string "Mimetic"
 $version        - version of the module
 $mask_file      - mask file's name
 $mlen           - mask file's length
 $original_file  - original file's name
 $olen           - original file's length
 @pinfo          - specific encryption algorithm information

Throws an I if cannot open file

=cut

sub ParseSign {
	my ($mimetic_file,$slen,$algorithm,$key,@info) = @_;
	my $len = (stat($mimetic_file))[7];
	my $offset = $len - 40 - $slen;
	open (FH, "$mimetic_file") or throw Error::Mimetic "Cannot open $mimetic_file: $!";
	my $sign = "";
	seek FH, $offset, 0;
	read FH, $sign, $slen;
	close(FH);
	$sign = DecryptString($sign,$algorithm,$key,@info);
	return split "\0", $sign;
}

=pod

=item void I ($mimetic_file,$len,$mask_file)

Extract the mask file from $mimetic_file and save it in $mask_file.

Throws an I if cannot open files

=cut

sub WriteMaskFile {
	my ($mimetic_file,$len,$mask_file) = @_;
	my ($buf,$blocks,$padlen) = ("",int($len/32768),($len%32768));
	open (IN, "$mimetic_file") or throw Error::Mimetic "Cannot open $mimetic_file: $!";
	open (OUT, ">$mask_file") or throw Error::Mimetic "Cannot open $mask_file: $!";
	for (my $i = 0; $i < $blocks; $i++ ) {
		read(IN,$buf,32768);
		print OUT $buf;
	}
	read(IN,$buf,$padlen);
	print OUT $buf;
	close(OUT);
	close(IN);
}

=pod

=item void I ($original_file,$mask_file,$destination_file,$algorithm,$key,@info)

Mask the $original_file with a $mask_file and put everything in $destination_file, according $algorithm and @info instruction. Return true on success, false otherwise.

Throws an I if cannot open files or password not correctly given

=cut

sub Mask {
	my ($original_file,$mask_file,$destination_file,$algorithm,$key,@info) = @_;

	#test if destination file is ok
	open (OF,">$destination_file") or throw Error::Mimetic "Cannot open $destination_file: $!";
	close(OF);

	my $passwd_needed = ExternalCall($algorithm,'PasswdNeeded');

	copy ($mask_file,$destination_file) or throw Error::Mimetic "Cannot copy $mask_file to $destination_file: $!";

	$key = GetConfirmedPasswd() or throw Error::Mimetic "Password is needed at ". __FILE__ ." line ". __LINE__ unless ($key || !$passwd_needed);
	my ($len,@einfo) = EncryptFile($original_file,$destination_file,$algorithm,$key,@info);
	my $sign = Sign($original_file,$mask_file,$len,$algorithm,$key,@einfo);

	open (OF,">>$destination_file") or throw Error::Mimetic "Cannot open $destination_file: $!";
	print OF $sign;
	close(OF);
}

=pod

=item boolean I ($mimetic_file,$algorithm,$key,@info)

Unmask a $mimetic file splitting it in 2 files:
 1. mask file
 2. original file

Throws an I if cannot open files or password not given

=cut

sub Unmask {
	my ($mimetic_file,$algorithm,$key,@info) = @_;
	my ($algo,$slen) = GetSignInfo($mimetic_file);

	$algorithm = $algo unless $algorithm;
	my $passwd_needed = ExternalCall($algorithm,'PasswdNeeded');

	$key = GetPasswd() or throw Error::Mimetic "Password is needed at ". __FILE__ ." line ". __LINE__ unless ($key || !$passwd_needed);
	my ($Mimetic,$version,$mask_file,$mlen,$original_file,$olen,@pinfo) = ParseSign($mimetic_file,$slen,$algorithm,$key,@info);

	throw Error::Mimetic "Cannot do anything on this file: signature not recognized at ". __FILE__ ." line ". __LINE__ if ($Mimetic ne "Mimetic");

	WriteMaskFile($mimetic_file,$mlen,$mask_file);
	DecryptFile($mimetic_file,$original_file,$mlen,$olen,$algorithm,$key,@pinfo);
}

=pod

=item void I (@arguments)

A demo main to use this module
 Usage:
  to camouflage a file with a mask
    Main($original_file, $mask_file, $destination_file, [$algorithm]);
  to split camouflaged file in original file and mask
    Main($mimetic_file);

=cut

sub Main {
	my @argv = @_;
	my $argc = $#argv + 1;
	if ($argc == 1) {
		return Unmask($argv[0]);
	} elsif ($argc == 3) {
		return Mask($argv[0],$argv[1],$argv[2],"None");
	} elsif ($argc == 4) {
		return Mask($argv[0],$argv[1],$argv[2],$argv[3]);
	} else {
		print <<"END";

Usage (see also Perl documentation about Crypt::Mimetic):

 to camouflage a file with a mask:
   $0 original-file mask-file destination-file [algorithm]

 to split camouflaged file in original file and mask:
   $0 mimetic-file

 (Looking for available encryption algorithms, please wait...)
END
		my @algo = GetEncryptionAlgorithms();
		print " Encryption algorithms found:\n";
		my $err = $Error::Debug;
		$Error::Debug = 1 if $err < 1;
		foreach my $algo (@algo) {
			try {
				print '   * '. ShortDescr($algo) ."\n";
			} catch Error::Mimetic with {
				my $x = shift;
				print "   * $algo - ". $x->stringify();
			}
		}
		$Error::Debug = $err;
		print " See Perl documentation about Crypt::Mimetic:: for details.\n\n";
		exit;
	}
}

1;
__END__