Crypt-Rhash

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

	$inc  = "-I$inc_dir" if $inc_dir;
	$libs = "-L$lib_dir" if $lib_dir;
	$libs .= ' -lrhash'  if $rh_type ne 'builtin';
} else {
	# set custom compile and linking flags
	$inc = $custom_inc;
	$libs = $custom_ld;
}

# copy and rename *.c files by prepending underscore '_'
sub copy_c_files($) {
	my $from_dir = $_[0];
	my @result = ();
	(opendir my($dh), $from_dir) or die "Can't open $from_dir: $!";
	my @files = grep { /(?<!\Atest_hashes)\.c$/ } readdir $dh;
	closedir $dh;
	for (@files) {
		my ($from, $to) = ("$from_dir/$_", "_$_");
		push @result, $to;

		my ($df, $dt) = ((stat($from))[9], (stat($to))[9]);

Rhash.pm  view on Meta::CPAN

use constant RHASH_SHA3_512  => 0x2000000;
use constant RHASH_CRC32C    => 0x4000000;
use constant RHASH_SNEFRU128 => 0x8000000;
use constant RHASH_SNEFRU256 => 0x10000000;
use constant RHASH_ALL       => 0x1FFFFFFF;

##############################################################################
# Rhash class methods

# Rhash object constructor
sub new($$@)
{
	my $hash_id = 0;
	shift;
	scalar(@_) > 0 or die "hash_id not specified";
	for my $id (@_) {
		$hash_id |= scalar($id);
		if(!scalar($id) || (scalar($id) & RHASH_ALL) != $id) {
			die "bad hash_id = " . scalar($id);
		}
	}
	my $context = rhash_init($hash_id) or return undef;
	my $self = {
		context => $context,
	};
	return bless $self;
}

# destructor
sub DESTROY($)
{
	my $self = shift;
	# the 'if' added as workaround for perl 'global destruction' bug
	# ($self->{context} can disappear on global destruction)
	rhash_free($self->{context}) if $self->{context};
}

sub update($$)
{
	my $self = shift;
	my $message = shift;
	rhash_update($self->{context}, $message);
	return $self;
}

sub update_fd($$;$$)
{
	my ($self, $fd, $start, $size) = @_;
	my $res = 0;
	my $num = 0;

	binmode($fd);
	if(defined($start)) {
		seek($fd, scalar($start), 0) or return undef;
	}

Rhash.pm  view on Meta::CPAN

	} else {
		while( ($res = read($fd, $data, 8192)) ) {
			rhash_update($self->{context}, $data);
			$num += $res;
		}
	}

	return (defined($res) ? $num : undef); # return undef on read error
}

sub update_file($$;$$)
{
	my ($self, $file, $start, $size) = @_;
	open(my $fd, "<", $file) or return undef;
	my $res = $self->update_fd($fd, $start, $size);
	close($fd);
	return $res;
}

sub final($)
{
	my $self = shift;
	rhash_final($self->{context});
	return $self;
}

sub reset($)
{
	my $self = shift;
	rhash_reset($self->{context});
	return $self;
}

sub hashed_length($)
{
	my $self = shift;
	return rhash_get_hashed_length($self->{context});
}

sub hash_id($)
{
	my $self = shift;
	return rhash_get_hash_id($self->{context});
}

##############################################################################
# Hash formatting functions

# printing constants
use constant RHPR_DEFAULT   => 0x0;
use constant RHPR_RAW       => 0x1;
use constant RHPR_HEX       => 0x2;
use constant RHPR_BASE32    => 0x3;
use constant RHPR_BASE64    => 0x4;
use constant RHPR_UPPERCASE => 0x8;
use constant RHPR_REVERSE   => 0x10;

sub hash($;$$)
{
	my $self = shift;
	my $hash_id = scalar(shift) || 0;
	my $print_flags = scalar(shift) || RHPR_DEFAULT;
	return rhash_print($self->{context}, $hash_id, $print_flags);
}

sub hash_base32($;$)
{
	hash($_[0], $_[1], RHPR_BASE32);
}

sub hash_base64($;$)
{
	hash($_[0], $_[1], RHPR_BASE64);
}

sub hash_hex($;$)
{
	hash($_[0], $_[1], RHPR_HEX);
}

sub hash_rhex($;$)
{
	hash($_[0], $_[1], RHPR_HEX | RHPR_REVERSE);
}

sub hash_raw($;$)
{
	hash($_[0], $_[1], RHPR_RAW);
}

sub magnet_link($;$$)
{
	my ($self, $filename, $hash_mask) = @_;
	return rhash_print_magnet($self->{context}, $filename, $hash_mask);
}

our $AUTOLOAD;

# report error if a script called unexisting method/field
sub AUTOLOAD
{

Rhash.pm  view on Meta::CPAN

	die "no arguments specified to $field()" if !@_;
	die "the $field() argument is undefined" if !defined $self;

	($type = ref($self)) && $type eq $pkg || die "the $field() argument is not a $pkg reference";
	my $text = (exists $self->{$field} ? "is not accessible" : "does not exist");
	die "the method $field() $text in the class $pkg";
}

# static functions

sub msg($$)
{
	my ($hash_id, $msg) = @_;
	my $raw = rhash_msg_raw($hash_id, $msg); # get binary hash
	return (is_base32($hash_id) ? raw2base32($raw) : raw2hex($raw));
}

1;
__END__
# Below is Rhash module documentation in the standard POD format