package Crypt::Random::ISAAC;
use strict;

require Exporter;
use vars qw'@ISA @EXPORT_OK $VERSION';
use subs 'rand';

@ISA       = 'Exporter';
@EXPORT_OK = qw'rand randinit';
$VERSION   = '0.92';

=head1 NAME

Crypt::Random::ISAAC - ISAAC Crypto-secure PRNG, using address allocation as
seed.

=head1 SYNOPSIS

This is a drop-in replacement for Perl's C<rand()>, but nothing is exported by 
default.

	use Crypt::Random::ISAAC 'rand';
	print rand();
	
	## OR ##
	
	use Crypt::Random::ISAAC;
	print Crypt::Random::ISAAC::rand();
	
	## OR ##
	
	use Crypt::Random::ISAAC qw'rand randinit';
	@Crypt::ISAAC::randrsl = @seed[0..255];
	randinit(1); ## inits using seed value;
	print rand();

This can be used with other modules like C<Crypt::RandPasswd> in the following
manner:

	use Crypt::Random::ISAAC;
	use Crypt::RandPasswd;
	*Crypt::RandPasswd::rng = \&Crypt::Random::ISAAC::rand;

since our rand function has the same interface.

=head1 DESCRIPTION

A CSPRNG using natural timing (specific to exact CPU and load when run) as a
seed, conforming to the ISAAC spec (considered Cryptograpically Secure).
Core PRNG uses code originally (c)Bob Jenkins, 1996 and ported to Perl by
John L. Allen, 2000. See L<http://burtleburtle.net/bob/rand/isaacafa.html> for
the original C code and the Perl translation.

Initialization is peformed during module load, but can be repeated.

=head1 CAVEATS

=over 1

=item Seed not tested

Although the ISAAC algorithm has been well-tested for security, the method for
choosing the random seed that is employed by this module B<has not>.  The seed
is chosen by allocating memory for references, assigning the lower 32 bits of
the address to each seed slot.  The results are mixed somewhat before use, and
care is taken to ensure that a contiguous block of addresses are not used.

If this is not secure enough, the C<@randrsl> array can be populated with seed
values from a more entropic source (like /dev/random on *NIX).  If this is done,
you must call the C<randinit> function to re-seed the generator.  For example:

	if (-f '/dev/random') {
		open RAND, '<', '/dev/random' or die('No read on random device');
		for (0..255) { 
			my $bytes = read(RAND,2);
			$bytes = (ord(substr($bytes,0,1))<<16) + (ord(substr($bytes,1,1)));
			$Crypt::Random::ISAAC::randrsl[$_] = $bytes;
		}
		close RAND;
	}

But then, if you have C</dev/random>, you probably don't need this module!

=item Rand function wrapper insufficiently tested

The replacement C<rand()> relies on C<isaac()> for its randomness.  Some
numerical conversion is done.  While I don't believe this conversion has any
effect on randomness, it has not been robustly tested.  The author welcomes
feedback on this function.

=back

=head1 HISTORY

=over 1

=item Version 0.9

Released on PerlMonks L<http://www.perlmonks.com> - original version.

=item Version 0.91

Not released, testing version

=item Version 0.92

Released on PerlMonks L<http://www.perlmonks.com> - new random-seeder method;
uses the lowest 32 bits of a series of addresses belonging to references.  This
should be hard to reproduce or guess.

=back

=cut

## This code is John L. Allen's Perl, with some layout modifications (perltidy)
## and slight changes to documentation.

### BEGIN PORT

use integer;

# /* external results */
my ( @randrsl, $randcnt );

# /* internal state */
my (@mm);
my ( $aa, $bb, $cc ) = ( 0, 0, 0 );

sub isaac() {
	my ( $i, $x, $y );

	$cc++;    # /* cc just gets incremented once per 256 results */
	$bb += $cc;    # /* then combined with bb */

	for ( $i = 0 ; $i < 256 ; $i++ ) {
		$x = $mm[$i];
		$aa = $mm[( $i + 128 ) & 255] + ( $aa ^ ( $aa << 13 ) );
		$mm[$i]      = $y  = $mm[( $x >> 2 ) & 255] + $aa + $bb;
		$randrsl[$i] = $bb = $mm[( $y >> 10 ) & 255] + $x;
		$i++;

		$x = $mm[$i];
		$aa = $mm[( $i + 128 ) & 255] + ( $aa ^ ( 0x03ffffff & ( $aa >> 6 ) ) );
		$mm[$i]      = $y  = $mm[( $x >> 2 ) & 255] + $aa + $bb;
		$randrsl[$i] = $bb = $mm[( $y >> 10 ) & 255] + $x;
		$i++;

		$x = $mm[$i];
		$aa = $mm[( $i + 128 ) & 255] + ( $aa ^ ( $aa << 2 ) );
		$mm[$i]      = $y  = $mm[( $x >> 2 ) & 255] + $aa + $bb;
		$randrsl[$i] = $bb = $mm[( $y >> 10 ) & 255] + $x;
		$i++;

		$x  = $mm[$i];
		$aa =
		  $mm[( $i + 128 ) & 255] + ( $aa ^ ( 0x0000ffff & ( $aa >> 16 ) ) );
		$mm[$i]      = $y  = $mm[( $x >> 2 ) & 255] + $aa + $bb;
		$randrsl[$i] = $bb = $mm[( $y >> 10 ) & 255] + $x;

=begin comment

     /* Note that bits 2..9 are chosen from x but 10..17 are chosen
        from y.  The only important thing here is that 2..9 and 10..17
        don't overlap.  2..9 and 10..17 were then chosen for speed in
        the optimized version (rand.c) */
     /* See http://burtleburtle.net/bob/rand/isaac.html
        for further explanations and analysis. */

=end comment

=cut

	}
}    #__ end sub isaac()

=begin comment

/* if (flag==TRUE), then use the contents of randrsl[] to initialize mm[].
*/

        "mix" is "inlined" - see below

Note: The above C comment seems to be out of place, having been just
above the definition of the mix macro in readable.c.

=end comment

=cut

sub randinit {
	my ($flag) = @_;
	my $i;
	my ( $a, $b, $c, $d, $e, $f, $g, $h );
	$aa = $bb = $cc = 0;
	$a = $b = $c = $d = $e = $f = $g = $h = 0x9e3779b9; # /* the golden ratio */

	for ( $i = 0 ; $i < 4 ; ++$i )                      # /* scramble it */
	{

		# "mix"
		$a ^= $b << 11;
		$d += $a;
		$b += $c;
		$b ^= 0x3fffffff & ( $c >> 2 );
		$e += $b;
		$c += $d;
		$c ^= $d << 8;
		$f += $c;
		$d += $e;
		$d ^= 0x0000ffff & ( $e >> 16 );
		$g += $d;
		$e += $f;
		$e ^= $f << 10;
		$h += $e;
		$f += $g;
		$f ^= 0x0fffffff & ( $g >> 4 );
		$a += $f;
		$g += $h;
		$g ^= $h << 8;
		$b += $g;
		$h += $a;
		$h ^= 0x007fffff & ( $a >> 9 );
		$c += $h;
		$a += $b;
	}

	for ( $i = 0 ; $i < 256 ; $i += 8 )    # /* fill in mm[] with messy stuff */
	{
		if ($flag)    # /* use all the information in the seed */
		{
			$a += $randrsl[$i];
			$b += $randrsl[$i + 1];
			$c += $randrsl[$i + 2];
			$d += $randrsl[$i + 3];
			$e += $randrsl[$i + 4];
			$f += $randrsl[$i + 5];
			$g += $randrsl[$i + 6];
			$h += $randrsl[$i + 7];
		}

		# "mix"
		$a ^= $b << 11;
		$d += $a;
		$b += $c;
		$b ^= 0x3fffffff & ( $c >> 2 );
		$e += $b;
		$c += $d;
		$c ^= $d << 8;
		$f += $c;
		$d += $e;
		$d ^= 0x0000ffff & ( $e >> 16 );
		$g += $d;
		$e += $f;
		$e ^= $f << 10;
		$h += $e;
		$f += $g;
		$f ^= 0x0fffffff & ( $g >> 4 );
		$a += $f;
		$g += $h;
		$g ^= $h << 8;
		$b += $g;
		$h += $a;
		$h ^= 0x007fffff & ( $a >> 9 );
		$c += $h;
		$a += $b;
		$mm[$i]     = $a;
		$mm[$i + 1] = $b;
		$mm[$i + 2] = $c;
		$mm[$i + 3] = $d;
		$mm[$i + 4] = $e;
		$mm[$i + 5] = $f;
		$mm[$i + 6] = $g;
		$mm[$i + 7] = $h;
	}

	if ($flag)
	{    # /* do a second pass to make all of the seed affect all of mm */
		for ( $i = 0 ; $i < 256 ; $i += 8 ) {
			$a += $mm[$i];
			$b += $mm[$i + 1];
			$c += $mm[$i + 2];
			$d += $mm[$i + 3];
			$e += $mm[$i + 4];
			$f += $mm[$i + 5];
			$g += $mm[$i + 6];
			$h += $mm[$i + 7];

			# "mix"
			$a ^= $b << 11;
			$d += $a;
			$b += $c;
			$b ^= 0x3fffffff & ( $c >> 2 );
			$e += $b;
			$c += $d;
			$c ^= $d << 8;
			$f += $c;
			$d += $e;
			$d ^= 0x0000ffff & ( $e >> 16 );
			$g += $d;
			$e += $f;
			$e ^= $f << 10;
			$h += $e;
			$f += $g;
			$f ^= 0x0fffffff & ( $g >> 4 );
			$a += $f;
			$g += $h;
			$g ^= $h << 8;
			$b += $g;
			$h += $a;
			$h ^= 0x007fffff & ( $a >> 9 );
			$c += $h;
			$a += $b;
			$mm[$i]     = $a;
			$mm[$i + 1] = $b;
			$mm[$i + 2] = $c;
			$mm[$i + 3] = $d;
			$mm[$i + 4] = $e;
			$mm[$i + 5] = $f;
			$mm[$i + 6] = $g;
			$mm[$i + 7] = $h;
		}
	}

	isaac();    # /* fill in the first set of results */
	$randcnt = 256;    # /* prepare to use the first set of results */
}

### END PORT
#===============================================================================

## Initialization code for module, (c)2005 Darren Meyer <darren.meyer@gmail.com>

## This is at the end because it needs package globals declared in Mr. Allen's
## code.

# establish seed.
#- removed in 0.92
#- use Time::HiRes qw'time';
#- for ( 1 .. 1023 ) { $randrsl[int( $_ / 4 )] = ( time() . "$$" ) + $_ }

#+ added in 0.92
@randrsl = rand_seed();

randinit(1);

# next sequence to use; isaac generates 256 random values, we might as well
# use them all
my ($seq) = 0;

## turns on debugging-type warnings.
my $DEBUG = 0;

## Rand Function, (c)2005 Darren Meyer <darren.meyer@gmail.com>
#_____________________________________________________________________rand()
sub rand {
	no integer;    ## turn of integral math for this sub
	## drop-in replacement for system rand().
	my $mult = shift || 1;

	#print STDERR 'Mult: ',$mult,"\n";
	$DEBUG && warn 'Using ISAAC::rand';

	## if we've exhausted the queue, reset the index and generate a new set.
	if ( $seq > 255 ) {
		isaac();
		$seq = 0;
	}

	my $rand = undef;
	do {
		$rand =
		  eval( sprintf( '0x%x', $randrsl[$seq] ) );  ##convert to unsigned int;
		$rand = $rand / 0xFFFFFFFF * $mult;    ## convert to float and mult.
	};

	## two things that should never happen:
	defined $rand || ( warn '$rand not set, reason unknown.' and return );
	( $rand > 0 && $rand < $mult )
	  || ( warn '$rand out of acceptable range.' and return );

	$seq++;    ## adjusts global so that next run uses next random number.
	return $rand;
}    #_ rand()

## Random Seed populator, (c)2005 Darren Meyer <darren.meyer@gmail.com>
## Introduced in v0.02
#________________________________________________________________rand_seed()
sub rand_seed {
	## returns a 32-bit value for random seed.
	## these are not random (duh) but should be hard to reproduce
	my @refs;

	## create a bunch of array refs.
	for ( 0 .. 255 ) {
		$refs[$_] = [undef];
		if ( $_ % 2 ) { delete $refs[$_] }    ## delete every other ref
	}

	## create new array refs in empty spots ('interleaves' address space)
	for ( @refs[0 .. 255] ) { defined $_ or $_ = [undef] }

	## harvest addresses as 32-bit values.
	for (@refs) { $_ = "$_"; s/^\w+.|.$//g; }

	## use the address spaces by replacing with hash references.
	for ( 0 .. 255 ) { $refs[$_] = {$refs[$_] => $refs[$_ - 1]} }

	## harvest them again
	for (@refs) { $_ = "$_"; s/^\w+.|.$//g; }

	## make sure we're returning numerical values of no more than 32 bits.
	return map { sprintf( '%d', eval "$_" ) & 0xFFFFFFFF } @refs;
}    #/get_val()

#===============================================================================

=head1 AUTHOR

Darren Meyer <darren.meyer@gmail.com>, making heavy use of others' code.

=head1 COPYRIGHT

Original ISAAC code (c)1996 Bob Jenkins under a "code is free and may be used as
you wish" license.

Perl port (c)2000 John L. Allen under the same license as the original ISAAC
code.

This module is available under the terms of the MIT License, though the code by
the above authors is unencumbered.:

Copyright (c)2005 Darren Meyer

Permission is hereby granted, free of charge, to any person obtaining a copy of 
this software and associated documentation files (the "Software"), to deal in 
the Software without restriction, including without limitation the rights to 
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 
of the Software, and to permit persons to whom the Software is furnished to do 
so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all 
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 
SOFTWARE.

=cut

1;