Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > Calling encrypted perl file with our require("file.pl")

Reply
Thread Tools

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

 
 
Vijoy Varghese
Guest
Posts: n/a
 
      07-09-2005
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($AXJXSXOXHXJXGXJXYXJXGXDXRXYXZXXYXZDXFXGXBVX AXQX);
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~

 
Reply With Quote
 
 
 
 
Ignoramus3635
Guest
Posts: n/a
 
      07-09-2005
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;
}

 
Reply With Quote
 
 
 
 
Mark
Guest
Posts: n/a
 
      07-10-2005
Vijoy Varghese wrote:
> 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
 
Reply With Quote
 
Vijoy Varghese
Guest
Posts: n/a
 
      07-11-2005
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~

 
Reply With Quote
 
Vijoy Varghese
Guest
Posts: n/a
 
      07-11-2005
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.

 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Can I have 2 IP addresses on our internal interface on our cisco pix firewall bgamblin@spvg.com Cisco 1 09-08-2005 08:54 PM
How do we stamp our names onto our photos? Kim Digital Photography 6 01-06-2005 06:12 AM
Extracting encrypted in a table on DB2 with Perl rparimi@gmail.com Perl Misc 2 12-10-2004 10:39 AM
How is this Perl Script encrypted? i6033162556-signup1@yahoo.com.cn Perl Misc 12 09-23-2004 01:29 PM
Where do we get our MCDST symbols to put in our outlook signature? sb20056 MCDST 1 04-09-2004 09:40 PM



Advertisments