DeXRAY.pl

#!/usr/bin/perl
#
# dexray v0.2, written by Adam Blaszczyk @ Hexacorn.com, 2012-01/09
#
# This is a simple script that attempts to decrypt Portable Executable files
# embedded in an encrypted form within other files (using encryption
# relying on a one-byte xor key).
#
# Note: it scans directories recursively
#
# It attempts to handle:
#     * Any binary file (using X-RAY scanning)
#     * Symantec Quarantine files (VBN/QBD)
#     * McAfee Quarantine files (BUP)
#
# Usage:
#      perl DeXRAY.pl <filename or directory>
#
#  History
#     2012-09-22 - added support fore new VBN files (xor A5 + F6 xx xx FF FF chunks)
#     2012-01-23 - fixed minor bug in X-RAY loop
#     2012-01-05 - first release
#

use strict;
use warnings;

$| = 1;

print STDERR "
=================================================================
 dexray v0.2, written by Adam Blaszczyk @ Hexacorn.com, 2012-01/09
=================================================================
";

    my $target = shift or die "\n\nError: Gimme a filename or dir (use '.' for a current directory)!\n";

       if (-d $target)
       {
          scan ($target);
       }
    elsif (-f $target)
       {
          processonefile ($target);
       }
    else
       {
          print "\n\nError: Don't know what to do with '$target'!\n";
       }

    exit(0);

######################
sub scan
    {
        my $subdir = shift;

        $subdir =~ s/^\.\///;

        print   STDERR "Processing  directory: '$subdir'\n";

        opendir(DIR, $subdir);
        my @sorted_subdir = sort readdir DIR;
        closedir DIR;

        foreach my $filename (@sorted_subdir)
           {
                next if $filename =~ /^\.{1,2}$/;

                my $fullpath = $subdir.'/'.$filename;

                if (-d $fullpath)
                   {
                       scan ($fullpath);
                       next;
                   }

                processonefile ($fullpath);
           }
    }

######################
sub processonefile
    {
        my $file = shift;

        print   STDERR "Processing file: '$file'!\n";

        if (! -f $file)
            {
                print STDERR " -> Can't be found! (check attributes/access rights)\n";
                return;
            }

        my $filesize = -s $file;

        if ($filesize == 0)
            {
                print STDERR " -> Skipping cuz it's empty !\n";
                return;
            }

        my $data = readfile ($file, 0, $filesize);

        my $datalen = length($data);
        if ($filesize != $datalen)
            {
                print STDERR " -> Skipping cuz something funny happened during data reading (investigate)!\n";
                return;
            }

        my $newdata = '';

        if ($file =~ /\.vbn$/i)
            {
                my $ofs = unpack ("L", $data);
                if ($ofs < ($filesize-4))
                {
                   extractdata ($file, $data, $ofs, $filesize-$ofs, 0x5A, 1);
                   extractdata ($file, $data, $ofs, $filesize-$ofs, 0xA5, 1);
                }
                else
                {
                   extractdata ($file, $data, 0x00000000,$filesize, 0x5A, 1);
                   extractdata ($file, $data, 0x00000000,$filesize, 0xA5, 1);
                }
            }

        if ($file =~ /\.qbd$/i)
            {
                extractdata ($file, $data, 0x00000000, $filesize, 0xB3, 1);
            }

        if ($file =~ /\.bup$/i)
            {
                extractdata ($file, $data, 0x00000000, $filesize, 0x6A, 1);
            }

        my $progress_delta = 100/$datalen; # $datalen is never 0
        my $progress = 0;
        my $lastprogress = 0;

#       my @dataa = split(//,$data);
        my $cnt = 0;
        print   STDERR "    Attempting x-ray scan ($datalen bytes)\n";
        print   STDERR "    (may take quite some time !!!)\n" if $datalen>2000000;
        for (my $ofs=1; $ofs<$datalen; $ofs++)
            {
               print STDERR int($progress)."%\r" if $progress != $lastprogress;

                if ( (ord(substr($data, $ofs, 1)) ^ ord(substr($data, $ofs+1, 1))) == 0x17)
                #if ( (ord($dataa[$ofs]) ^ ord($dataa[$ofs+1]) ) == 0x17)
                {
                  my $key = ord(substr($data, $ofs, 1)) ^ 0x4D;
                  next if ( ord(substr($data, $ofs+1, 1)) ^ $key ) != 0x5A;

                  my $MZPE = dexor(substr($data,$ofs,16384),$key);
                  if ($MZPE =~ /^MZ.+PE\x00\x00/s)
                     {
                        $cnt+=extractdata ($file, $data, $ofs,$filesize-$ofs, $key, 0);
                     }
                }
                $lastprogress = $progress;
                $progress+=$progress_delta;
            }

        print   STDERR " -> Nothing found via X-RAY!\n" if $cnt == 0;
        print   STDERR " -> $cnt potential file(s) found via X-RAY!\n" if $cnt > 0;
    }

sub extractdata
    {
        my $file = shift;
        my $data = shift;
        my $ofs  = shift;
        my $size = shift;
        my $key  = shift;
        my $flag = shift;

        my $newfilename = sprintf($file.'.%08d.%02X.out',$ofs,$key);

        my $newdata = dexor(substr($data,$ofs,$size),$key);
        if ($newdata =~ /^MZ.+PE\x00\x00/s)
           {
               print   STDERR " -> '$newfilename' - Possible PE\n -> ofs='$ofs' (".sprintf("%08lX",$ofs)."), key = 0x".sprintf("%02X",$key)." ($key)!\n";
               if ($file =~/\.vbn$/i && $key==0xA5)
               {
                 print   STDERR "     removing chunk dividers for newer VBN files ... \n";
                 $newdata =~ s/(.{3864})\xF6..\xFF\xFF/$1/sig;
               }
               writefile ($newfilename, $newdata);
               return 1;
           }
        elsif ($flag == 1)
           {
               print   STDERR " -> '$newfilename' - Decrypted data\n -> ofs='$ofs' (".sprintf("%08lX",$ofs)."), key = 0x".sprintf("%02X",$key)." ($key)!\n";
               writefile ($newfilename, $newdata);
               return 1;
           }

      return 0;
    }

sub writefile
    {
        my $file = shift;
        my $data = shift;

        open    (FILE, '>'.$file);
        binmode (FILE);
        print    FILE $data;
        close   (FILE);
    }

sub readfile
    {
        my $file = shift;
        my $ofs  = shift;
        my $siz  = shift;

        return  '' if !-f $file;

        open    (FILE, '<'.$file);
        binmode (FILE);
        seek    (FILE, $ofs, 0);
        read    (FILE, my $data, $siz);
        close   (FILE);

        return $data;
    }

sub dexor
    {
        my $data = shift;
        my $xorv = shift;

        my $newdata = '';

        for (my $i=0; $i<length($data); $i++)
            {
                $newdata .= chr(ord(substr($data, $i, 1)) ^ $xorv);
            }

        return $newdata;
    }