view release on metacpan or  search on metacpan

t/20-validate_encrypt_decrypt.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use File::Basename;
use File::Spec;
use Sys::Hostname;
use Fred::Fish::DBUG 2.09 qw / on /;
use Fred::Fish::DBUG::Test 2.09;

# How to find the helper module ...
BEGIN { push (@INC, File::Spec->catdir (".", "t", "test-helper")); }
use helper1234;

my $fish;

# =================================================================
# Tests the encryption/decryption logic.
# =================================================================
# Assumptions about the config files made by this test program:
# If any assumtions are false, you will see test failures.
#   1) No tag appeears in multiple sections for this test.
#   2) All tags starting with "join" are assumed to reference
#      encrypted variables/tags.
# =================================================================

BEGIN {
   $fish = turn_fish_on_off_for_advanced_config ();

   unlink ( $fish );

   DBUG_ENTER_FUNC ();

   use_ok ("Advanced::Config");

   DBUG_VOID_RETURN ();
}


END {
   DBUG_ENTER_FUNC ();
   # Don't do any tests in the END block ...
   DBUG_VOID_RETURN ();
}

# =================================================================

my %decrypt_callback_tags;
my %encrypt_callback_tags;

sub my_security_callback
{
   DBUG_ENTER_FUNC (@_);
   my $mode     = shift;    # 0 = Decrypt / 1 = Encrypt
   my $tag      = shift;
   my $value    = shift;
   my $file     = shift;
   my $workArea = shift;

   if ( $mode == 0 ) {
      # Decryption ...
      $decrypt_callback_tags{$tag} = 1;
      if ( $value =~ m/^XX(.*)YY$/ ) {
         $value = $1;
      } else {
         $value = "Bogus decryption ...";
      }
   } else {
      # Encryption ...
      $encrypt_callback_tags{$tag} = 1;
      $value = "XX" . $value . "YY";
   }

   DBUG_RETURN ( $value );
}

sub my_source_callback
{
   DBUG_ENTER_FUNC (@_);
   my %opts = ( alias => "20-0-encrypt-decrypt.cfg",
                encrypt_cb => \&my_security_callback );
   DBUG_RETURN ( \%opts, undef );
}