#!/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; }