Espiar las comunicaciones de otros procesos

Enviado por admin el Dom, 10/26/2008 - 21:16

Seguro que alguna vez has tenido curiosidad por saber como funciona otro proceso, que envía y que recibe a través de internet, para esta tarea ya existen programas muy buenos, por ejemplo wireshark, pero lo que aquí propongo es hacerlo nosotros mismos desde un programa en delphi. Puede que el resultado no sea muy profesional, pero sirve perfectamente como ejemplo de como inyectar código en otro proceso e interceptar las llamadas que hace este a funciones de la API de windows. Solo es una "prueba de concepto", un pequeño juguete, para usarlo de una forma un poco más seria habría que limar un poco el código, pero ese no es ahora mismo mi objetivo.

El proyecto se divide en dos partes, una dll que se va a cargar en el proceso a espiar y un ejecutable que se va a encargar de inyectar a la dll dentro del otro proceso. Una vez inyectada la dll en el proceso que queremos espiar, busca la zona de memoria donde se guardan las direcciones de las funciones a interceptar, guarda ese valor, y lo reemplaza con la dirección de sus propias funciones. De esta manera cuando el programa intente ejecutar la función, lo que hará realmente es ejecutar la nueva función.

El código del programa y la dll (sockspy.zip):

El código de la dll:

library Hook;
 
uses
  Windows,
  Sysutils,
  Messages,
  Psapi,
  ImageHlp,
  Winsock;
 
type
  IMAGE_IMPORT_DESCRIPTOR = record
    Characteristics: DWORD;
    TimeDateStamp: DWORD;
    ForwarderChain: DWORD;
    Name: DWORD;
    FirstThunk: DWORD;
  end;
  PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR;
 
  TWSABUF = record
    len: u_long;
    buf: PChar;
  end;
  PWSABUF = ^TWSABUF;
 
  TSendFunc = function (s: TSocket; Buf: Pchar; len, flags: Integer): Integer; stdcall;
  TRecvFunc = function (s: TSocket; Buf: Pchar; len, flags: Integer): Integer; stdcall;
  TWSASendFunc = function(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
    lpCompletionRoutine: Pointer): Integer; stdcall;
  TWSARecvFunc = function(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
    lpCompletionRoutine: Pointer): Integer; stdcall;
 
  TBufType = (btSend, btRecv);
 
var
  OldSend: TSendFunc;
  OldRecv: TRecvFunc;
  OldWSASend: TWSASendFunc;
  OldWSARecv: TWSARecvFunc;
 
// Esta funcion convierte los datos a texto, convirtiendo los caracteres no imprimibles
// a su representacion hexadecimal
function BufToString(Buf: PChar; Len: Integer): String;
var
  i: Integer;
begin
  Result:= EmptyStr;
  for i:= 1 to Len do
  begin
    if (Buf^ in [#32..#126]) then
      Result:= Result + Buf^
    else
      Result:= Result + '[' + IntToHex(Byte(Buf^),2) + ']';
    inc(Buf);
  end;
end;
 
// Todos los hooks apuntan hacia aqui
procedure SaveBuf(S: TSocket; Buf: PChar; Len: Integer; Tipo: TBufType);
var
  Str: String;
begin 
  Str:= BufToString(Buf,len);
  if Tipo = btSend then
    Str:= Format('Send(%d): %s',[S,Str])
  else if Tipo = btRecv then
    Str:= Format('Recv(%d): %s',[S,Str]);
  OutputDebugString(PChar(Str));
end;
 
function NewSend(s: TSocket; Buf: PChar; len, flags: Integer): Integer; stdcall;
begin
  SaveBuf(s,Buf,len,btSend);
  if @OldSend <> nil then
    Result:= OldSend(s,Buf,len,flags)
  else
    Result:= SOCKET_ERROR;
end;
 
function NewRecv(s: TSocket; Buf: PChar; len, flags: Integer): Integer; stdcall;
begin
  if @OldRecv <> nil then
    Result:= OldRecv(s,Buf,len,flags)
  else
    Result:= SOCKET_ERROR;
  if Result > 0 then
    SaveBuf(s,Buf,Result,btRecv);
end;
 
function NewWSASend(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
  lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
  lpCompletionRoutine: Pointer): Integer; stdcall;
var
  i: DWORD;
  P: PWSABUF;
begin
  i:= dwBufferCount;
  P:= lpBuffers;
  while i > 0 do
  begin
    SaveBuf(s,P.Buf,P.len,btSend);
    dec(i);
    inc(P);
  end;
  if @OldWSASend <> nil then
    Result:= OldWSASend(s,lpBuffers,dwBufferCount,lpNumberOfBytesSent,dwFlags,
      lpOverlapped,lpCompletionRoutine)
  else
    Result:= SOCKET_ERROR;
end;
 
function newWSARecv(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
  lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
  lpCompletionRoutine: Pointer): Integer; stdcall;
var
  i: DWORD;
  P: PWSABUF;
begin
  if @OldWSARecv <> nil then
    Result:= OldWSARecv(s,lpBuffers,dwBufferCount,lpNumberOfBytesSent,dwFlags,
      lpOverlapped,lpCompletionRoutine)
  else
    Result:= SOCKET_ERROR;
  if Result <> SOCKET_ERROR then
  begin
    i:= dwBufferCount;
    P:= lpBuffers;
    while i > 0 do
    begin
      SaveBuf(s,P.Buf,P.len,btRecv);
      dec(i);
      inc(P);
    end;
  end;
end;
 
function HookFunction(ModName, ProcName: PChar; Nuevo: Pointer): Pointer;
var
  i: Integer;
  hProcess: THandle;
  hModules: array[0..1024] of HMODULE;
  cbNeeded: DWORD;
  hMod: HMODULE;
  ImportDesc: PIMAGE_IMPORT_DESCRIPTOR;
  Size: Cardinal;
  szModName: PChar;
  Thunk: PPointer;
  MBI: MEMORY_BASIC_INFORMATION;
begin
  Result:= nil;
  hMod:= GetModuleHandle(ModName);
  if hMod <> 0 then
  begin
    Result:= GetProcAddress(hMod, ProcName);
    if Result <> nil then
    begin
      hProcess:= OpenProcess(PROCESS_QUERY_INFORMATION  or PROCESS_VM_READ,
        FALSE, GetCurrentProcessId);
      if hProcess <> 0 then
      begin
        if EnumProcessModules(hProcess, @hModules, Sizeof(hModules), cbNeeded) then
          for i:= 0 to (cbNeeded div Sizeof(HMODULE)) - 1 do
          begin
            ImportDesc:= ImageDirectoryEntryToData(Pointer(hModules[i]),
              TRUE, IMAGE_DIRECTORY_ENTRY_IMPORT, Size);
            if ImportDesc <> nil then
            begin
              while ImportDesc.Name > 0 do
              begin
                szModName:= PChar(hModules[i] + ImportDesc.Name);
                if StrIComp(szModName,ModName) = 0  then
                begin
                  Thunk:= Pointer(hModules[i] + ImportDesc.FirstThunk);
                  while Thunk^ <> nil do
                  begin
                    if Thunk^ = Result then
                    begin
                      OutputDebugString(PChar(String(ProcName) + ': ' + 'Hookeado'));
                      VirtualQuery(Thunk,MBI,Sizeof(MEMORY_BASIC_INFORMATION));
                      VirtualProtect(MBI.BaseAddress,MBI.RegionSize,PAGE_READWRITE,
                        MBI.Protect);
                      Thunk^:=  Nuevo;
                      VirtualProtect(mbi.BaseAddress,mbi.RegionSize,mbi.Protect,
                        MBI.Protect);
                    end;
                    inc(Thunk);
                  end;
                end;
                inc(ImportDesc);
              end;
            end;
          end;
      end;
    end;
  end;
end;
 
procedure ProcessAttach; stdcall;
begin
  OldSend:= HookFunction('wsock32.dll','send',@NewSend);
  OldRecv:= HookFunction('wsock32.dll','recv',@newRecv);
  OldWSASend:= HookFunction('Ws2_32.dll','WSASend',@NewWSASend);
  OldWSARecv:= HookFunction('Ws2_32.dll','WSARecv',@NewWSARecv);
end;
 
procedure ProcessDetach; stdcall;
begin
//
end;
 
procedure DLLEntryPoint(Reason: integer);
begin
  case Reason of
    Dll_Process_Detach: ProcessDetach;
    Dll_Process_Attach: ProcessAttach;
  end;
end;
 
begin
  ProcessAttach;
  DLLProc:= @DLLEntryPoint;
end.

Por otro lado el programa es muy sencillo, solamente lista los procesos y permite cargar la dll anterior en cualquiera de ellos.

Las dos funciones principales son las siguientes:

procedure TfrmMain.btnInyectarClick(Sender: TObject);
var
  Procesos: array[1..1024] of DWORD;
  Needed, i: DWORD;
  Process, Thread: THandle;
  ModName: array[0..MAX_PATH] of Char;
  RemLibPath: PChar;
  ExitCode: Cardinal;
  LibPath, Target: String;
begin
  if lsbMain.ItemIndex >= 0 then
  begin
    Target:= lsbMain.Items[lsbMain.ItemIndex];
    LibPath:= IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) +
      'Hook.dll';
    if EnumProcesses(@Procesos, SizeOf(Procesos), Needed ) then
    begin
      for i:= 1 to (Needed div Sizeof(DWORD)) do
      begin
        Process := OpenProcess(PROCESS_ALL_ACCESS, FALSE,Procesos[i]);
        if Process <> 0 then
        begin
          if GetModuleFileNameEx(Process,0,ModName,SizeOf(ModName)-1) > 0  then
          begin
            if AnsiStrPos(ModName,PChar(Target)) <> nil then
            begin
              RemLibPath:= VirtualAllocEx(Process, nil,Length(LibPath)+1,
                MEM_COMMIT, PAGE_READWRITE);
              if RemLibPath <> nil then
              begin
                if WriteProcessMemory(Process, RemLibPath, PChar(LibPath),
                  Length(LibPath),PDWORD(nil)^) then
                begin
                  Thread:= CreateRemoteThread(Process, nil, 0,
                    GetProcAddress(GetModuleHandle('Kernel32'),'LoadLibraryA'),
                    RemLibPath, 0, PDWORD(nil)^);
                  if Thread <> 0 then
                  begin
                    WaitForSingleObject(Thread,INFINITE );
                    GetExitCodeThread(Thread,ExitCode);
                    CloseHandle(Thread);
                  end;
                end;
                VirtualFreeEx(Process,RemLibPath,Length(LibPath)+1,MEM_RELEASE);
              end;
            end;
          end;
          CloseHandle(Process);
        end;
      end;
    end;
  end;
end;
 
procedure TfrmMain.btnRefrescarClick(Sender: TObject);
var
  Procesos: array[1..1024] of DWORD;
  Needed, i: DWORD;
  Process: THandle;
  ModName: array[0..MAX_PATH] of Char;
begin
  lsbMain.Clear;
  if EnumProcesses(@Procesos,SizeOf(Procesos),Needed) then
  begin
    for i:= 1 to (Needed div Sizeof(DWORD)) do
    begin
      Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
        FALSE,Procesos[i]);
      if Process <> 0 then
      begin
        if GetModuleFileNameEx(Process,0,ModName,SizeOf(ModName)-1)>0  then
        begin
          lsbMain.Items.Add(ModName);
        end;
        CloseHandle(Process);
      end;
    end;
  end;
end;

Para usar el programa solo hay que ejecutar el programa, buscar el proceso que queremos espiar y pulsar el botón inyectar. A partir de ese momento cuando el programa llame a las APIS send, recv, WSASend, WSARecv el contenido sera volcado a la "salida de debug". Para poder verlo necesitaremos de un programa como DebugView de Sysinternals.

Un ejemplo de la información que puedes obtener usando este programa:

Servidor ftp normal

Recv(472): 220---------- Welcome to Pure-FTPd [TLS] ----------	
Send(472): USER usuario..	
Recv(472): 331 User usuario OK. Password required..	
Send(472): PASS password..	
Recv(472): 230-User usuario has group access to:  usuario   ..230 OK. Current restricted directory is /..	
Send(472): SYST..	
Recv(472): 215 UNIX Type: L8..	
 Send(472): FEAT..	
Recv(472): 211-Extensions supported:.. EPRT.. IDLE.. MDTM.. SIZE.. REST STREAM.. MLST type*;size*;sizd*;modify*;UNIX.mode*;UNIX.uid*;UNIX.gid*;unique*;.. MLSD.. ESTP.. PASV.. EPSV.. SPSV.. ESTA.. AUTH TLS.. PBSZ.. PROT..211 End...	
Send(472): PWD..	
Recv(472): 257 "/" is your current location..	
Send(472): TYPE A..	
Recv(472): 200 TYPE is now ASCII..	
Send(472): PASV..	
Recv(472): 227 Entering Passive Mode (86,109,99,252,148,1)..	
Send(472): LIST..

Servidor ftps (SSL Explicit)

Recv(472): 220 Indy FTP Server ready...	
Send(472): AUTH SSL..	
Recv(472): 234 AUTH Command OK. Initializing SSL..	
Send(472): .j....Q......9..8..5..............3..2../.............................@.....................>^...z....T..).Q	
Recv(472): ._....../....0..+0...............j...0...*.H........0E1.0...U....AU1.0...U... (Continua)
Send(472): .R.......@...<.#$./d.!..Ji....C......+{}$....`..~.M.....\(.."...u%J..L...(Continua)
Recv(472): .(..R.....B..h+.Cx..(..../....S..V..z#......(.t....l.,....)P.....c.Ky$K.....5.Z.T..K8.

Comentarios

Enviado por Anonimo (no verificado) el Vie, 10/31/2008 - 19:21

Fenomenal código. Muchas gracias

Enviado por Guidus (no verificado) el Mar, 11/10/2009 - 23:00

Excelente, bastante entendible para nosotros los que empezamos aprendiendo.

Gracias Domingo.