view release on metacpan or  search on metacpan

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

    } 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<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