File Coverage

blib/lib/WWW/Live/Auth/Utils.pm

Criterion	Covered	Total	%
statement	15	49	30.6
branch	0	8	0.0
condition	0	6	0.0
subroutine	5	14	35.7
pod			n/a
total	20	77	25.9

# Copyright 2008 Andrew M. Jenkinson, all rights reserved
# Use and/or distribution is permitted only with prior consent
package WWW::Live::Auth::Utils;

use strict;
use warnings;

use base qw(Exporter);

require Crypt::Rijndael;
require Digest::SHA;
require MIME::Base64;
use Carp;

use vars qw(@EXPORT @EXPORT_OK);
@EXPORT = @EXPORT_OK = qw(_unescape _escape _decode _encode _decrypt _validate _sign _timestamp _split);

sub _unescape {
  return URI::Escape::uri_unescape( shift );
}

sub _escape {
  return URI::Escape::uri_escape( shift );
}

sub _decode {
  my $decoded = MIME::Base64::decode_base64( shift );
  if ( length $decoded <= 16 || (length $decoded) % 16 != 0 ) {
    croak('Unable to decode token');
  }
  return $decoded;
}

sub _encode {
  return MIME::Base64::encode_base64( shift );
}

sub _decrypt {
  my $decoded   = shift;
  my $encryption_key = shift;
  my $iv        = substr($decoded, 0, 16);
  my $encrypted = substr($decoded, 16);
  my $cipher = Crypt::Rijndael->new( $encryption_key,
                                     Crypt::Rijndael::MODE_CBC() );
  $cipher->set_iv($iv);
  return $cipher->decrypt( $encrypted );
}

sub _validate {
  my $decrypted     = shift;
  my $signature_key = shift;

  my ( $token, $signature ) = split /&sig=/, $decrypted;
  if ( !$token || !$signature ) {
    croak('Unable to validate decrypted token');
  }
  $signature = _decode( _unescape( $signature ) );

  my $compare_signature = _sign( $token, $signature_key );
  if ( $signature ne $compare_signature ) {
    croak('Decrypted token does not match signature');
  }

  return $token;
}

sub _sign {
  my ( $token, $signature_key ) = @_;
  return Digest::SHA::hmac_sha256( $token, $signature_key );
}

sub _timestamp {
  return time();
}

sub _split {
  my ( $s ) = @_;
  my %split = ();
  my @pairs = split /&/, $s;
  for ( @pairs ) {
    my ( $key, $val ) = split /=/, $_;
    $split{$key} = $val;
  }
  return wantarray ? %split : \%split;
}

1;
__END__