view release on metacpan or  search on metacpan

lib/Captcha/Stateless/Text.pm  view on Meta::CPAN

###############################################################################
# Captcha::Stateless::Text module for Perl.
# Copyright (C) 2024, Lester Hightower <hightowe@cpan.org>
###############################################################################

package Captcha::Stateless::Text;

use strict;
use v5.20; # Version needed for feature signatures
use feature qw(signatures);
no warnings qw(experimental::signatures);
use Sub::Util qw(set_subname);   # core
use MIME::Base64 qw();           # core
use Digest::MD5 qw(md5_hex);     # core
use Data::Dumper;                # core
use Try::Tiny;                   # libtry-tiny-perl
use Crypt::Mode::CBC;            # libcryptx-perl
use JSON qw(to_json from_json);  # libjson-perl
use Lingua::EN::Nums2Words;      # From CPAN (cpanm Lingua::EN::Nums2Words)
$Data::Dumper::Sortkeys = 1;
Lingua::EN::Nums2Words::set_case('lower');

our $VERSION = "0.5";
sub Version { $VERSION; }

my %QAfuncs = {}; # Holds our private __ANON__ subroutines

sub new {
  my $class = shift;
  my $self = {
    cipher => 'AES',
    iv  => 'gkbx5g9hsvhqrosg',                 # Must be 16 bytes / 128 bits
    key => 'tyDjb39dQ20pdva0lTpyuiowWfxSSwa9', # 32 bytes / 256 bits (AES256)
    ep_pre => 'captcha'.lc(substr(md5_hex(__PACKAGE__), 0, 6)).'.',
  };
  bless $self, $class;
  return $self;
}

#############################################################################
# Object parameter get/set functions ########################################
#############################################################################
sub get_ep_pre($self)           { return $self->{ep_pre}; }
sub set_self_val($self, $k, $v) { $self->{$k} = $v; }
sub set_cipher($self, $v)       { set_self_val($self, 'cipher', $v); }
sub set_iv($self, $v)           { set_self_val($self, 'iv', $v); }
sub set_key($self, $v)          { set_self_val($self, 'key', $v); }

#############################################################################
# Crypto functions ##########################################################
#############################################################################
sub encrypt_b64($self, $data) {
  my $d = my_crypt_cbc($self, 'encrypt', $self->{cipher}, $self->{key}, $self->{iv}, $data);
  return MIME::Base64::encode_base64url($d, ''); # '' for no line breaks
}
sub decrypt_b64($self, $data) {
  my $d = MIME::Base64::decode_base64url($data);
  return my_crypt_cbc($self, 'decrypt', $self->{cipher}, $self->{key}, $self->{iv}, $d);
}
# Helper function to centralize and reduce code duplication
sub my_crypt_cbc($self, $mode, $cipher, $key, $iv, $data) {
  my $pkg = __PACKAGE__;

  my $cbc = Crypt::Mode::CBC->new($cipher, 1);
  if ($mode eq 'encrypt') {
    my $payload = undef;
    try {
      $payload = $cbc->encrypt($data, $key, $iv); # ENCRYPT
    } catch {
      warn("$pkg my_crypt_cbc() failed to $mode with error: $_");
      $payload = undef;
    };
    return $payload;
  } elsif ($mode eq 'decrypt') {
    my $payload = undef;
    try {