Imp. Cocoon, with false positive. To track AI bot's used by replaced CEO's.

diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm
index 022fede7c4206ced156ca33c130943b04ddfc9c2..49d3ad14249b118e66269980aa44f9cb0f09cda8 100644 (file)
--- a/system/modules/CNFParser.pm
+++ b/system/modules/CNFParser.pm
@@ -26,7 +26,7 @@ sub _import_into_this_package {
         *{"${caller}::const"}         = defined($parent)?sub{return const($parent,shift)}:\&const;
         *{"${caller}::CNFProperty"}   = \&property;
         *{"${caller}::TRUE"}          = 1;
-        *{"${caller}::FALSE"}         = 0;        
+        *{"${caller}::FALSE"}         = 0;
         *{"${caller}::isTrue"}        = \&CNF::_isTrue;
 
     }
@@ -543,7 +543,7 @@ sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_;
        $priority = $itm->{'^'};
        if($t&&$t=~/^[@%]/){ #Is possibly numbered list collection type, with e not instruction the name.
          doProcessCollection($self,$t,$e,$v);
-         return; 
+         return;
        }
     }
     $is_tagged = defined($t); $t = $e if not $is_tagged;

diff --git a/system/modules/Cocoon.pm b/system/modules/Cocoon.pm
new file mode 100644 (file)
index 0000000..c251104
--- /dev/null
+++ b/system/modules/Cocoon.pm
@@ -0,0 +1,178 @@
+package Cocoon;
+use strict;
+use warnings;
+use feature qw(signatures say);
+use Crypt::CBC;
+use Crypt::Blowfish;
+
+our @DIGITS = "1234567890ABCDEFGHIJKLMWENCARCHIVE" =~ m/./g;
+our $cocoon_config = $ENV{HOME}."/.config/PerlCNF/cocoon.cnf";
+our $CBC_IV = "C00000000000000F";
+
+sub new ($class, $key){
+
+    bless {
+
+        key =>$key,
+
+        cbc => Crypt::CBC->new(
+            -cipher => "Blowfish",
+            -pass =>  $key,
+            -iv => pack("H*", $CBC_IV),
+            -header => 'none',
+            -padding => 'none',
+            -nodeprecate=>1,
+            -pbkdf=>'pbkdf2'
+        )
+
+    }, $class;
+}
+
+sub encrypt ($self, $text) {
+    return unpack("H*", $self->{cbc}->encrypt($text));
+}
+sub decrypt ($self,$cipher) {
+    my $ret = $self->{cbc}->decrypt(pack("H*",$cipher));
+    $ret =~ s/\0*$//g; #Zero always padded maybe?
+    return $ret;
+}
+
+sub passCodeGenerate {
+    my $code = "";
+    sub rc {sprintf ("%s%s", $DIGITS[rand(28)], $DIGITS[rand(28)])}
+    foreach(1..8){$code .= &rc . '-'}
+    $code =~ s/(-$)//;
+    return $code;
+}
+
+sub _passCodeCheck {
+    my ($arg, $pass) = @_;
+    $arg =~ s/^-+.*pas.+=//;
+    $arg = uc $arg;
+    if($arg =~ m/(..)-(..)-(..)-(..)-(..)-(..)-(..)-(..)/g){
+        my @g = split /[.!-]?/, $arg;
+        foreach my $c(@g){
+            $pass=0; #We assume EACH next of it will fail.
+            foreach my $d(@DIGITS){
+                if($d eq $c){
+                    $pass = 1;
+                    last;
+                }
+            }
+            if(!$pass){
+                last;
+            }
+        }
+    }
+    if(!$pass){
+        print "Error: Invalid passcode format: [$arg]\n";
+        return 0;
+    }
+    return $arg;
+}
+
+sub register($self, $full_name, $alias, $pass_code, $notes, $config){
+    my $dref;
+    my $date = CNFDateTime -> now() -> toDateTimeFormat();
+    if( _passCodeCheck($pass_code) ){
+        if(!$config){
+            my $encrypted  = $self->encrypt($notes);
+            if(-f $cocoon_config){
+                $config = CNFParser ->new($cocoon_config);
+                my %dhash  = %{$config ->data()};
+                my $table  = $dhash{cocoon};
+                my $rdata  = $$table->{data};
+                my @data   = @$rdata;
+                my $idx    = _getHeaderColumnIndexes($table);
+                my ($found,$old_pass, @row)=(0);
+                foreach my $rref(@data){
+                    @row = CNFMeta::_deRefArray($rref);
+                    if(!$found && $alias eq $row[$idx->{alias}]){
+                       $old_pass = $row[$idx->{pass}];
+                       $found    = $row[$idx->{id}];
+                    }elsif($row[$idx->{pass}] eq $pass_code){
+                        warn "Error pass_code is not unique:$pass_code previously was assigned to ".
+                        $row[$idx->{alias}]."[".$row[$idx->{fname}]."]";
+                        return 0;
+                    }
+                }
+                if($found){
+                   $data[$found-1] = \[$found, $full_name, $alias, $pass_code, $date, $encrypted];
+                   say "Updating for $alias [$full_name] to: $pass_code was: $old_pass";
+                }else{
+                   $data[@data] = \[scalar(@data)+1,$full_name, $alias, $pass_code, $date, $encrypted];
+                   say "Added $alias [$full_name] to: $pass_code";
+                }
+                $$table->{data} =  \@data;
+                $self->{config} = $config;
+            }else{
+                my $cocoon_key = $self->passCodeGenerate();                
+                $config  = CNFParser   -> blank() -> parse(undef,qq(
+                    <<COCOON_KEY<$cocoon_key>>>
+                    <<cocoon<DATA>__AUTO_NUMBERED__ __HAS_HEADER__
+                    ID`FULL NAME`ALIAS`PASS_CODE _UNIQUE_`DATE _DATE_`NOTES _TEXT_~
+                    #`$full_name`$alias`$pass_code`$date`$encrypted~
+                    >>
+                ));
+                say "Created new cocoon and added $alias [$full_name] to: $pass_code";
+            }
+        }
+        $config -> writeToDataFile($cocoon_config,'cocoon');
+    }
+    return 1;
+}
+
+sub getCocoonTable($self){
+    if(not exists $self->{config}){
+        warn "Cocoon not registered yet!"
+    }else{
+       my $config = $self->{config};
+       my %dhash  = %{$config ->data()};
+       return $dhash{cocoon};
+    }
+}
+
+sub getByAliasRecord($self, $alias, $pass_code){
+    my $config;
+    if(not exists $self->{config}){
+        if( _passCodeCheck($pass_code) ){
+            if(-f $cocoon_config){
+                  $self->{config} = $config = CNFParser ->new($cocoon_config);
+            }
+        }
+    }else{
+       $config = $self->{config};
+    }
+    my %dhash  = %{$config ->data()};
+    my $table  = $dhash{cocoon};
+    my $rdata  = $$table->{data};
+    my @data   = @$rdata;
+    my $idx    = _getHeaderColumnIndexes($table);
+    foreach my $rref(@data){
+            my @row = CNFMeta::_deRefArray($rref);
+                if($alias eq $row[$idx->{alias}]){
+                   if($pass_code eq $row[$idx->{pass}]){
+                       my $encrypted = $row[$idx->{notes}];                       
+                          $row[$idx->{notes}] = $self->decrypt($encrypted);
+                       return @row;
+                   }else{
+                        warn "Error pass_code:$pass_code not is matching with alias:$alias";
+                        last
+                   }
+                }
+    }
+
+}
+
+sub _getHeaderColumnIndexes($table){
+    return {
+        id    => CNFMeta::_getColumnIndex($table,'ID'),
+        fname => CNFMeta::_getColumnIndex($table,'FULL NAME'),
+        alias => CNFMeta::_getColumnIndex($table,'ALIAS'),
+        pass  => CNFMeta::_getColumnIndex($table,'PASS_CODE'),
+        notes => CNFMeta::_getColumnIndex($table,'NOTES'),
+    }
+}
+
+
+1;
\ No newline at end of file

diff --git a/tests/testCocoonCodeGeneration.pl b/tests/testCocoonCodeGeneration.pl
new file mode 100644 (file)
index 0000000..f5c97fd
--- /dev/null
+++ b/tests/testCocoonCodeGeneration.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+use warnings; use strict;
+use lib::relative ('.','../system/modules');
+
+require TestManager;
+require CNFParser;
+require Cocoon;
+
+my $test = TestManager -> new($0);
+our $APP_PASS_KEY = "For now can be anything. Not just 123!";
+
+use Syntax::Keyword::Try; try {
+
+    ###
+    $test->case("Test Cocoon Instance creation");
+    my $coco = Cocoon->new($APP_PASS_KEY);
+    my $generate = $coco->passCodeGenerate();
+
+    $test->isDefined('$generate='.$generate, $generate);
+
+    $coco->register("Johnny Spare", "jspare" ,$generate, "Example 1 entry",undef);
+    $coco->register("Melany Stare", "mstare" ,$coco->passCodeGenerate(), "Example2",undef);
+    if(!$coco->register("Bubba Cuba", "cuba" ,$generate, "",undef)){
+        $test->passed("Passed register Bubba Cuba not possible with previous assigne pass code.");
+    }else{
+        $test->failed("Failed Bubba Cuba got register with previously registered pass_code!");
+    }
+
+    #
+    $test->nextCase();
+    #
+
+    $test->case("Test description of Notes column.");
+
+    my @row = $coco->getByAliasRecord('jspare',$generate);
+    $test->evaluate("Alias record contains 6 columns?",scalar(@row),6);
+
+    my $idx = Cocoon::_getHeaderColumnIndexes($coco->getCocoonTable());
+    $test->evaluate("Alias 'jspare' decrypted notes checks?",$row[$idx->{notes}],"Example 1 entry");
+
+
+    #
+    $test->done();
+    #
+}
+catch{
+   $test -> dumpTermination($@);
+   $test -> doneFailed();
+}