Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

How to call Assembly language routines from Perl

by bitshiftleft (Sexton)
on Nov 26, 2008 at 00:17 UTC ( #725978=sourcecode: print w/replies, xml ) Need Help??
Category: Fun Stuff
Author/Contact Info I will browse this occasionally to reply to questions.
Description: This article shows how to write and call assembly language routines from Perl. I am using ActiveStates version of Perl on Win32. I used Win32::API, but other External Call modules can be used. Unlike the VB trick of using a callback from an API call to execute asm code, the method here is more direct. If you want to explore Win32 memory with Perl here is one way to do it. Also it is another way to learn assembly langauge. This code could be made more robust with Windows memory access API: VirtualQuery(), VirtualProtect(),IsBadReadPtr(), rtlMoveMemory(), ... and so forth. Look after __END__ in code below to see my output of the program
# callasm.pl
# Written by bitshiftleft
# Perl & Assembly Language interface demo .
# set AeDebug in Registry to ntsd.exe or your favorite debugger for un
+handled 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 debugge
+r 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 debug
+ger here
          "\x64\xa1\x18\x00\x00\x00" . # MOV EAX, dword ptr fs:[000000
+18] get Thread Environment Block
          "\xc3";                      # RET

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

$getCPU   = "\x90"     .             #  debug break(0xcc)(checks if th
+is 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 avai
+lable cpuid calls
            "\x8B\x45\x08"         . #  mov eax,[ebp+0x08]   ; EPB+8  
+contains address of $ebx perl string 
            "\x89\x18"             . #  mov [eax],ebx        ; overwri
+te "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        ; overwri
+te "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        ; overwri
+te "CHIP" in the  perl string $ecx with the ecx register
            "\x58"         .         #  pop eax - restore number of cp
+uid calls to be returned to caller            
            "\x59"     .             #  pop ecx - restore registers us
+ed
            "\x5A"     .             #  pop edx
            "\x5B"     .             #  pop ebx
            "\x89\xec" .             #  mov esp,ebp
            "\x5d"     .             #  pop ebp
            "\xc2\x0c\x00"           #  ret 12  "__stdcall", back to P
+erl 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 f
+or 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 struc
+t TEB
$SEH1 = unpack( "L!",$teb1);  
$PEB = unpack("L!",unpack("P4",pack("L",$TEB1+$TEBstruct{'PEB'})));
$stackbase = unpack("L!",unpack("P4",pack("L",$TEB1+$TEBstruct{'StackB
+ase'})));     
$stacklimt = unpack("L!",unpack("P4",pack("L",$TEB1+$TEBstruct{'StackL
+imit'})));
our $imagebase =  unpack("L!",unpack("P4",pack("L",$PEB+$PEBstruct{'PE
+B_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_REGISTRATIO
+N.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",$initord
+er+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+0x
+18))));
 $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", "GetCurrentProcessI
+d", "", "N");
 $hackedObject->{proc} = $PROCPTR;  # Substitute our assembly language
+ routine
 @{$hackedObject->{in}} = @args if scalar(@args); # Substitute our par
+ameters
   $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 capabili
+ty 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
Replies are listed 'Best First'.
Re: How to call Assembly language routines from Perl
by Anonymous Monk on May 20, 2011 at 01:26 UTC
    This is great. but can you provide the same idea on linux :)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://725978]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (2)
As of 2020-09-27 10:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (142 votes). Check out past polls.

    Notices?