# callasm.pl
# Written by bitshiftleft
# Perl & Assembly Language interface demo .
# set AeDebug in Registry to ntsd.exe or your favorite debugger for unhandled exceptions
# If you are not getting memory access violations as you explore, you are not having fun [:-) 
use Win32::API;
$getSP    = "\x90" .                #  nop(90) or int3(cc) for debugger unhandled exceptions here
            "\x8b\xc4" .            #  mov eax,esp - get stack pointer - for checking proper stack maintenance 
            "\xc3";                 #  return - back to perl

$getTEB = "\x90" .                     # nop(90) or int3(cc) for debugger here
          "\x64\xa1\x18\x00\x00\x00" . # MOV EAX, dword ptr fs:[00000018] get Thread Environment Block
          "\xc3";                      # RET

$getPEB = "\x90" .                     # nop(90) or int3(cc) for debugger here
          "\x64\xa1\x30\x00\x00\x00" . # MOV EAX, dword ptr fs:[00000030] get Process Environment Block
          "\xc3";                      # RET

$getCPU   = "\x90"     .             #  debug break(0xcc)(checks if this assembles right) or nop(0x90) 
            "\x55"     .             #  push ebp
            "\x89\xe5" .             #  mov ebp,esp
            "\x90"     .             #  nop
            "\x53"     .             #  push ebx  save registers to be used
            "\x52"     .             #  push edx
            "\x51"     .             #  push ecx
            "\xB8\x00\x00\x00\x00" . #  mov eax,0x0  => eax=0 gets cpu vendor for the call
            "\x0F\xA2"     .         #  cpuid
            "\x50"         .         #  push eax - save number of available cpuid calls
            "\x8B\x45\x08"         . #  mov eax,[ebp+0x08]   ; EPB+8  contains address of $ebx perl string 
            "\x89\x18"             . #  mov [eax],ebx        ; overwrite "NO  " in the  perl string $ebx with the ebx register
            "\x8b\x45\x0C"         . #  mov eax,[ebp+0x0c]   ; EPB+12  contains address of $ebx perl string
            "\x89\x10"             . #  mov [eax],edx        ; overwrite "SUCH" in the  perl string $edx with the edx register
            "\x8b\x45\x10"         . #  mov eax,[ebp+0x10]   ; EPB+16  contains address of $ecx perl string
            "\x89\x08"            .  #  mov [eax],ecx        ; overwrite "CHIP" in the  perl string $ecx with the ecx register
            "\x58"         .         #  pop eax - restore number of cpuid calls to be returned to caller            
            "\x59"     .             #  pop ecx - restore registers used
            "\x5A"     .             #  pop edx
            "\x5B"     .             #  pop ebx
            "\x89\xec" .             #  mov esp,ebp
            "\x5d"     .             #  pop ebp
            "\xc2\x0c\x00"           #  ret 12  "__stdcall", back to Perl removing 3 arguments(longs) from the stack

;
our %TEBstruct =(   # abbreviated Thread Environment Block
 'SEHcurrent' => 0x00,
 'StackBase' => 0x04, 
 'StackLimit' => 0x08,
 'TIBself' => 0x18,
 'PID' => 0x20,
 'TID' => 0x24,
 'TLS' => 0x2C,
 'PEB' => 0x30,
);

our %PEBstruct =( # abbreviated Process Environment Block
 'PEB_IMG_BASE' => 0x08,
 'PEB_LDR_DATA' => 0x0C,
 'HEAP' => 0x18,
);
our $TEB1 ;
our $PEB ;
our $TLS  ;     
our $stackbase  ;     
our $stacklimt  ;    
our $SEH1;
our $teb1;
our $ldr_data;
our $address;

$ebx = "NO  ";
$edx = "SUCH";
$ecx = "CHIP";

printf "\$getCPU Assembly address %08X\n",unpack("I",pack("P",$getCPU));
print "CPU vendor: ",$ebx,$edx,$ecx,", Before the Call\n";
$PtrToFunc = DeclareFarProc($getCPU,"III","I");
my $highnum = $PtrToFunc->Call(Ptr($ebx),Ptr($edx),Ptr($ecx));
print "CPU vendor: ",$ebx,$edx,$ecx,", With $highnum available calls for more CPU capability info\n";
$PtrToFunc->DESTROY;
$PtrToFunc = DeclareFarProc($getTEB,"","I");  # get Thread Environment Block
$TEB1 = $PtrToFunc->Call();
$PtrToFunc->DESTROY;
print "\n------- Some Memory Information ------ \n";
printf "TEB        : %08X\n",$TEB1;
$teb1 = unpack ("P4",pack("L","$TEB1")); # a partial fill of the struct TEB
$SEH1 = unpack( "L!",$teb1);  
$PEB = unpack("L!",unpack("P4",pack("L",$TEB1+$TEBstruct{'PEB'})));
$stackbase = unpack("L!",unpack("P4",pack("L",$TEB1+$TEBstruct{'StackBase'})));     
$stacklimt = unpack("L!",unpack("P4",pack("L",$TEB1+$TEBstruct{'StackLimit'})));
our $imagebase =  unpack("L!",unpack("P4",pack("L",$PEB+$PEBstruct{'PEB_IMG_BASE'})));
$ldr_data = unpack("L!",unpack("P4",pack("L",$PEB+$PEBstruct{'PEB_LDR_DATA'})));


print "PEB        : ",sprintf("%08X",$PEB),"\n";
print "Image base : ",sprintf("%08X",$imagebase),"\n";
print "StackBase  : ",sprintf("%08X",$stackbase),"\n";
print "StackLimit : ",sprintf("%08X",$stacklimt),"\n";
print "Dll List   : ",sprintf("%08X",$ldr_data),"\n";
print "SEH1       : ",sprintf("%08X",$SEH1),"\n\n";


our $a = $SEH1;
my $iteration = 0;
my $looplimit = 6;

print 'Walking SEH Linked List ....',"\n";
while($a != -1){
 my $b = pack("L!",$a+4);
 printf "EXCEPTION_REGISTRATION.prev    :  %08X\nEXCEPTION_REGISTRATION.handler :  %08X\n\n",$a,unpack("L!",unpack("P4","$b"));
 my $c = pack("i",$a+0);
 $a = unpack("l",unpack("P4","$c"));
 ++$iteration;
 last if $a == -1;
 last if $iteration > $looplimit;
}
our $initorder = unpack("L!",unpack("P4",pack("L",$ldr_data+0x1c)));
printf "dll initorder = %08x\n",$initorder;
our $nextdll = $initorder;
$address = unpack("L!",unpack("P4",pack("L",$initorder+0x08)));
our $size = unpack("L!",unpack("P4",pack("L",$initorder+0x10)));
our $dllname = unpack("A*",unpack("P128",unpack("P4",pack("L",$initorder+0x18))));
$dllname =~ s/\x00\x00(.)+//gis;
$dllname =~ s/(.)\x00/$1/gis;
print "---- Dll list ----\n";
our $ki = 1;
print "Base      End      Name\n";   
while($address > 0){
 printf "%08x  %08x %s\n",$address,$address+$size,$dllname;
 $nextdll = unpack("L!",unpack("P4",pack("L",$nextdll)));
 $address = unpack("L!",unpack("P4",pack("L",$nextdll+0x08)));
 $size = unpack("L!",unpack("P4",pack("L",$nextdll+0x10)));
 $dllname = unpack("A*",unpack("P128",unpack("P4",pack("L",$nextdll+0x18))));
 $dllname =~ s/\x00\x00(.)+//gis;  # unicode to ascii
 $dllname =~ s/(.)\x00/$1/gis;
 ++$ki; 
}
exit;

######################### Subs #######################
######## sub  DeclareFarProc -  sets up the Call #####
sub  DeclareFarProc{
 my $PROCPTR = Ptr($_[0]);
 my @args;
 my $rtn;
 my $argstr = $_[1];
 if(defined($argstr)){foreach my $arg (split(//,$argstr)) { push(@args, Win32::API::type_to_num($arg));}} ;
 $rtn = Win32::API::type_to_num($_[2]) if defined $_[2];
 my $hackedObject = new Win32::API("kernel32.dll", "GetCurrentProcessId", "", "N");
 $hackedObject->{proc} = $PROCPTR;  # Substitute our assembly language routine
 @{$hackedObject->{in}} = @args if scalar(@args); # Substitute our parameters
   $hackedObject->{out} = $rtn if  defined($rtn);
   return $hackedObject;
}

##### Sub Ptr() - just like VarPtr() for you VB programmers ####
sub  Ptr{unpack("I",pack("P",$_[0]));} 

__END__

------ MY PROGRAM OUTPUT -----
C:\Documents and Settings\bitshiftleft\Desktop>callasm.PL
$getCPU Assembly address 018201F0
CPU vendor: NO  SUCHCHIP, Before the Call
CPU vendor: GenuineIntel, With 3 available calls for more CPU capability info

------- Some Memory Information ------
TEB        : 7FFFE000
PEB        : 7FFFF000
Image base : 00400000
StackBase  : 01410000
StackLimit : 01409000
Dll List   : 00151E90
SEH1       : 0140FFB0

Walking SEH Linked List ....
EXCEPTION_REGISTRATION.prev    :  0140FFB0
EXCEPTION_REGISTRATION.handler :  00401150

EXCEPTION_REGISTRATION.prev    :  0140FFE0
EXCEPTION_REGISTRATION.handler :  7C839AA8

dll initorder = 00151f28
---- Dll list ----
Base      End      Name
7c900000  7c9b0000 C:\WINDOWS\system32\ntdll.dll
7c800000  7c8f5000 C:\WINDOWS\system32\kernel32.dll
77c10000  77c68000 C:\WINDOWS\system32\MSVCRT.dll
77f10000  77f57000 C:\WINDOWS\system32\GDI32.dll
7e410000  7e4a0000 C:\WINDOWS\system32\USER32.dll
77e70000  77f01000 C:\WINDOWS\system32\RPCRT4.dll
77dd0000  77e6b000 C:\WINDOWS\system32\ADVAPI32.dll
28000000  280a3000 C:\Perl\bin\Perl56.dll
10000000  10008000 C:\Perl\site\lib\auto\Win32\API.dll