view release on metacpan or  search on metacpan

lib/Crypt/Mimetic.pm  view on Meta::CPAN

       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<test.pl> used by I<make test> 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<GetEncryptionAlgorithm> ()

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

=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<GetPasswd> ($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<GetConfirmedPasswd> ()

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

Throws an I<Error::Mimetic> 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

lib/Crypt/Mimetic.pm  view on Meta::CPAN

=cut

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

=pod

=item [string] I<DecryptFile> ($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<Error::Mimetic> 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<DecryptString> ($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<Error::Mimetic> 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<Sign> ($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<GetSignInfo> ($mimetic_file)

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

Throws an I<Error::Mimetic> 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<ParseSign> ($mimetic_file,$slen,$algorithm,$key,@info);

Extract information from sign of $mimetic_file.
You can obtain $slen and $algorithm from I<GetSignInfo>($mimetic_file) and key from I<GetPasswd>(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<Error::Mimetic> 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<WriteMaskFile> ($mimetic_file,$len,$mask_file)

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

Throws an I<Error::Mimetic> 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<Mask> ($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<Error::Mimetic> 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);