File Coverage

blib/lib/Session/Token.pm

Criterion	Covered	Total	%
statement	37	41	90.2
branch	22	34	64.7
condition	8	18	44.4
subroutine	4	4	100.0
pod	0	1	0.0
total	71	98	72.4

package Session::Token;

use strict;

use Carp qw/croak/;
use POSIX qw/ceil/;


our $VERSION = '1.501';

require XSLoader;
XSLoader::load('Session::Token', $VERSION);


my $default_alphabet = join('', ('0'..'9', 'a'..'z', 'A'..'Z',));
my $default_entropy = 128;

my $is_windows;

if ($^O =~ /mswin/i) {
  require Crypt::Random::Source::Strong::Win32;
  $is_windows = 1;
}


sub new {
  my ($class, @args) = @_;

  ## support arguments in a hash ref
  @args = %{$args[0]} if @args == 1 && ref $args[0] eq 'HASH';

  my %args = @args;


  ## Init seed

  my $seed;

  if (defined $args{seed}) {
    croak "seed argument should be a 1024 byte long bytestring"
      unless length($args{seed}) == 1024;
    $seed = $args{seed};
  }

  if (!defined $seed) {
    if ($is_windows) {
      my $windows_rng_source = Crypt::Random::Source::Strong::Win32->new;
      $seed = $windows_rng_source->get(1024);
      die "Win32 RNG source didn't provide 1024 bytes" unless length($seed) == 1024;
    } else {
      my ($fh, $err1, $err2);

      open($fh, '<:raw', '/dev/urandom') || ($err1 = $!);
      open($fh, '<:raw', '/dev/arandom') || ($err2 = $!)
        unless defined $fh;

      if (!defined $fh) {
        croak "unable to open /dev/urandom ($err1) or /dev/arandom ($err2)";
      }

      sysread($fh, $seed, 1024) == 1024 || croak "unable to read from random device: $!";
    }
  }


  ## Init alphabet

  my $alphabet = defined $args{alphabet} ? $args{alphabet} : $default_alphabet;
  $alphabet = join('', @$alphabet) if ref $alphabet eq 'ARRAY';

  croak "alphabet must be between 2 and 256 bytes long"
    if length($alphabet) < 2 || length($alphabet) > 256;


  ## Init token length

  croak "you can't specify both length and entropy"
    if defined $args{length} && defined $args{entropy};

  my $token_length;

  if (defined $args{length}) {
    croak "bad value for length" unless $args{length} =~ m/^\d+$/ && $args{length} > 0;
    $token_length = $args{length};
  } else {
    my $entropy = $args{entropy} || $default_entropy;
    croak "bad value for entropy" unless $entropy > 0;
    my $alphabet_entropy = log(length($alphabet)) / log(2);
    $token_length = ceil($entropy / $alphabet_entropy);
  }


  return _new_context($seed, $alphabet, $token_length);
}



1;



__END__