lazarus/components/fpdebug/fpimgreaderwinpe.pas
2025-03-02 11:23:28 +01:00

555 lines
18 KiB
ObjectPascal

{
This unit contains the types needed for reading PE images.
This file was ported from DUBY. See svn log for details
---------------------------------------------------------------------------
@created(Thu May 4th WET 2006)
@lastmod($Date: 2009-01-16 03:26:10 +0300 (Пт, 16 янв 2009) $)
@author(Marc Weustink <marc@@dommelstein.nl>)
@modified by dmitry boyarintsev (july 2009:
+ removed Windows unit dependancy. added SectionCount and
+ added Sections access by Index
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
unit FpImgReaderWinPE;
{$mode objfpc}{$H+}
{$IFDEF INLINE_OFF}{$INLINE OFF}{$ENDIF}
interface
uses
Classes, {$ifdef windows}windows,{$endif} SysUtils, math,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, LazUTF8,
DbgIntfBaseTypes, LazFileUtils,
FpImgReaderBase, FpImgReaderWinPETypes, fpDbgSymTable;
type
{ TPEFileSource }
TPEFileSource = class(TDbgImageReader)
private
FSections: TStringListUTF8Fast;
FFileLoader : TDbgFileLoader;
FOwnLoader : Boolean;
FCodeBase : DWord;
protected
function GetSection(const AName: String): PDbgImageSection; override;
function GetSection(const ID: integer): PDbgImageSection; override;
function GetSection(const AVirtAddr: QWord): PDbgImageSection;
function MapVirtAddressToSection(AVirtAddr: Pointer): Pointer;
procedure LoadSections;
procedure ClearSections;
public
class function isValid(ASource: TDbgFileLoader): Boolean; override;
class function UserName: AnsiString; override;
function EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean; override;
public
constructor Create(ASource: TDbgFileLoader; ADebugMap: TObject; ALoadedTargetImageAddr: TDbgPtr; OwnSource: Boolean); override;
destructor Destroy; override;
procedure ParseSymbolTable(AfpSymbolInfo: TfpSymbolList); override;
procedure ParseLibrarySymbolTable(AFpSymbolInfo: TfpSymbolList); override;
end;
implementation
uses
FpDbgCommon;
var
DBG_WARNINGS: PLazLoggerLogGroup;
const
// Symbol-map section name
_symbol = '.symbols';
_symbolstrings = '.symbolsstrings';
type
PImageSymbolArray = ^TImageSymbolArray;
TImageSymbolArray = array[0..maxSmallint] of TImageSymbol;
function isValidPEStream(ASource: TDbgFileLoader): Boolean;
var
DosHeader: TImageDosHeader;
begin
try
Result := false;
if ASource.Read(0, sizeof(DosHeader), @DosHeader) <> sizeof(DosHeader) then
Exit;
if (DosHeader.e_magic <> IMAGE_DOS_SIGNATURE) or (DosHeader.e_lfanew = 0) then
Exit;
Result := true;
except
Result := false;
end;
end;
constructor TPEFileSource.Create(ASource: TDbgFileLoader; ADebugMap: TObject; ALoadedTargetImageAddr: TDbgPtr; OwnSource: Boolean);
var
crc: cardinal;
DbgFileName, SourceFileName: String;
NewFileLoader: TDbgFileLoader;
begin
inherited Create(ASource, ADebugMap, ALoadedTargetImageAddr, OwnSource);
FSections := TStringListUTF8Fast.Create;
FSections.Sorted := False; // need sections in original order / Symbols use "SectionNumber"
//FSections.Duplicates := dupError;
FSections.CaseSensitive := False;
FFileLoader:=ASource;
FOwnLoader:=OwnSource;
LoadSections;
// check external debug file
if ReadGnuDebugLinkSection(DbgFileName, crc) then
begin
SourceFileName := ASource.FileName;
if SourceFileName<>'' then
SourceFileName := ExtractFilePath(SourceFileName);
NewFileLoader := LoadGnuDebugLink(SourceFileName, DbgFileName, crc);
if NewFileLoader <> nil then begin
if FOwnLoader then
FFileLoader.Free;
FFileLoader := NewFileLoader;
FOwnLoader := True;
ClearSections;
LoadSections;
end;
end;
end;
procedure TPEFileSource.ClearSections;
var
i: Integer;
begin
for i := 0 to FSections.Count-1 do
Freemem(FSections.Objects[i]);
FSections.Clear;
end;
destructor TPEFileSource.Destroy;
begin
if FOwnLoader then FFileLoader.Free;
ClearSections;
FSections.Free;
inherited Destroy;
end;
procedure TPEFileSource.ParseSymbolTable(AfpSymbolInfo: TfpSymbolList);
var
p: PDbgImageSection;
ps: PDbgImageSection;
SymbolArr: PImageSymbolArray;
SymbolStr: pointer;
i,j: integer;
SymbolCount: integer;
SymbolName: AnsiString;
SectNumber, SectCount: Integer;
SectRVA: QWord;
begin
AfpSymbolInfo.SetAddressBounds(LoadedTargetImageAddr, LoadedTargetImageAddr+ImageSize);
p := Section[_symbol];
ps := Section[_symbolstrings];
if assigned(p) and assigned(ps) then
begin
SymbolArr:=PDbgImageSectionEx(p)^.Sect.RawData;
SymbolStr:=PDbgImageSectionEx(ps)^.Sect.RawData;
SymbolCount := PDbgImageSectionEx(p)^.Sect.Size div sizeof(TImageSymbol);
SectCount := FSections.Count;
{$PUSH}{$R-} // SymbolArr may be more than maxSmallInt
for i := 0 to SymbolCount-1 do
begin
begin
// Section-index is ignored for now...
if SymbolArr^[i].N.Name.Short=0 then
SymbolName:=pchar(SymbolStr+SymbolArr^[i].N.Name.Long)
else
begin
SymbolName:='';
if SymbolArr^[i].N.Name.Long<>0 then
begin
for j := 0 to sizeof(SymbolArr^[i].N.ShortName)-1 do
begin
if SymbolArr^[i].N.ShortName[j]=#0 then break;
SymbolName:=SymbolName+SymbolArr^[i].N.ShortName[j];
end;
end;
end;
SectNumber := integer(SymbolArr^[i].SectionNumber) - 1;
if (SectNumber >= 0) and (SectNumber < SectCount) then
SectRVA := PDbgImageSectionEx(FSections.Objects[SectNumber])^.Sect.VirtualAddress
else
SectRVA := 0;
AfpSymbolInfo.Add(SymbolName, TDBGPtr(SymbolArr^[i].Value+LoadedTargetImageAddr+SectRVA));
end
end;
{$POP}
end;
end;
procedure TPEFileSource.ParseLibrarySymbolTable(AFpSymbolInfo: TfpSymbolList);
{$ifdef windows}
var
hBase: PImageDosHeader;
header64: PImageNtHeaders64;
header32: PImageNtHeaders32;
ExportSect: PIMAGE_EXPORT_DIRECTORY;
ExportSize: DWord;
NameCnt, FuncCnt: DWord;
NameList, FuncList: PDWORD;
OrdList: PWORD;
i: Integer;
NameAddr: PByte;
FuncName: AnsiString;
OrdVal: Word;
FuncAddr: TDBGPtr;
{$ENDIF}
begin
{$ifdef windows}
if LoadedTargetImageAddr = 0 then
exit;
FFileLoader.LoadMemory(0, 1, hBase); // size does not matter, only obtain address
if (hBase = nil) or (hBase^.e_magic <> IMAGE_DOS_SIGNATURE) then
exit;
if TargetInfo.bitness = b64 then begin
header64 := PImageNtHeaders64(PByte(hBase) + hBase^.e_lfanew);
if (header64^.Signature <> IMAGE_NT_SIGNATURE) or
(header64^.OptionalHeader.NumberOfRvaAndSizes = 0)
then
exit;
ExportSect := MapVirtAddressToSection(
PIMAGE_EXPORT_DIRECTORY(PtrUInt(header64^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress))
);
ExportSize := header64^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size;
SetImageSize(header64^.OptionalHeader.SizeOfImage);
end
else begin
header32 := PImageNtHeaders32(PByte(hBase) + hBase^.e_lfanew);
if (header32^.Signature <> IMAGE_NT_SIGNATURE) or
(header32^.OptionalHeader.NumberOfRvaAndSizes = 0)
then
exit;
ExportSect := MapVirtAddressToSection(
PIMAGE_EXPORT_DIRECTORY(PtrUInt(header32^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress))
);
ExportSize := header32^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size;
SetImageSize(header32^.OptionalHeader.SizeOfImage);
end;
AfpSymbolInfo.SetAddressBounds(LoadedTargetImageAddr, LoadedTargetImageAddr+ImageSize);
if (ExportSect = nil) or (ExportSect^.AddressOfNames = 0) or (ExportSize = 0) then
exit;
NameCnt := ExportSect^.NumberOfNames;
FuncCnt := ExportSect^.NumberOfFunctions;
if (NameCnt = 0) or (FuncCnt = 0) then
exit;
NameList := MapVirtAddressToSection(PDWORD(PtrUInt(ExportSect^.AddressOfNames)));
OrdList := MapVirtAddressToSection( PWORD(PtrUInt(ExportSect^.AddressOfNameOrdinals)));
FuncList := MapVirtAddressToSection(PDWORD(PtrUInt(ExportSect^.AddressOfFunctions)));
if (NameList = nil) or (OrdList = nil) or (FuncList = nil) then
exit;
for i := 0 to NameCnt - 1 do begin
NameAddr := MapVirtAddressToSection(PByte(PtrUInt(NameList[i])));
if IndexByte(NameAddr^, 500, 0) < 0 then
continue;
FuncName := PChar(NameAddr);
OrdVal := OrdList[i];
if OrdVal >= FuncCnt then
continue;
FuncAddr := TDBGPtr(FuncList[OrdVal]);
if FuncAddr = 0 then
Continue;
AFpSymbolInfo.Add(FuncName, LoadedTargetImageAddr + FuncAddr);
end;
{$ENDIF}
end;
function TPEFileSource.GetSection(const AName: String): PDbgImageSection;
var
i: Integer;
ex: PDbgImageSectionEx;
begin
Result := nil;
i := FSections.IndexOf(AName);
if i < 0 then
exit;
ex := PDbgImageSectionEx(FSections.Objects[i]);
Result := @ex^.Sect;
if ex^.Loaded then
exit;
ex^.Loaded := True;
FFileLoader.LoadMemory(ex^.Offs, Result^.Size, Result^.RawData);
end;
function TPEFileSource.GetSection(const ID: integer): PDbgImageSection;
var
ex: PDbgImageSectionEx;
begin
if (ID >= 0) and (ID < FSections.Count) then
begin
ex := PDbgImageSectionEx(FSections.Objects[ID]);
Result := @ex^.Sect;
Result^.Name := FSections[ID];
if not ex^.Loaded then
begin
ex^.Loaded := True;
FFileLoader.LoadMemory(ex^.Offs, Result^.Size, Result^.RawData);
end;
end
else
Result := nil;
end;
function TPEFileSource.GetSection(const AVirtAddr: QWord): PDbgImageSection;
var
i: Integer;
ex: PDbgImageSectionEx;
begin
for i := 0 to FSections.Count - 1 do begin
ex := PDbgImageSectionEx(FSections.Objects[i]);
Result := @ex^.Sect;
if (Result^.VirtualAddress <= AVirtAddr) and
(Result^.VirtualAddress + Result^.Size > AVirtAddr)
then begin
FFileLoader.LoadMemory(ex^.Offs, Result^.Size, Result^.RawData);
exit;
end;
end;
Result := nil;
end;
function TPEFileSource.MapVirtAddressToSection(AVirtAddr: Pointer): Pointer;
var
Sect: PDbgImageSection;
begin
(* AVirtAddress is a 32bit pointer (DWORD) as found in the mem mapped file.
It will be mapped to the Address to which the file has been loaded. (native pointer)
*)
Result := nil;
Sect := GetSection(QWord(AVirtAddr));
if Sect = nil then
exit;
{$PUSH}{$R-}
Result := (PByte(Sect^.RawData) + (QWord(AVirtAddr) - Sect^.VirtualAddress));
{$POP}
end;
procedure TPEFileSource.LoadSections;
procedure Add(const AName: String; ARawData: QWord; ASize: QWord; AVirtualAdress: QWord;
AIsLoadable: boolean);
var
p: PDbgImageSectionEx;
idx: integer;
begin
idx := FSections.AddObject(AName, nil);
New(p);
P^.Offs := ARawData;
p^.Sect.Size := ASize;
p^.Sect.VirtualAddress := AVirtualAdress;
p^.Sect.IsLoadable := AIsLoadable; // Could also default to false since it isn't currently used
p^.Loaded := False;
FSections.Objects[idx] := TObject(p);
end;
var
DosHeader: TImageDosHeader;
NtHeaders: record
case integer of
1: (Sys: TImageNtHeaders;);
2: (W32: TImageNtHeaders32;);
3: (W64: TImageNtHeaders64;);
end;
SectionHeader: PImageSectionHeader;
n, i: Integer;
SectionName: array[0..IMAGE_SIZEOF_SHORT_NAME] of Char;
SectionMax: QWord;
s: string[255];
StringTableLen: DWord;
StringTableStart: QWord;
begin
FTargetInfo.machineType := mtNONE;
FTargetInfo.bitness := bNone;
FTargetInfo.byteOrder := boNone;
FTargetInfo.OS := osNone;
FFileLoader.Read(0, sizeof(DosHeader), @DosHeader);
if (DosHeader.e_magic <> IMAGE_DOS_SIGNATURE)
or (DosHeader.e_lfanew = 0)
then begin
//WriteLn('Invalid DOS header');
Exit;
end;
FFileLoader.Read(DosHeader.e_lfanew, sizeof(NtHeaders), @NtHeaders);
if NtHeaders.Sys.Signature <> IMAGE_NT_SIGNATURE
then begin
//WriteLn('Invalid NT header: ', IntToHex(NtHeaders^.Signature, 8));
Exit;
end;
FTargetInfo.OS := osWindows;
case NtHeaders.Sys.FileHeader.Machine of
IMAGE_FILE_MACHINE_I386:
begin
FTargetInfo.machineType := mt386;
FTargetInfo.byteOrder := boLSB;
end;
IMAGE_FILE_MACHINE_ARM:
begin
FTargetInfo.machineType := mtARM;
FTargetInfo.byteOrder := boLSB;
end;
IMAGE_FILE_MACHINE_IA64, IMAGE_FILE_MACHINE_AMD64:
begin
FTargetInfo.machineType := mtX86_64;
FTargetInfo.byteOrder := boLSB;
end;
else
FTargetInfo.OS := osNone;
end;
case NtHeaders.Sys.OptionalHeader.Magic of
IMAGE_NT_OPTIONAL_HDR32_MAGIC: FTargetInfo.Bitness := b32;
IMAGE_NT_OPTIONAL_HDR64_MAGIC: FTargetInfo.Bitness := b64;
else
FTargetInfo.Bitness := bNone;
end;
if FTargetInfo.Bitness = b64 then begin
SetImageBase(NtHeaders.W64.OptionalHeader.ImageBase);
SetImageSize(NtHeaders.W64.OptionalHeader.SizeOfImage);
end else begin
SetImageBase(NtHeaders.W32.OptionalHeader.ImageBase);
SetImageSize(NtHeaders.W32.OptionalHeader.SizeOfImage);
end;
// Windows has loaded the binary at the LoadedTargetImageAddr. But the addresses
// inside the library are encoded as if the binary is located at the ImageBase
// address. So when LoadedTargetImageAddr<>ImageBase (happens when the binary has been
// relocated) all addresses need a correction.
// The difference between the LoadedTargetImageAddr and ImageBase is the offset
// that has to be used to calculate the actual addresses in memory.
{$PUSH}{$Q-}{$R-}
SetRelocationOffset(LoadedTargetImageAddr-ImageBase);
{$POP}
FCodeBase := NtHeaders.W32.OptionalHeader.BaseOfCode;
SectionMax := FFileLoader.LoadMemory(
DosHeader.e_lfanew +
(PByte(@NtHeaders.Sys.OptionalHeader) - PByte(@NtHeaders.Sys)) +
NtHeaders.Sys.FileHeader.SizeOfOptionalHeader,
SizeOf(TImageSectionHeader) * NtHeaders.Sys.FileHeader.NumberOfSections,
SectionHeader
)
div SizeOf(TImageSectionHeader);
if SectionMax <> NtHeaders.Sys.FileHeader.NumberOfSections then begin
DebugLn(DBG_WARNINGS, ['Could not load all headers', NtHeaders.Sys.FileHeader.NumberOfSections, ' ', SectionMax]);
end;
for n := 0 to SectionMax - 1 do
begin
//SectionHeader := Pointer(@NtHeaders.Sys.OptionalHeader) +
// NtHeaders.Sys.FileHeader.SizeOfOptionalHeader +
// SizeOf(TImageSectionHeader) * n;
// make a null terminated name
Move(SectionHeader[n].Name, SectionName, IMAGE_SIZEOF_SHORT_NAME);
SectionName[IMAGE_SIZEOF_SHORT_NAME] := #0;
if (SectionName[0] = '/') and (SectionName[1] in ['0'..'9'])
then begin
// long name
i := FFileLoader.Read(
NTHeaders.Sys.FileHeader.PointerToSymbolTable +
NTHeaders.Sys.FileHeader.NumberOfSymbols * IMAGE_SIZEOF_SYMBOL +
StrToIntDef(PChar(@SectionName[1]), 0), 255, @s[1]);
s[Min(i, 255)] := #0;
Add(pchar(@s[1]), SectionHeader[n].PointerToRawData, SectionHeader[n].Misc.VirtualSize, SectionHeader[n].VirtualAddress,
not((SectionHeader[n].Characteristics and (IMAGE_SCN_CNT_CODE or IMAGE_SCN_CNT_INITIALIZED_DATA)) = 0));
end
else begin
// short name
Add(SectionName, SectionHeader[n].PointerToRawData, SectionHeader[n].Misc.VirtualSize, SectionHeader[n].VirtualAddress,
not((SectionHeader[n].Characteristics and (IMAGE_SCN_CNT_CODE or IMAGE_SCN_CNT_INITIALIZED_DATA)) = 0));
end
end;
// Create a fake-sections for the symbol-table:
if NtHeaders.Sys.FileHeader.PointerToSymbolTable<>0 then
begin
Add(_symbol,NtHeaders.Sys.FileHeader.PointerToSymbolTable, NtHeaders.Sys.FileHeader.NumberOfSymbols*IMAGE_SIZEOF_SYMBOL,0,false);
StringTableStart:=NtHeaders.Sys.FileHeader.PointerToSymbolTable+NtHeaders.Sys.FileHeader.NumberOfSymbols*IMAGE_SIZEOF_SYMBOL;
FFileLoader.Read(StringTableStart, sizeof(DWord), @StringTableLen);
Add(_symbolstrings,StringTableStart, StringTableLen, 0,false);
end;
FFileLoader.UnloadMemory(SectionHeader);
end;
class function TPEFileSource.isValid(ASource: TDbgFileLoader): Boolean;
begin
Result := isValidPEStream(ASource);
end;
class function TPEFileSource.UserName: AnsiString;
begin
Result:='PE file';
end;
function TPEFileSource.EnclosesAddressRange(AStartAddress, AnEndAddress: TDBGPtr): Boolean;
var
i: Integer;
ex: PDbgImageSectionEx;
s: PDbgImageSection;
begin
for i := 0 to FSections.Count - 1 do
begin
ex := PDbgImageSectionEx(FSections.Objects[i]);
s := @ex^.Sect;
if (s^.VirtualAddress+LoadedTargetImageAddr <= AStartAddress) and
(s^.VirtualAddress + s^.Size + LoadedTargetImageAddr >= AnEndAddress) then
Exit(True);
end;
Result := False;
end;
initialization
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
RegisterImageReaderClass(TPEFileSource);
end.