#!/usr/bin/perl
 
use strict;
use warnings;
 
use String::CRC::Cksum qw(cksum);
use Crypt::CBC;
 
# Utility function.
sub display {
    my ( $first, $second ) = @_;
    print ' 'x( 16 - length $first ), "$first: '$second'\n";
}
 
my $database_id    = 1234;
my $session_id     = 5678;
my $session_secret = join '', 'a'..'z';
 
# Create the input.
my $in = join ':', $database_id, $session_id, $session_secret;
display "Input", $in;
 
my $cipher_text = my_encrypt( $in );
display "Encrypted token", $cipher_text;
 
# $cipher_text =~ s/a/b/g; # <= uncomment to muck up the encryption.
# display "Altered token", $cipher_text;
 
my $out = my_decrypt( $cipher_text );
display "Output", $out;
 
display 'Result', $in eq $out ? "Good" : "Bad";
 
############################################## 
sub my_encrypt {
    my $input = shift || die;
 
    # Calculate the checksum and then prepend it to the token.
    my $cksum = cksum( $input );

    my $token = join ':', $cksum, $input;
    display "Token", $token;
 
    # Encrypt the token to hex.
    my $cipher = get_cipher();
    my $hex_token = $cipher->encrypt_hex( $token );
 
    return $hex_token;
}
 
sub my_decrypt {
    my $input = shift || die;
    my $cipher = get_cipher();
 
    my $cksum_token = $cipher->decrypt_hex( $input );
    display "Decrypted token", $cksum_token;
 
    unless ( $cksum_token ) {
        warn "Error decrypting";
        return 0;
    }
     
     
    # Extract the checksum and then check it.
    my ( $cksum, $token ) = split /:/, $cksum_token, 2;
     
    # If the checksum is correct.
    return $token if defined $cksum
        && $token
        && $cksum =~ m/^\d+$/
        && cksum( $token ) == $cksum;
 
    # If it is not correct then complain.
    warn "Checksum is wrong.";
    return 0;
}
 
sub get_cipher {
    my $system_secret = 'top secret';
 
    return Crypt::CBC->new
        ( {'key'    => $system_secret,
           'cipher' => 'Blowfish' }
        ) || die;
}
[download]