{ This file is part of the Free Pascal run time library. Copyright (c) 2008 by Peter Vreman Executable file reading functions See the file COPYING.FPC, included in this distribution, for details about the copyright. This program 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. **********************************************************************} unit exeinfo; interface {$mode objfpc} {$S-} type TExeFile=record f : file; isopen : boolean; nsects : longint; sechdrofs, secstrofs : ptruint; processaddress : ptruint; end; function OpenExeFile(out e:TExeFile;const fn:string):boolean; function FindExeSection(var e:TExeFile;const secname:string;out secofs,seclen:longint):boolean; function CloseExeFile(var e:TExeFile):boolean; implementation uses strings; {**************************************************************************** Executable Loaders ****************************************************************************} {$if defined(netbsd) or defined(freebsd) or defined(linux) or defined(sunos)} {$ifdef cpu64} {$define ELF64} {$else} {$define ELF32} {$endif} {$endif} {$if defined(win32) or defined(wince)} {$define PE32} {$endif} {$if defined(win64)} {$define PE32PLUS} {$endif} {$ifdef netwlibc} {$define netware} {$endif} {$IFDEF OS2} {$DEFINE EMX} {$ENDIF OS2} {$ifdef netware} const SIZE_OF_NLM_INTERNAL_FIXED_HEADER = 130; SIZE_OF_NLM_INTERNAL_VERSION_HEADER = 32; SIZE_OF_NLM_INTERNAL_EXTENDED_HEADER = 124; function loadNetwareNLM:boolean; var valid : boolean; name : string; StabLength, StabStrLength, alignAmount, hdrLength, dataOffset, dataLength : longint; function getByte:byte; begin BlockRead (f,getByte,1); end; procedure Skip (bytes : longint); var i : longint; begin for i := 1 to bytes do getbyte; end; function getLString : String; var Res:string; begin blockread (F, res, 1); if length (res) > 0 THEN blockread (F, res[1], length (res)); getbyte; getLString := res; end; function getFixString (Len : byte) : string; var i : byte; begin getFixString := ''; for I := 1 to Len do getFixString := getFixString + char (getbyte); end; function get0String : string; var c : char; begin get0String := ''; c := char (getbyte); while (c <> #0) do begin get0String := get0String + c; c := char (getbyte); end; end; function getword : word; begin blockread (F, getword, 2); end; function getint32 : longint; begin blockread (F, getint32, 4); end; begin processaddress := 0; LoadNetwareNLM:=false; stabofs:=-1; stabstrofs:=-1; { read and check header } Skip (SIZE_OF_NLM_INTERNAL_FIXED_HEADER); getLString; // NLM Description getInt32; // Stacksize getInt32; // Reserved skip(5); // old Thread Name getLString; // Screen Name getLString; // Thread Name hdrLength := -1; dataOffset := -1; dataLength := -1; valid := true; repeat name := getFixString (8); if (name = 'VeRsIoN#') then begin Skip (SIZE_OF_NLM_INTERNAL_VERSION_HEADER-8); end else if (name = 'CoPyRiGh') then begin getword; // T= getLString; // Copyright String end else if (name = 'MeSsAgEs') then begin skip (SIZE_OF_NLM_INTERNAL_EXTENDED_HEADER - 8); end else if (name = 'CuStHeAd') then begin hdrLength := getInt32; dataOffset := getInt32; dataLength := getInt32; Skip (8); // dataStamp Valid := false; end else Valid := false; until not valid; if (hdrLength = -1) or (dataOffset = -1) or (dataLength = -1) then exit; (* The format of the section information is: null terminated section name zeroes to adjust to 4 byte boundary 4 byte section data file pointer 4 byte section size *) Seek (F, dataOffset); stabOfs := 0; stabStrOfs := 0; Repeat Name := Get0String; alignAmount := 4 - ((length (Name) + 1) MOD 4); Skip (alignAmount); if (Name = '.stab') then begin stabOfs := getInt32; stabLength := getInt32; stabcnt:=stabLength div sizeof(tstab); end else if (Name = '.stabstr') then begin stabStrOfs := getInt32; stabStrLength := getInt32; end else Skip (8); until (Name = '') or ((StabOfs <> 0) and (stabStrOfs <> 0)); Seek (F,stabOfs); //if (StabOfs = 0) then __ConsolePrintf ('StabOfs = 0'); //if (StabStrOfs = 0) then __ConsolePrintf ('StabStrOfs = 0'); LoadNetwareNLM := ((stabOfs > 0) and (stabStrOfs > 0)); end; {$endif} {$ifdef go32v2} function LoadGo32Coff:boolean; type tcoffheader=packed record mach : word; nsects : word; time : longint; sympos : longint; syms : longint; opthdr : word; flag : word; other : array[0..27] of byte; end; tcoffsechdr=packed record name : array[0..7] of char; vsize : longint; rvaofs : longint; datalen : longint; datapos : longint; relocpos : longint; lineno1 : longint; nrelocs : word; lineno2 : word; flags : longint; end; var coffheader : tcoffheader; coffsec : tcoffsechdr; i : longint; begin processaddress := 0; LoadGo32Coff:=false; stabofs:=-1; stabstrofs:=-1; { read and check header } if filesize(f)<2048+sizeof(tcoffheader) then exit; seek(f,2048); blockread(f,coffheader,sizeof(tcoffheader)); if coffheader.mach<>$14c then exit; { read section info } for i:=1to coffheader.nSects do begin blockread(f,coffsec,sizeof(tcoffsechdr)); if (coffsec.name[4]='b') and (coffsec.name[1]='s') and (coffsec.name[2]='t') then begin if (coffsec.name[5]='s') and (coffsec.name[6]='t') then stabstrofs:=coffsec.datapos+2048 else begin stabofs:=coffsec.datapos+2048; stabcnt:=coffsec.datalen div sizeof(tstab); end; end; end; LoadGo32Coff:=(stabofs<>-1) and (stabstrofs<>-1); end; {$endif Go32v2} {$ifdef PE32} function OpenPeCoff(var e:TExeFile):boolean; type tdosheader = packed record e_magic : word; e_cblp : word; e_cp : word; e_crlc : word; e_cparhdr : word; e_minalloc : word; e_maxalloc : word; e_ss : word; e_sp : word; e_csum : word; e_ip : word; e_cs : word; e_lfarlc : word; e_ovno : word; e_res : array[0..3] of word; e_oemid : word; e_oeminfo : word; e_res2 : array[0..9] of word; e_lfanew : longint; end; tpeheader = packed record PEMagic : longint; Machine : word; NumberOfSections : word; TimeDateStamp : longint; PointerToSymbolTable : longint; NumberOfSymbols : longint; SizeOfOptionalHeader : word; Characteristics : word; Magic : word; MajorLinkerVersion : byte; MinorLinkerVersion : byte; SizeOfCode : longint; SizeOfInitializedData : longint; SizeOfUninitializedData : longint; AddressOfEntryPoint : longint; BaseOfCode : longint; BaseOfData : longint; ImageBase : longint; SectionAlignment : longint; FileAlignment : longint; MajorOperatingSystemVersion : word; MinorOperatingSystemVersion : word; MajorImageVersion : word; MinorImageVersion : word; MajorSubsystemVersion : word; MinorSubsystemVersion : word; Reserved1 : longint; SizeOfImage : longint; SizeOfHeaders : longint; CheckSum : longint; Subsystem : word; DllCharacteristics : word; SizeOfStackReserve : longint; SizeOfStackCommit : longint; SizeOfHeapReserve : longint; SizeOfHeapCommit : longint; LoaderFlags : longint; NumberOfRvaAndSizes : longint; DataDirectory : array[1..$80] of byte; end; coffsymbol=packed record name : array[0..3] of char; { real is [0..7], which overlaps the strofs ! } strofs : longint; value : longint; section : smallint; empty : word; typ : byte; aux : byte; end; var dosheader : tdosheader; peheader : tpeheader; begin result:=false; { read and check header } if filesize(e.f)$4550 then exit; e.sechdrofs:=filepos(e.f); e.nsects:=peheader.NumberOfSections; e.secstrofs:=peheader.PointerToSymbolTable+peheader.NumberOfSymbols*sizeof(coffsymbol)+4; if e.secstrofs>filesize(e.f) then exit; result:=true; end; {$endif PE32} {$if defined(PE32) or defined(PE32PLUS)} function FindSectionPECoff(var e:TExeFile;const asecname:string;out secofs,seclen:longint):boolean; type tcoffsechdr=packed record name : array[0..7] of char; vsize : longint; rvaofs : longint; datalen : longint; datapos : longint; relocpos : longint; lineno1 : longint; nrelocs : word; lineno2 : word; flags : longint; end; var i : longint; sechdr : tcoffsechdr; secname : string; secnamebuf : array[0..255] of char; code, oldofs, bufsize : longint; strofs : cardinal; begin result:=false; { read section info } seek(e.f,e.sechdrofs); for i:=1 to e.nsects do begin blockread(e.f,sechdr,sizeof(sechdr),bufsize); move(sechdr.name,secnamebuf,8); secnamebuf[8]:=#0; secname:=strpas(secnamebuf); if secname[1]='/' then begin Val(Copy(secname,2,8),strofs,code); if code=0 then begin fillchar(secnamebuf,sizeof(secnamebuf),0); oldofs:=filepos(e.f); seek(e.f,e.secstrofs+strofs); blockread(e.f,secnamebuf,sizeof(secnamebuf),bufsize); seek(e.f,oldofs); secname:=strpas(secnamebuf); end else secname:=''; end; if asecname=secname then begin secofs:=sechdr.datapos; seclen:=sechdr.datalen; result:=true; exit; end; end; end; {$endif PE32 or PE32PLUS} {$ifdef PE32PLUS} function OpenPePlusCoff(var e:TExeFile):boolean; type tdosheader = packed record e_magic : word; e_cblp : word; e_cp : word; e_crlc : word; e_cparhdr : word; e_minalloc : word; e_maxalloc : word; e_ss : word; e_sp : word; e_csum : word; e_ip : word; e_cs : word; e_lfarlc : word; e_ovno : word; e_res : array[0..3] of word; e_oemid : word; e_oeminfo : word; e_res2 : array[0..9] of word; e_lfanew : longint; end; tpeheader = packed record PEMagic : longint; Machine : word; NumberOfSections : word; TimeDateStamp : longint; PointerToSymbolTable : longint; NumberOfSymbols : longint; SizeOfOptionalHeader : word; Characteristics : word; Magic : word; MajorLinkerVersion : byte; MinorLinkerVersion : byte; SizeOfCode : longint; SizeOfInitializedData : longint; SizeOfUninitializedData : longint; AddressOfEntryPoint : longint; BaseOfCode : longint; BaseOfData : longint; ImageBase : longint; SectionAlignment : longint; FileAlignment : longint; MajorOperatingSystemVersion : word; MinorOperatingSystemVersion : word; MajorImageVersion : word; MinorImageVersion : word; MajorSubsystemVersion : word; MinorSubsystemVersion : word; Reserved1 : longint; SizeOfImage : longint; SizeOfHeaders : longint; CheckSum : longint; Subsystem : word; DllCharacteristics : word; SizeOfStackReserve : int64; SizeOfStackCommit : int64; SizeOfHeapReserve : int64; SizeOfHeapCommit : int64; LoaderFlags : longint; NumberOfRvaAndSizes : longint; DataDirectory : array[1..$80] of byte; end; tcoffsechdr=packed record name : array[0..7] of char; vsize : longint; rvaofs : longint; datalen : longint; datapos : longint; relocpos : longint; lineno1 : longint; nrelocs : word; lineno2 : word; flags : longint; end; var dosheader : tdosheader; peheader : tpeheader; begin result:=false; { read and check header } if filesize(f)$4550 then exit; e.sechdrofs:=filepos(e.f); e.nsects:=peheader.NumberOfSections; e.secstrofs:=peheader.PointerToSymbolTable+peheader.NumberOfSymbols*sizeof(coffsymbol)+4; if e.secstrofs>filesize(e.f) then exit; result:=true; end; {$endif PE32PLUS} {$IFDEF EMX} function LoadEMXaout: boolean; type TDosHeader = packed record e_magic : word; e_cblp : word; e_cp : word; e_crlc : word; e_cparhdr : word; e_minalloc : word; e_maxalloc : word; e_ss : word; e_sp : word; e_csum : word; e_ip : word; e_cs : word; e_lfarlc : word; e_ovno : word; e_res : array[0..3] of word; e_oemid : word; e_oeminfo : word; e_res2 : array[0..9] of word; e_lfanew : longint; end; TEmxHeader = packed record Version: array [1..16] of char; Bound: word; AoutOfs: longint; Options: array [1..42] of char; end; TAoutHeader = packed record Magic: word; Machine: byte; Flags: byte; TextSize: longint; DataSize: longint; BssSize: longint; SymbSize: longint; EntryPoint: longint; TextRelocSize: longint; DataRelocSize: longint; end; const StartPageSize = $1000; var DosHeader: TDosHeader; EmxHeader: TEmxHeader; AoutHeader: TAoutHeader; S4: string [4]; begin processaddress := 0; LoadEMXaout := false; StabOfs := -1; StabStrOfs := -1; { read and check header } if FileSize (F) > SizeOf (DosHeader) then begin BlockRead (F, DosHeader, SizeOf (TDosHeader)); Seek (F, DosHeader.e_cparhdr shl 4); BlockRead (F, EmxHeader, SizeOf (TEmxHeader)); S4 [0] := #4; Move (EmxHeader.Version, S4 [1], 4); if S4 = 'emx ' then begin Seek (F, EmxHeader.AoutOfs); BlockRead (F, AoutHeader, SizeOf (TAoutHeader)); if AOutHeader.Magic=$10B then StabOfs := StartPageSize else StabOfs :=EmxHeader.AoutOfs + SizeOf (TAoutHeader); StabOfs := StabOfs + AoutHeader.TextSize + AoutHeader.DataSize + AoutHeader.TextRelocSize + AoutHeader.DataRelocSize; StabCnt := AoutHeader.SymbSize div SizeOf (TStab); StabStrOfs := StabOfs + AoutHeader.SymbSize; StabsFunctionRelative:=false; LoadEMXaout := (StabOfs <> -1) and (StabStrOfs <> -1); end; end; end; {$ENDIF EMX} {$if defined(ELF32) or defined(ELF64)} type {$ifdef ELF32} telfheader=packed record magic0123 : longint; file_class : byte; data_encoding : byte; file_version : byte; padding : array[$07..$0f] of byte; e_type : word; e_machine : word; e_version : longword; e_entry : longword; // entrypoint e_phoff : longword; // program header offset e_shoff : longword; // sections header offset e_flags : longword; e_ehsize : word; // elf header size in bytes e_phentsize : word; // size of an entry in the program header array e_phnum : word; // 0..e_phnum-1 of entrys e_shentsize : word; // size of an entry in sections header array e_shnum : word; // 0..e_shnum-1 of entrys e_shstrndx : word; // index of string section header end; telfsechdr=packed record sh_name : longword; sh_type : longword; sh_flags : longword; sh_addr : longword; sh_offset : longword; sh_size : longword; sh_link : longword; sh_info : longword; sh_addralign : longword; sh_entsize : longword; end; {$endif ELF32} {$ifdef ELF64} telfheader=packed record magic0123 : longint; file_class : byte; data_encoding : byte; file_version : byte; padding : array[$07..$0f] of byte; e_type : word; e_machine : word; e_version : longword; e_entry : int64; // entrypoint e_phoff : int64; // program header offset e_shoff : int64; // sections header offset e_flags : longword; e_ehsize : word; // elf header size in bytes e_phentsize : word; // size of an entry in the program header array e_phnum : word; // 0..e_phnum-1 of entrys e_shentsize : word; // size of an entry in sections header array e_shnum : word; // 0..e_shnum-1 of entrys e_shstrndx : word; // index of string section header end; telfsechdr=packed record sh_name : longword; sh_type : longword; sh_flags : int64; sh_addr : int64; sh_offset : int64; sh_size : int64; sh_link : longword; sh_info : longword; sh_addralign : int64; sh_entsize : int64; end; {$endif ELF64} function OpenElf(var e:TExeFile):boolean; var elfheader : telfheader; elfsec : telfsechdr; begin result:=false; { read and check header } if filesize(e.f){$ifdef ENDIAN_LITTLE}$464c457f{$else}$7f454c46{$endif} then exit; if elfheader.e_shentsize<>sizeof(telfsechdr) then exit; { read section names } seek(e.f,elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telfsechdr))); blockread(e.f,elfsec,sizeof(telfsechdr)); e.secstrofs:=elfsec.sh_offset; e.sechdrofs:=elfheader.e_shoff; e.nsects:=elfheader.e_shnum; end; function FindSectionElf(var e:TExeFile;const asecname:string;out secofs,seclen:longint):boolean; var elfsec : telfsechdr; secname : string; secnamebuf : array[0..255] of char; oldofs, bufsize,i : longint; begin result:=false; seek(e.f,e.sechdrofs); for i:=1 to e.nsects do begin blockread(e.f,elfsec,sizeof(telfsechdr)); fillchar(secnamebuf,sizeof(secnamebuf),0); oldofs:=filepos(e.f); seek(e.f,e.secstrofs+elfsec.sh_name); blockread(e.f,secnamebuf,sizeof(secnamebuf),bufsize); seek(e.f,oldofs); secname:=strpas(secnamebuf); if asecname=secname then begin secofs:=elfsec.sh_offset; seclen:=elfsec.sh_size; result:=true; exit; end; end; end; {$endif ELF32} {$ifdef beos} {$i ptypes.inc} { ------------------------- Images --------------------------- } type // Descriptive formats status_t = Longint; team_id = Longint; image_id = Longint; { image types } const B_APP_IMAGE = 1; B_LIBRARY_IMAGE = 2; B_ADD_ON_IMAGE = 3; B_SYSTEM_IMAGE = 4; type image_info = packed record id : image_id; _type : longint; sequence: longint; init_order: longint; init_routine: pointer; term_routine: pointer; device: dev_t; node: ino_t; name: array[0..MAXPATHLEN-1] of char; { name: string[255]; name2: string[255]; name3: string[255]; name4: string[255]; name5: string[5]; } text: pointer; data: pointer; text_size: longint; data_size: longint; end; function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info'; function LoadElf32Beos:boolean; type telf32header=packed record magic0123 : longint; file_class : byte; data_encoding : byte; file_version : byte; padding : array[$07..$0f] of byte; e_type : word; e_machine : word; e_version : longword; e_entry : longword; // entrypoint e_phoff : longword; // program header offset e_shoff : longword; // sections header offset e_flags : longword; e_ehsize : word; // elf header size in bytes e_phentsize : word; // size of an entry in the program header array e_phnum : word; // 0..e_phnum-1 of entrys e_shentsize : word; // size of an entry in sections header array e_shnum : word; // 0..e_shnum-1 of entrys e_shstrndx : word; // index of string section header end; telf32sechdr=packed record sh_name : longword; sh_type : longword; sh_flags : longword; sh_addr : longword; sh_offset : longword; sh_size : longword; sh_link : longword; sh_info : longword; sh_addralign : longword; sh_entsize : longword; end; var elfheader : telf32header; elfsec : telf32sechdr; secnames : array[0..255] of char; pname : pchar; i : longint; cookie : longint; info : image_info; result : status_t; begin cookie := 0; fillchar(info, sizeof(image_info), 0); get_next_image_info(0,cookie,info,sizeof(info)); if (info._type = B_APP_IMAGE) then processaddress := cardinal(info.text) else processaddress := 0; LoadElf32Beos:=false; stabofs:=-1; stabstrofs:=-1; { read and check header } if filesize(f)$464c457f then exit; {$endif ENDIAN_LITTLE} {$ifdef ENDIAN_BIG} if elfheader.magic0123<>$7f454c46 then exit; {$endif ENDIAN_BIG} if elfheader.e_shentsize<>sizeof(telf32sechdr) then exit; { read section names } seek(f,elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telf32sechdr))); blockread(f,elfsec,sizeof(telf32sechdr)); seek(f,elfsec.sh_offset); blockread(f,secnames,sizeof(secnames)); { read section info } seek(f,elfheader.e_shoff); for i:=1to elfheader.e_shnum do begin blockread(f,elfsec,sizeof(telf32sechdr)); pname:=@secnames[elfsec.sh_name]; if (pname[4]='b') and (pname[1]='s') and (pname[2]='t') then begin if (pname[5]='s') and (pname[6]='t') then stabstrofs:=elfsec.sh_offset else begin stabofs:=elfsec.sh_offset; stabcnt:=elfsec.sh_size div sizeof(tstab); end; end; end; LoadElf32Beos:=(stabofs<>-1) and (stabstrofs<>-1); end; {$endif beos} {$ifdef darwin} type MachoFatHeader= packed record magic: longint; nfatarch: longint; end; MachoHeader= packed record magic: longword; cpu_type_t: longint; cpu_subtype_t: longint; filetype: longint; ncmds: longint; sizeofcmds: longint; flags: longint; end; cmdblock= packed record cmd: longint; cmdsize: longint; end; symbSeg= packed record symoff : longint; nsyms : longint; stroff : longint; strsize: longint; end; function OpenMachO32PPC(var e:TExeFile):boolean; var mh:MachoHeader; begin result:= false; if filesize(e.f)0 then exit; e.isopen:=true; if ExeProcs.OpenProc<>nil then result:=ExeProcs.OpenProc(e); end; function CloseExeFile(var e:TExeFile):boolean; begin result:=false; if not e.isopen then exit; e.isopen:=false; close(e.f); result:=true; end; function FindExeSection(var e:TExeFile;const secname:string;out secofs,seclen:longint):boolean; begin result:=false; if not e.isopen then exit; if ExeProcs.FindProc<>nil then result:=ExeProcs.FindProc(e,secname,secofs,seclen); end; end.