Calling encrypted perl file with our require("file.pl")

[Vijoy Varghese]

Hello Group


My manager wants me to encrypt/scramble the perl programs I created
before delivering to client. I tried to convince him that a 'legal
warning' will do the job, but he is not happy, and so is his boss.

I searched the web, and found a program called 'Perl Coder'. What it
does it, it will take the perl program as input and will create a new
perl file which looks like '@#$#@fasd$#'. All i need to do was to
change the Shebang line, and it was working fine.

But its not the end of the story, my project is lying over 48 files
called as 'require library_names.pl;'. There is only one executable
perl code 'index.pl'.
the structure is like this

.../cgi-bin/index.pl (executable)

/some/where/else/lib/library1.pl
/some/where/else/lib/library2.pl
/some/where/else/lib/one/library2_1.pl
..
..
/some/where/else/lib/five/library4_3.pl


I tried to encrypt each of the library files, and executed the
'index.pl' file, but it was not working.

Then I decided to find how 'Perl Coder' was encrypting/scrambling perl
files. It's something like, they does some kind of encryption of the
entire perl code, and store it in a variable like
$AXJXSXOXHXJXGXJXYXJXGXDXRXYXZXXYXZDXFXGXBVXAXQX, then at the end, they
use this code [which is packed()] to decrypt it.

$program = &ll0l($AXJXSXOXHXJXGXJXYXJXGXDXRXYXZXXYXZDXFXGXBVXAXQX);
sub ll0l{
my($lll)=@_;
$lll=~s,\+,,gm;
$lll=~s,\-,,g;
$lll=~s,\=,,gm;
$lll=~s,\n,,gm;
$lll=~s,Z,,gm;
$lll=~s,X,,gm;
return(pack('C*',split('l',$lll)));
}

then they call

eval ($program)

and, thats it!!!


The sad part is, i explained 'how simple its to decrypt it' to my
manager and still he want some kind of 'encryption'. So again, am
stuck!

So I created two functions, which encrypts and decrypts any file using
simple 'XOR'ing with a $key logic. Using this encryption algorithm, i
encrypted all my 48 library files. Then in my main 'index.pl' program,
i replaced all

require ("librarynames.pl");

with my custom requireNow function call

eval requireNow("encrypted_librarynames.pl");

and my requireNow function which resides in the index.pl file looks
something like this

sub requireNow{
my($file)=@_;
open(DAT,"$file");
my $prog = '';
{
my $key = 111;
local $/;
$prog = pack "c*",
map { $_ ^= $key }
unpack "c*", <DAT>;
}
return $prog;
}

Then I encrypted the index.pl file with 'Perl Coder', and everything
was looking fine.

I called index.pl in web-browser, and it was working most of the time.
But some times, i was getting errors like

Undefined subroutine &main:neOfMyFunctions called at (eval 17) line
9, <DAT> line 3.

This is how control flows in my program

program [index.pl]

#!/C:/perl/perl.exe

....

eval requireNow("encrypted_somecommonlib.pl");
eval requireNow("encrypted_anothercommonlib.pl");

.....

if($q->param("main") eq "one"){
eval requireNow("encrypted_one_lib.pl");
&oneFunction1(); # a function inside encrypted_one_lib.pl Working
fine!
...
}
elsif($q->param("main") eq "two"){
&Fun1;
}
else{
...
}
sub Fun1{
if($q->param("submain")){
eval requireNow ("encrypted_one_sub.pl");
&functionIn_one_sub(); # function inside encrypted_one_sub.pl, am
getting error here! :-(
}
else{
...
}
}

_____


So here is my question, is

eval requireNow("encrypted_one_lib.pl");

same as

require "one_lib.pl";

if not, can some one tell me how to achive the functionality of
'require' so that, i can decrypt the encrypted perl library file and
then load it to program.


thanks in advance,

Vijoy~

 

[Ignoramus3635]

I never used, but I like obfuscator.pl. It is not my script, but I am
attaching it. Try using google to find its home.

#!/usr/bin/perl
# RJ's evil obfuscator ALPHA very alpha danger keep yer pants on.
#$Id: obfuscator.pl,v 1.2 2005/03/31 12:00:16 ichudov Exp $

my ($v)='v 1.7 2000/02/22 18:53:39';
my ($debug)=0;
my ($perldocflag);
my (@perldoc);

# read the file
open FI, $ARGV[0];
while (my $x=<FI>) {
if ($x =~ /^\=head/) {
$perldocflag=1;
}

if (!$perldocflag) {
push @goop,$x;
} else {
push @perldoc,$x;
}

if ($x =~ /^\=cut/) {
$perldocflag=0;
}
}
close FI;

# pass 1 look for all vars/subs
my(%subroutines);
my(%variables);

# A short list of the most popular special variables and one
# I needed (%FORM) exported for a cgi implementation.
my(@evilvars)=("ISA","ARGV","_","0","1","2","3","4","5","6","7","8","9","INC","ENV","F","SIG","FORM");

my ($out,$line,$unquoted);

foreach my $line (@goop) {
my(@hits)= ($line =~ /[\$\@\%]\#*\{*([\w:]+)/g);
foreach (@hits) {
$variables{$_}=$_;
}
my(@hits)= $line =~ /\s*sub\s+(\w+)\s*/g;
foreach (@hits) {
$subroutines{$_}=$_;
}
}


# Obfuscate variables with simple substitution via a hash
# Variables get base 26'ed starting high enough to have a letter a-k
# I'm still toying with this part. Seems to work, though.
srand;
foreach (keys(%variables)) {
alreadyhavethat:
$code=lc(BaseConvert(int(rand(182780)+1)+182790,10,26));
if (in($code,values(%variables))) {
goto alreadyhavethat;
}
# local namespace, only. BTW, not intended for packages yet
if (!(/::/)) {
$variables{$_}=$code;
}
}

# Subroutines are simply lettered in sequence, sorry.
my($i);
foreach (keys(%subroutines)) {
$i++;
$subroutines{$_}=lc(BaseConvert($i+7030,10,26));
}

# Fix the variables we didn't really want to rename
my($i);
foreach $i(@evilvars) {
$variables{$i}=$i;
}


# Toss it over to a scalar, killing comments
# Note the caveat... print " I like #5 "; will get killed here...
foreach $line(@goop) {
# Kill comments
$line=~s/(^|[^\$\\\S])\#.*$/$1/;
$out .= $line;
}

@goop = ();

# Yes, flagrant assumption you like 'NIX.
# Your line was killed by the comment eater just above here.
print "\#!/usr/bin/perl\n";
print "\# THIS FILE has passed through RJ's Perl Obfuscator $v\n\n";
if ($#perldoc>-1) {
print @perldoc;
}
print stringparse($out);
exit;

#########################################################

sub stringparse {
my($a)=@_;
my($out,$work);
my($l) = length($a);
# The quote characters in all their glory
my(@qc)= ("\"","'","`");
my(@l5,$c,$i);
my($quoteflag);
for ($i=0; $i<$l; $i++) {
$c=substr($a,$i,1);

# Keep a running 5 last original letters...
push @l5,$c;
if (length(@l5>5)) {
shift @l5;
}

if (!$quoteflag) {

# An actual quote-type character
$last5=join(undef,@l5);
# Do we have a quote character?
if (in($c,@qc) and !$quoteflag) {
# Should we interpret it as a quote character?
if (($last5 !~/\\$c$/)) {
$quotechar=endquotechar($c);
unless ($c eq "\'") {
$out.=chopnonquote($work,$quoteflag);
$quoteflag=1;
$work=undef;
} else {
$out.=chopnonquote($work,$quoteflag);
$quoteflag=2;
$work=undef;
}
}
@l5=();
}

$last5=join(undef,@l5);
# Cheat and use the qX hack
if ($last5 =~ m/[\b\s=(,.]q([^\s\w]{1})/) {
$quotechar=endquotechar($1);
$out.=chopnonquote($work,$quoteflag);
$quoteflag=2;
$work=undef;
@l5=();
}

$last5=join(undef,@l5);
# Cheat and use the qqX hack
if ($last5 =~ m/[\b\s=(,.]qq([^\s\w]{1})/) {
$quotechar=endquotechar($1);
$out.=chopnonquote($work,$quoteflag);
$quoteflag=1;
$work=undef;
@l5=();
}

$last5=join(undef,@l5);
if ($last5 =~ m/[\b\s=(,.]qx([^\s\w]{1})/) {
$quotechar=endquotechar($1);
$out.=chopnonquote($work,$quoteflag);
$quoteflag=1;
$work=undef;
@l5=();
}
# If we are still not in quotes...
if ($quoteflag<1) {
# Kill pretty formatting
# This should really move to chopnonquote...
if ($c=~/[\s\n\t]/) {
if (substr($work, length($work)-1,1) eq " ") {
$c=undef;
} else {
$c=" ";
}
}
}
} else {
# We are in quotes... can we get out?
if ($c eq $quotechar) {
# is it escaped?
if (!(($l5[($#l5)-1] eq "\\") and ($l5[($#l5)-2] ne "\\"))) {
$quotechar=undef;
@l5=();
$out.=chopnonquote($work,$quoteflag);
$work=undef;
$quoteflag=0;
}
}
if ($quoteflag==1) {
if ($c eq "\n") {
$c = '\n';
}
if ($c eq "\t") {
$c = '\t';
}
}
}

$work .= $c;
}
$out =~ s/^\s//;
return $out.chopnonquote($work,$quoteflag);
}

sub chopnonquote
{
my($work, $mode)=@_;


# Replace variables
if ($mode<2) { # was ([\w:]+)
$work =~ s/([\$\@\%]\#*\{*)([\w]+)/$1$variables{$2}/g;
}

# Replace subroutines
if ($mode==0 and (lc($ARGV[1]) ne 'p')) {
foreach (keys(%subroutines)) {
unless ($work =~ /\:$_/) {
$work =~ s/\b($_)\b/$subroutines{$1}/g;
}
}
}

if (!$debug) {
return $work;
} else {
return "\n"x($mode==0).$work."\n"x($mode==0);
#print "[".$work."]<".$mode.">\n";
return undef;
}
}


sub endquotechar
{
my ($qc)=@_;
if ($qc eq "{") {
$qc="}";
}
if ($qc eq "[") {
$qc="]";
}
if ($qc eq "\(") {
$qc="\)";
}
if ($qc eq "<") {
$qc=">";
}
return $qc;
}

############### NMX.pm ROUTINES swiped to make it portable ################
############### WRITTEN BY Nathan Morse ###################################
############### Thanks, man! ;^>

# BaseConvert($number,$FromBase,$ToBase)
# converts a "number" from one base to another
# doesn't deal with "decimal" values yet
sub BaseConvert
{
my(%digit);
my($i,$letter,$from,$to,$n);

$letter="A";
for $i(0..35) {
if ($i<10) {
$digit{$i}="$i";
} else {
$digit{$i}=$letter++;
}
}

($n,$from,$to)=@_;
$n=uc$n;
$n=to10($n,$from,reverse%digit)if($from!=10);
$n=from10($n,$to,%digit)if($to!=10);
$n=~s/^0*//;
if ($n) {
return$n;
} else {
return"0";
}

sub from10
{
my($n,$to,$nout,%digit);
$nout="";
($n,$to,%digit)=@_;
while ($n>0) {
$nout=$digit{$n%$to}.$nout;
$n=int($n/$to);
}
$nout=$n%$to.$nout;
$n=$n/$to;
return$nout;
}

sub to10
{
my($n,$from,$nout,$p,%digit);
($n,$from,%digit)=@_;
for $p(0..(length$n)-1) {
$nout+=$digit{substr($n,(length$n)-$p-1,1)}*$from**$p;
}
return$nout;
}
}

# in($SearchString,$StartPosition,@ArrayToSearch) searches an array for a value
# returns true if found, or false if not
sub in
{
my($string,@array)=@_;
my($found)=-1;
my($element);
foreach $element(@array) {
return 1 if($element eq $string);
}
return 0;
}

 

[Mark]

Hello Group


My manager wants me to encrypt/scramble the perl programs I created
before delivering to client. I tried to convince him that a 'legal
warning' will do the job, but he is not happy, and so is his boss.

Acme::Bleach?

warning: make sure you have copies of your script available before using
this, otherwise you will lose access to the source. Of course, you
should have all your code in source control, anyway.

Mark

 

[Vijoy Varghese]

thanks for the code Ignoramus3635,

But, what I am looking for is not 'how to encrypt' a perl program. But
its ....

How to 'require' a encrypted perl library(a collection of subroutines)
in a perl program.

Vijoy~

 

[Vijoy Varghese]

Acme::Bleach, cool concept!

But my
eval reqiureNow( "encrypted_library.pl"); logic is still not working...

I want to load my encrypted library files into main program. Before
encryption, it was loaded using the require "library.pl". Now, I need a
custom 'require' function, because I need to decrypt the libraries
before loading.

I created a require function like this
sub requireNow{
encrypted code = read encrypted library
decrypt code
return decrypted code;
}

eval requireNow("encrypted_library.pl");

and its not 100% working, When i use my 'eval requireNow' function
inside other functions, in some functions it works, but in some others,
am getting errors of this form...

Undefined subroutine &main:neOfMyFunctions called at (eval 17) line
9, <DAT> line 3.