1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 2008 by Peter Vreman 4 5 Executable file reading functions 6 7 See the file COPYING.FPC, included in this distribution, 8 for details about the copyright. 9 10 This program is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 13 14 **********************************************************************} 15{ 16 This unit should not be compiled in objfpc mode, since this would make it 17 dependent on objpas unit. 18} 19 20{ Disable checks of pointers explictly, 21 as we are dealing here with special pointer that 22 might be seen as invalid by heaptrc unit CheckPointer function } 23 24{$checkpointer off} 25 26unit exeinfo; 27interface 28 29{$S-} 30 31type 32 TExeFile=record 33 f : file; 34 // cached filesize 35 size : int64; 36 isopen : boolean; 37 nsects : longint; 38 sechdrofs, 39 secstrofs : {$ifdef cpui8086}longword{$else}ptruint{$endif}; 40 processaddress : {$ifdef cpui8086}word{$else}ptruint{$endif}; 41{$ifdef cpui8086} 42 processsegment : word; 43{$endif cpui8086} 44 FunctionRelative: boolean; 45 // Offset of the binary image forming permanent offset to all retrieved values 46 ImgOffset: {$ifdef cpui8086}longword{$else}ptruint{$endif}; 47 filename : string; 48 // Allocate static buffer for reading data 49 buf : array[0..4095] of byte; 50 bufsize, 51 bufcnt : longint; 52 end; 53 54function OpenExeFile(var e:TExeFile;const fn:string):boolean; 55function FindExeSection(var e:TExeFile;const secname:string;var secofs,seclen:longint):boolean; 56function CloseExeFile(var e:TExeFile):boolean; 57function ReadDebugLink(var e:TExeFile;var dbgfn:string):boolean; 58 59{$ifdef CPUI8086} 60procedure GetModuleByAddr(addr: farpointer; var baseaddr: farpointer; var filename: string); 61{$else CPUI8086} 62procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string); 63{$endif CPUI8086} 64 65implementation 66 67uses 68 strings{$ifdef windows},windows{$endif windows}; 69 70{$if defined(unix) and not defined(beos) and not defined(haiku)} 71 72 procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string); 73 begin 74 if assigned(UnixGetModuleByAddrHook) then 75 UnixGetModuleByAddrHook(addr,baseaddr,filename) 76 else 77 begin 78 baseaddr:=nil; 79 filename:=ParamStr(0); 80 end; 81 end; 82 83{$elseif defined(windows)} 84 85 var 86 Tmm: TMemoryBasicInformation; 87{$ifdef FPC_OS_UNICODE} 88 TST: array[0..Max_Path] of WideChar; 89{$else} 90 TST: array[0..Max_Path] of Char; 91{$endif FPC_OS_UNICODE} 92 procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string); 93 begin 94 baseaddr:=nil; 95 if VirtualQuery(addr, @Tmm, SizeOf(Tmm))<>sizeof(Tmm) then 96 filename:=ParamStr(0) 97 else 98 begin 99 baseaddr:=Tmm.AllocationBase; 100 TST[0]:= #0; 101 if baseaddr <> nil then 102 begin 103 GetModuleFileName(THandle(Tmm.AllocationBase), TST, Length(TST)); 104{$ifdef FPC_OS_UNICODE} 105 filename:= String(PWideChar(@TST)); 106{$else} 107 filename:= String(PChar(@TST)); 108{$endif FPC_OS_UNICODE} 109 end; 110 end; 111 end; 112 113{$elseif defined(morphos)} 114 115 procedure startsymbol; external name '_start'; 116 117 procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string); 118 begin 119 baseaddr:= @startsymbol; 120{$ifdef FPC_HAS_FEATURE_COMMANDARGS} 121 filename:=ParamStr(0); 122{$else FPC_HAS_FEATURE_COMMANDARGS} 123 filename:=''; 124{$endif FPC_HAS_FEATURE_COMMANDARGS} 125 end; 126 127{$elseif defined(msdos)} 128 129 procedure GetModuleByAddr(addr: farpointer; var baseaddr: farpointer; var filename: string); 130 begin 131 baseaddr:=Ptr(PrefixSeg+16,0); 132 filename:=ParamStr(0); 133 end; 134 135{$elseif defined(beos) or defined(haiku)} 136 137{$i ptypes.inc} 138{$i ostypes.inc} 139 140 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'; 141 142 procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string); 143 const 144 B_OK = 0; 145 var 146 cookie : longint; 147 info : image_info; 148 begin 149 filename:=''; 150 baseaddr:=nil; 151 152 cookie:=0; 153 fillchar(info, sizeof(image_info), 0); 154 155 while get_next_image_info(0,cookie,info,sizeof(info))=B_OK do 156 begin 157 if (info._type = B_APP_IMAGE) and 158 (addr >= info.text) and (addr <= (info.text + info.text_size)) then 159 begin 160 baseaddr:=info.text; 161 filename:=PChar(@info.name); 162 end; 163 end; 164 end; 165 166{$else} 167 168{$ifdef CPUI8086} 169 procedure GetModuleByAddr(addr: farpointer; var baseaddr: farpointer; var filename: string); 170{$else CPUI8086} 171 procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string); 172{$endif CPUI8086} 173 begin 174 baseaddr:= nil; 175{$ifdef FPC_HAS_FEATURE_COMMANDARGS} 176 filename:=ParamStr(0); 177{$else FPC_HAS_FEATURE_COMMANDARGS} 178 filename:=''; 179{$endif FPC_HAS_FEATURE_COMMANDARGS} 180 end; 181 182{$endif} 183 184{**************************************************************************** 185 Executable Loaders 186****************************************************************************} 187 188{$if defined(freebsd) or defined(netbsd) or defined (openbsd) or defined(linux) or defined(sunos) or defined(android) or defined(dragonfly)} 189 {$ifdef cpu64} 190 {$define ELF64} 191 {$define FIND_BASEADDR_ELF} 192 {$else} 193 {$define ELF32} 194 {$define FIND_BASEADDR_ELF} 195 {$endif} 196{$endif} 197 198{$if defined(beos) or defined(haiku)} 199 {$ifdef cpu64} 200 {$define ELF64} 201 {$else} 202 {$define ELF32} 203 {$endif} 204{$endif} 205 206{$if defined(morphos)} 207 {$define ELF32} 208{$endif} 209 210{$if defined(msdos)} 211 {$define ELF32} 212{$endif} 213 214{$if defined(win32) or defined(wince)} 215 {$define PE32} 216{$endif} 217 218{$if defined(win64)} 219 {$define PE32PLUS} 220{$endif} 221 222{$ifdef netwlibc} 223 {$define netware} 224{$endif} 225 226{$IFDEF OS2} 227 {$DEFINE EMX} 228{$ENDIF OS2} 229 230 231{**************************************************************************** 232 DOS Stub 233****************************************************************************} 234 235{$if defined(EMX) or defined(PE32) or defined(PE32PLUS) or defined(GO32V2) or defined(MSDOS)} 236type 237 tdosheader = packed record 238 e_magic : word; 239 e_cblp : word; 240 e_cp : word; 241 e_crlc : word; 242 e_cparhdr : word; 243 e_minalloc : word; 244 e_maxalloc : word; 245 e_ss : word; 246 e_sp : word; 247 e_csum : word; 248 e_ip : word; 249 e_cs : word; 250 e_lfarlc : word; 251 e_ovno : word; 252 e_res : array[0..3] of word; 253 e_oemid : word; 254 e_oeminfo : word; 255 e_res2 : array[0..9] of word; 256 e_lfanew : longint; 257 end; 258{$endif EMX or PE32 or PE32PLUS or GO32v2} 259 260 261{**************************************************************************** 262 NLM 263****************************************************************************} 264 265{$ifdef netware} 266 267function getByte(var f:file):byte; 268 begin 269 BlockRead (f,getByte,1); 270 end; 271 272 procedure Skip (var f:file; bytes : longint); 273 var i : longint; 274 begin 275 for i := 1 to bytes do getbyte(f); 276 end; 277 278 function get0String (var f:file) : string; 279 var c : char; 280 begin 281 get0String := ''; 282 c := char (getbyte(f)); 283 while (c <> #0) do 284 begin 285 get0String := get0String + c; 286 c := char (getbyte(f)); 287 end; 288 end; 289 290 function getint32 (var f:file): longint; 291 begin 292 blockread (F, getint32, 4); 293 end; 294 295 296const SIZE_OF_NLM_INTERNAL_FIXED_HEADER = 130; 297 SIZE_OF_NLM_INTERNAL_VERSION_HEADER = 32; 298 SIZE_OF_NLM_INTERNAL_EXTENDED_HEADER = 124; 299 300function openNetwareNLM(var e:TExeFile):boolean; 301var valid : boolean; 302 name : string; 303 hdrLength, 304 dataOffset, 305 dataLength : longint; 306 307 308 function getLString : String; 309 var Res:string; 310 begin 311 blockread (e.F, res, 1); 312 if length (res) > 0 THEN 313 blockread (e.F, res[1], length (res)); 314 getbyte(e.f); 315 getLString := res; 316 end; 317 318 function getFixString (Len : byte) : string; 319 var i : byte; 320 begin 321 getFixString := ''; 322 for I := 1 to Len do 323 getFixString := getFixString + char (getbyte(e.f)); 324 end; 325 326 327 function getword : word; 328 begin 329 blockread (e.F, getword, 2); 330 end; 331 332 333 334begin 335 e.sechdrofs := 0; 336 openNetwareNLM:=false; 337 338 // read and check header 339 Skip (e.f,SIZE_OF_NLM_INTERNAL_FIXED_HEADER); 340 getLString; // NLM Description 341 getInt32(e.f); // Stacksize 342 getInt32(e.f); // Reserved 343 skip(e.f,5); // old Thread Name 344 getLString; // Screen Name 345 getLString; // Thread Name 346 hdrLength := -1; 347 dataOffset := -1; 348 dataLength := -1; 349 valid := true; 350 repeat 351 name := getFixString (8); 352 if (name = 'VeRsIoN#') then 353 begin 354 Skip (e.f,SIZE_OF_NLM_INTERNAL_VERSION_HEADER-8); 355 end else 356 if (name = 'CoPyRiGh') then 357 begin 358 getword; // T= 359 getLString; // Copyright String 360 end else 361 if (name = 'MeSsAgEs') then 362 begin 363 skip (e.f,SIZE_OF_NLM_INTERNAL_EXTENDED_HEADER - 8); 364 end else 365 if (name = 'CuStHeAd') then 366 begin 367 hdrLength := getInt32(e.f); 368 dataOffset := getInt32(e.f); 369 dataLength := getInt32(e.f); 370 Skip (e.f,8); // dateStamp 371 Valid := false; 372 end else 373 Valid := false; 374 until not valid; 375 if (hdrLength = -1) or (dataOffset = -1) or (dataLength = -1) then 376 exit; 377 378 Seek (e.F, dataOffset); 379 e.sechdrofs := dataOffset; 380 openNetwareNLM := (e.sechdrofs > 0); 381end; 382 383function FindSectionNetwareNLM(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean; 384var name : string; 385 alignAmount : longint; 386begin 387 seek(e.f,e.sechdrofs); 388 (* The format of the section information is: 389 null terminated section name 390 zeroes to adjust to 4 byte boundary 391 4 byte section data file pointer 392 4 byte section size *) 393 Repeat 394 Name := Get0String(e.f); 395 alignAmount := 4 - ((length (Name) + 1) MOD 4); 396 Skip (e.f,AlignAmount); 397 if (Name = asecname) then 398 begin 399 secOfs := getInt32(e.f); 400 secLen := getInt32(e.f); 401 end else 402 Skip(e.f,8); 403 until (Name = '') or (Name = asecname); 404 FindSectionNetwareNLM := (Name=asecname); 405end; 406 407{$endif} 408 409 410{**************************************************************************** 411 COFF 412****************************************************************************} 413 414{$if defined(PE32) or defined(PE32PLUS) or defined(GO32V2)} 415type 416 tcoffsechdr=packed record 417 name : array[0..7] of char; 418 vsize : longint; 419 rvaofs : longint; 420 datalen : longint; 421 datapos : longint; 422 relocpos : longint; 423 lineno1 : longint; 424 nrelocs : word; 425 lineno2 : word; 426 flags : longint; 427 end; 428 coffsymbol=packed record 429 name : array[0..3] of char; { real is [0..7], which overlaps the strofs ! } 430 strofs : longint; 431 value : longint; 432 section : smallint; 433 empty : word; 434 typ : byte; 435 aux : byte; 436 end; 437 438function FindSectionCoff(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean; 439var 440 i : longint; 441 sechdr : tcoffsechdr; 442 secname : string; 443 secnamebuf : array[0..255] of char; 444 code, 445 oldofs, 446 bufsize : longint; 447 strofs : cardinal; 448begin 449 FindSectionCoff:=false; 450 { read section info } 451 seek(e.f,e.sechdrofs); 452 for i:=1 to e.nsects do 453 begin 454 blockread(e.f,sechdr,sizeof(sechdr),bufsize); 455 move(sechdr.name,secnamebuf,8); 456 secnamebuf[8]:=#0; 457 secname:=strpas(secnamebuf); 458 if secname[1]='/' then 459 begin 460 Val(Copy(secname,2,8),strofs,code); 461 if code=0 then 462 begin 463 fillchar(secnamebuf,sizeof(secnamebuf),0); 464 oldofs:=filepos(e.f); 465 seek(e.f,e.secstrofs+strofs); 466 blockread(e.f,secnamebuf,sizeof(secnamebuf),bufsize); 467 seek(e.f,oldofs); 468 secname:=strpas(secnamebuf); 469 end 470 else 471 secname:=''; 472 end; 473 if asecname=secname then 474 begin 475 secofs:=cardinal(sechdr.datapos) + E.ImgOffset; 476{$ifdef GO32V2} 477 seclen:=sechdr.datalen; 478{$else GO32V2} 479 { In PECOFF, datalen includes file padding up to the next section. 480 vsize is the actual payload size if it does not exceed datalen, 481 otherwise it is .bss (or alike) section that we should ignore. } 482 if sechdr.vsize<=sechdr.datalen then 483 seclen:=sechdr.vsize 484 else 485 exit; 486{$endif GO32V2} 487 FindSectionCoff:=true; 488 exit; 489 end; 490 end; 491end; 492{$endif PE32 or PE32PLUS or GO32V2} 493 494 495{$ifdef go32v2} 496function OpenGo32Coff(var e:TExeFile):boolean; 497type 498 tgo32coffheader=packed record 499 mach : word; 500 nsects : word; 501 time : longint; 502 sympos : longint; 503 syms : longint; 504 opthdr : word; 505 flag : word; 506 other : array[0..27] of byte; 507 end; 508const 509 ParagraphSize = 512; 510var 511 coffheader : tgo32coffheader; 512 DosHeader: TDosHeader; 513 BRead: cardinal; 514begin 515 OpenGo32Coff:=false; 516 { read and check header } 517 if E.Size < SizeOf (DosHeader) then 518 Exit; 519 BlockRead (E.F, DosHeader, SizeOf (DosHeader), BRead); 520 if BRead <> SizeOf (DosHeader) then 521 Exit; 522 if DosHeader.E_Magic = $5A4D then 523 begin 524 E.ImgOffset := DosHeader.e_cp * ParagraphSize; 525 if DosHeader.e_cblp > 0 then 526 E.ImgOffset := E.ImgOffset + DosHeader.e_cblp - ParagraphSize; 527 end; 528 if e.size < E.ImgOffset + sizeof(coffheader) then 529 exit; 530 seek(e.f,E.ImgOffset); 531 blockread(e.f,coffheader,sizeof(coffheader)); 532 if coffheader.mach<>$14c then 533 exit; 534 e.sechdrofs:=filepos(e.f); 535 e.nsects:=coffheader.nsects; 536 e.secstrofs:=coffheader.sympos+coffheader.syms*sizeof(coffsymbol)+4; 537 if e.secstrofs>e.size then 538 exit; 539 OpenGo32Coff:=true; 540end; 541{$endif Go32v2} 542 543 544{$ifdef PE32} 545function OpenPeCoff(var e:TExeFile):boolean; 546type 547 tpeheader = packed record 548 PEMagic : longint; 549 Machine : word; 550 NumberOfSections : word; 551 TimeDateStamp : longint; 552 PointerToSymbolTable : longint; 553 NumberOfSymbols : longint; 554 SizeOfOptionalHeader : word; 555 Characteristics : word; 556 Magic : word; 557 MajorLinkerVersion : byte; 558 MinorLinkerVersion : byte; 559 SizeOfCode : longint; 560 SizeOfInitializedData : longint; 561 SizeOfUninitializedData : longint; 562 AddressOfEntryPoint : longint; 563 BaseOfCode : longint; 564 BaseOfData : longint; 565 ImageBase : longint; 566 SectionAlignment : longint; 567 FileAlignment : longint; 568 MajorOperatingSystemVersion : word; 569 MinorOperatingSystemVersion : word; 570 MajorImageVersion : word; 571 MinorImageVersion : word; 572 MajorSubsystemVersion : word; 573 MinorSubsystemVersion : word; 574 Reserved1 : longint; 575 SizeOfImage : longint; 576 SizeOfHeaders : longint; 577 CheckSum : longint; 578 Subsystem : word; 579 DllCharacteristics : word; 580 SizeOfStackReserve : longint; 581 SizeOfStackCommit : longint; 582 SizeOfHeapReserve : longint; 583 SizeOfHeapCommit : longint; 584 LoaderFlags : longint; 585 NumberOfRvaAndSizes : longint; 586 DataDirectory : array[1..$80] of byte; 587 end; 588var 589 dosheader : tdosheader; 590 peheader : tpeheader; 591begin 592 OpenPeCoff:=false; 593 { read and check header } 594 if e.size<sizeof(dosheader) then 595 exit; 596 blockread(e.f,dosheader,sizeof(tdosheader)); 597 seek(e.f,dosheader.e_lfanew); 598 blockread(e.f,peheader,sizeof(tpeheader)); 599 if peheader.pemagic<>$4550 then 600 exit; 601 e.sechdrofs:=filepos(e.f); 602 e.nsects:=peheader.NumberOfSections; 603 e.secstrofs:=peheader.PointerToSymbolTable+peheader.NumberOfSymbols*sizeof(coffsymbol); 604 if e.secstrofs>e.size then 605 exit; 606 e.processaddress:=peheader.ImageBase; 607 OpenPeCoff:=true; 608end; 609{$endif PE32} 610 611 612{$ifdef PE32PLUS} 613function OpenPePlusCoff(var e:TExeFile):boolean; 614type 615 tpeheader = packed record 616 PEMagic : longint; 617 Machine : word; 618 NumberOfSections : word; 619 TimeDateStamp : longint; 620 PointerToSymbolTable : longint; 621 NumberOfSymbols : longint; 622 SizeOfOptionalHeader : word; 623 Characteristics : word; 624 Magic : word; 625 MajorLinkerVersion : byte; 626 MinorLinkerVersion : byte; 627 SizeOfCode : longint; 628 SizeOfInitializedData : longint; 629 SizeOfUninitializedData : longint; 630 AddressOfEntryPoint : longint; 631 BaseOfCode : longint; 632 ImageBase : qword; 633 SectionAlignment : longint; 634 FileAlignment : longint; 635 MajorOperatingSystemVersion : word; 636 MinorOperatingSystemVersion : word; 637 MajorImageVersion : word; 638 MinorImageVersion : word; 639 MajorSubsystemVersion : word; 640 MinorSubsystemVersion : word; 641 Reserved1 : longint; 642 SizeOfImage : longint; 643 SizeOfHeaders : longint; 644 CheckSum : longint; 645 Subsystem : word; 646 DllCharacteristics : word; 647 SizeOfStackReserve : qword; 648 SizeOfStackCommit : qword; 649 SizeOfHeapReserve : qword; 650 SizeOfHeapCommit : qword; 651 LoaderFlags : longint; 652 NumberOfRvaAndSizes : longint; 653 DataDirectory : array[1..$80] of byte; 654 end; 655var 656 dosheader : tdosheader; 657 peheader : tpeheader; 658begin 659 OpenPePlusCoff:=false; 660 { read and check header } 661 if E.Size<sizeof(dosheader) then 662 exit; 663 blockread(E.F,dosheader,sizeof(tdosheader)); 664 seek(E.F,dosheader.e_lfanew); 665 blockread(E.F,peheader,sizeof(tpeheader)); 666 if peheader.pemagic<>$4550 then 667 exit; 668 e.sechdrofs:=filepos(e.f); 669 e.nsects:=peheader.NumberOfSections; 670 e.secstrofs:=peheader.PointerToSymbolTable+peheader.NumberOfSymbols*sizeof(coffsymbol); 671 if e.secstrofs>e.size then 672 exit; 673 e.processaddress:=peheader.ImageBase; 674 OpenPePlusCoff:=true; 675end; 676{$endif PE32PLUS} 677 678 679{**************************************************************************** 680 AOUT 681****************************************************************************} 682 683{$IFDEF EMX} 684type 685 TEmxHeader = packed record 686 Version: array [1..16] of char; 687 Bound: word; 688 AoutOfs: longint; 689 Options: array [1..42] of char; 690 end; 691 692 TAoutHeader = packed record 693 Magic: word; 694 Machine: byte; 695 Flags: byte; 696 TextSize: longint; 697 DataSize: longint; 698 BssSize: longint; 699 SymbSize: longint; 700 EntryPoint: longint; 701 TextRelocSize: longint; 702 DataRelocSize: longint; 703 end; 704 705const 706 PageSizeFill = $FFF; 707 708var 709 DosHeader: TDosHeader; 710 EmxHeader: TEmxHeader; 711 AoutHeader: TAoutHeader; 712 StabOfs: PtrUInt; 713 S4: string [4]; 714 715function OpenEMXaout (var E: TExeFile): boolean; 716begin 717 OpenEMXaout := false; 718{ GDB after 4.18 uses offset to function begin 719 in text section but OS/2 version still uses 4.16 PM } 720 E.FunctionRelative := false; 721{ read and check header } 722 if E.Size > SizeOf (DosHeader) then 723 begin 724 BlockRead (E.F, DosHeader, SizeOf (TDosHeader)); 725{$IFDEF DEBUG_LINEINFO} 726 WriteLn (StdErr, 'DosHeader.E_CParHdr = ', DosHeader.E_cParHdr); 727{$ENDIF DEBUG_LINEINFO} 728 if E.Size > DosHeader.e_cparhdr shl 4 + SizeOf (TEmxHeader) then 729 begin 730 Seek (E.F, DosHeader.e_cparhdr shl 4); 731 BlockRead (E.F, EmxHeader, SizeOf (TEmxHeader)); 732 S4 [0] := #4; 733 Move (EmxHeader.Version, S4 [1], 4); 734 if (S4 = 'emx ') and 735 (E.Size > EmxHeader.AoutOfs + SizeOf (TAoutHeader)) then 736 begin 737{$IFDEF DEBUG_LINEINFO} 738 WriteLn (StdErr, 'EmxHeader.AoutOfs = ', EmxHeader.AoutOfs, '/', HexStr (pointer (EmxHeader.AoutOfs))); 739{$ENDIF DEBUG_LINEINFO} 740 Seek (E.F, EmxHeader.AoutOfs); 741 BlockRead (E.F, AoutHeader, SizeOf (TAoutHeader)); 742{$IFDEF DEBUG_LINEINFO} 743 WriteLn (StdErr, 'AoutHeader.Magic = ', AoutHeader.Magic); 744{$ENDIF DEBUG_LINEINFO} 745{ if AOutHeader.Magic = $10B then} 746 StabOfs := (EmxHeader.AoutOfs or PageSizeFill) + 1 747 + AoutHeader.TextSize 748 + AoutHeader.DataSize 749 + AoutHeader.TextRelocSize 750 + AoutHeader.DataRelocSize; 751{$IFDEF DEBUG_LINEINFO} 752 WriteLn (StdErr, 'AoutHeader.TextSize = ', AoutHeader.TextSize, '/', HexStr (pointer (AoutHeader.TextSize))); 753 WriteLn (StdErr, 'AoutHeader.DataSize = ', AoutHeader.DataSize, '/', HexStr (pointer (AoutHeader.DataSize))); 754 WriteLn (StdErr, 'AoutHeader.TextRelocSize = ', AoutHeader.TextRelocSize, '/', HexStr (pointer (AoutHeader.TextRelocSize))); 755 WriteLn (StdErr, 'AoutHeader.DataRelocSize = ', AoutHeader.DataRelocSize, '/', HexStr (pointer (AoutHeader.DataRelocSize))); 756 WriteLn (StdErr, 'AoutHeader.SymbSize = ', AoutHeader.SymbSize, '/', HexStr (pointer (AoutHeader.SymbSize))); 757 WriteLn (StdErr, 'StabOfs = ', StabOfs, '/', HexStr (pointer (StabOfs))); 758{$ENDIF DEBUG_LINEINFO} 759 if E.Size > StabOfs + AoutHeader.SymbSize then 760 OpenEMXaout := true; 761 end; 762 end; 763 end; 764end; 765 766 767function FindSectionEMXaout (var E: TExeFile; const ASecName: string; 768 var SecOfs, SecLen: longint): boolean; 769begin 770 FindSectionEMXaout := false; 771 if ASecName = '.stab' then 772 begin 773 SecOfs := StabOfs; 774 SecLen := AoutHeader.SymbSize; 775 FindSectionEMXaout := true; 776 end else 777 if ASecName = '.stabstr' then 778 begin 779 SecOfs := StabOfs + AoutHeader.SymbSize; 780 SecLen := E.Size - Pred (SecOfs); 781 FindSectionEMXaout := true; 782 end; 783end; 784{$ENDIF EMX} 785 786 787{**************************************************************************** 788 ELF 789****************************************************************************} 790 791{$if defined(ELF32)} 792type 793 telfheader=packed record 794 magic0123 : longint; 795 file_class : byte; 796 data_encoding : byte; 797 file_version : byte; 798 padding : array[$07..$0f] of byte; 799 e_type : word; 800 e_machine : word; 801 e_version : longword; 802 e_entry : longword; // entrypoint 803 e_phoff : longword; // program header offset 804 e_shoff : longword; // sections header offset 805 e_flags : longword; 806 e_ehsize : word; // elf header size in bytes 807 e_phentsize : word; // size of an entry in the program header array 808 e_phnum : word; // 0..e_phnum-1 of entrys 809 e_shentsize : word; // size of an entry in sections header array 810 e_shnum : word; // 0..e_shnum-1 of entrys 811 e_shstrndx : word; // index of string section header 812 end; 813 telfsechdr=packed record 814 sh_name : longword; 815 sh_type : longword; 816 sh_flags : longword; 817 sh_addr : longword; 818 sh_offset : longword; 819 sh_size : longword; 820 sh_link : longword; 821 sh_info : longword; 822 sh_addralign : longword; 823 sh_entsize : longword; 824 end; 825 telfproghdr=packed record 826 p_type : longword; 827 p_offset : longword; 828 p_vaddr : longword; 829 p_paddr : longword; 830 p_filesz : longword; 831 p_memsz : longword; 832 p_flags : longword; 833 p_align : longword; 834 end; 835{$endif ELF32} 836{$ifdef ELF64} 837type 838 telfheader=packed record 839 magic0123 : longint; 840 file_class : byte; 841 data_encoding : byte; 842 file_version : byte; 843 padding : array[$07..$0f] of byte; 844 e_type : word; 845 e_machine : word; 846 e_version : longword; 847 e_entry : int64; // entrypoint 848 e_phoff : int64; // program header offset 849 e_shoff : int64; // sections header offset 850 e_flags : longword; 851 e_ehsize : word; // elf header size in bytes 852 e_phentsize : word; // size of an entry in the program header array 853 e_phnum : word; // 0..e_phnum-1 of entrys 854 e_shentsize : word; // size of an entry in sections header array 855 e_shnum : word; // 0..e_shnum-1 of entrys 856 e_shstrndx : word; // index of string section header 857 end; 858type 859 telfsechdr=packed record 860 sh_name : longword; 861 sh_type : longword; 862 sh_flags : int64; 863 sh_addr : int64; 864 sh_offset : int64; 865 sh_size : int64; 866 sh_link : longword; 867 sh_info : longword; 868 sh_addralign : int64; 869 sh_entsize : int64; 870 end; 871 872 telfproghdr=packed record 873 p_type : longword; 874 p_flags : longword; 875 p_offset : qword; 876 p_vaddr : qword; 877 p_paddr : qword; 878 p_filesz : qword; 879 p_memsz : qword; 880 p_align : qword; 881 end; 882{$endif ELF64} 883 884 885{$if defined(ELF32) or defined(ELF64)} 886 887{$ifdef FIND_BASEADDR_ELF} 888var 889 LocalJmpBuf : Jmp_Buf; 890procedure LocalError; 891begin 892 Longjmp(LocalJmpBuf,1); 893end; 894 895procedure GetExeInMemoryBaseAddr(addr : pointer; var BaseAddr : pointer; 896 var filename : openstring); 897type 898 AT_HDR = record 899 typ : ptruint; 900 value : ptruint; 901 end; 902 P_AT_HDR = ^AT_HDR; 903 904{ Values taken from /usr/include/linux/auxvec.h } 905const 906 AT_HDR_COUNT = 5;{ AT_PHNUM } 907 AT_HDR_SIZE = 4; { AT_PHENT } 908 AT_HDR_Addr = 3; { AT_PHDR } 909 AT_EXE_FN = 31; {AT_EXECFN } 910 911var 912 pc : ppchar; 913 pat_hdr : P_AT_HDR; 914 i, phdr_count : ptrint; 915 phdr_size : ptruint; 916 phdr : ^telfproghdr; 917 found_addr : ptruint; 918 SavedExitProc : pointer; 919begin 920 filename:=ParamStr(0); 921 SavedExitProc:=ExitProc; 922 ExitProc:=@LocalError; 923 if SetJmp(LocalJmpBuf)=0 then 924 begin 925 { Try, avoided in order to remove exception installation } 926 pc:=envp; 927 phdr_count:=-1; 928 phdr_size:=0; 929 phdr:=nil; 930 found_addr:=ptruint(-1); 931 while (assigned(pc^)) do 932 inc (pointer(pc), sizeof(ptruint)); 933 inc(pointer(pc), sizeof(ptruint)); 934 pat_hdr:=P_AT_HDR(pc); 935 while assigned(pat_hdr) do 936 begin 937 if (pat_hdr^.typ=0) and (pat_hdr^.value=0) then 938 break; 939 if pat_hdr^.typ = AT_HDR_COUNT then 940 phdr_count:=pat_hdr^.value; 941 if pat_hdr^.typ = AT_HDR_SIZE then 942 phdr_size:=pat_hdr^.value; 943 if pat_hdr^.typ = AT_HDR_Addr then 944 phdr := pointer(pat_hdr^.value); 945 if pat_hdr^.typ = AT_EXE_FN then 946 filename:=strpas(pchar(pat_hdr^.value)); 947 inc (pointer(pat_hdr),sizeof(AT_HDR)); 948 end; 949 if (phdr_count>0) and (phdr_size = sizeof (telfproghdr)) 950 and assigned(phdr) then 951 begin 952 for i:=0 to phdr_count -1 do 953 begin 954 if (phdr^.p_type = 1 {PT_LOAD}) and (ptruint(phdr^.p_vaddr) < found_addr) then 955 found_addr:=phdr^.p_vaddr; 956 inc(pointer(phdr), phdr_size); 957 end; 958 {$ifdef DEBUG_LINEINFO} 959 end 960 else 961 begin 962 if (phdr_count=-1) then 963 writeln(stderr,'AUX entry AT_PHNUM not found'); 964 if (phdr_size=0) then 965 writeln(stderr,'AUX entry AT_PHENT not found'); 966 if (phdr=nil) then 967 writeln(stderr,'AUX entry AT_PHDR not found'); 968 {$endif DEBUG_LINEINFO} 969 end; 970 971 if found_addr<>ptruint(-1) then 972 begin 973 {$ifdef DEBUG_LINEINFO} 974 Writeln(stderr,'Found addr = $',hexstr(found_addr,2 * sizeof(ptruint))); 975 {$endif} 976 BaseAddr:=pointer(found_addr); 977 end 978 {$ifdef DEBUG_LINEINFO} 979 else 980 writeln(stderr,'Error parsing stack'); 981 {$endif DEBUG_LINEINFO} 982 end 983 else 984 begin 985 {$ifdef DEBUG_LINEINFO} 986 writeln(stderr,'Exception parsing stack'); 987 {$endif DEBUG_LINEINFO} 988 end; 989 ExitProc:=SavedExitProc; 990end; 991{$endif FIND_BASEADDR_ELF} 992 993function OpenElf(var e:TExeFile):boolean; 994{$ifdef MSDOS} 995const 996 ParagraphSize = 512; 997{$endif MSDOS} 998var 999 elfheader : telfheader; 1000 elfsec : telfsechdr; 1001 phdr : telfproghdr; 1002 i : longint; 1003{$ifdef MSDOS} 1004 DosHeader : tdosheader; 1005 BRead : cardinal; 1006{$endif MSDOS} 1007begin 1008 OpenElf:=false; 1009{$ifdef MSDOS} 1010 { read and check header } 1011 if E.Size < SizeOf (DosHeader) then 1012 Exit; 1013 BlockRead (E.F, DosHeader, SizeOf (DosHeader), BRead); 1014 if BRead <> SizeOf (DosHeader) then 1015 Exit; 1016 if DosHeader.E_Magic = $5A4D then 1017 begin 1018 E.ImgOffset := LongWord(DosHeader.e_cp) * ParagraphSize; 1019 if DosHeader.e_cblp > 0 then 1020 E.ImgOffset := E.ImgOffset + DosHeader.e_cblp - ParagraphSize; 1021 end; 1022{$endif MSDOS} 1023 { read and check header } 1024 if e.size<(sizeof(telfheader)+e.ImgOffset) then 1025 exit; 1026 seek(e.f,e.ImgOffset); 1027 blockread(e.f,elfheader,sizeof(telfheader)); 1028 if elfheader.magic0123<>{$ifdef ENDIAN_LITTLE}$464c457f{$else}$7f454c46{$endif} then 1029 exit; 1030 if elfheader.e_shentsize<>sizeof(telfsechdr) then 1031 exit; 1032 { read section names } 1033 seek(e.f,e.ImgOffset+elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telfsechdr))); 1034 blockread(e.f,elfsec,sizeof(telfsechdr)); 1035 e.secstrofs:=elfsec.sh_offset; 1036 e.sechdrofs:=elfheader.e_shoff; 1037 e.nsects:=elfheader.e_shnum; 1038 1039{$ifdef MSDOS} 1040 { e.processaddress is already initialized to 0 } 1041 e.processsegment:=PrefixSeg+16; 1042{$else MSDOS} 1043 { scan program headers to find the image base address } 1044 e.processaddress:=High(e.processaddress); 1045 seek(e.f,e.ImgOffset+elfheader.e_phoff); 1046 for i:=1 to elfheader.e_phnum do 1047 begin 1048 blockread(e.f,phdr,sizeof(phdr)); 1049 if (phdr.p_type = 1 {PT_LOAD}) and (ptruint(phdr.p_vaddr) < e.processaddress) then 1050 e.processaddress:=phdr.p_vaddr; 1051 end; 1052 1053 if e.processaddress = High(e.processaddress) then 1054 e.processaddress:=0; 1055{$endif MSDOS} 1056 1057 OpenElf:=true; 1058end; 1059 1060 1061function FindSectionElf(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean; 1062var 1063 elfsec : telfsechdr; 1064 secname : string; 1065 secnamebuf : array[0..255] of char; 1066 oldofs, 1067 bufsize,i : longint; 1068begin 1069 FindSectionElf:=false; 1070 seek(e.f,e.ImgOffset+e.sechdrofs); 1071 for i:=1 to e.nsects do 1072 begin 1073 blockread(e.f,elfsec,sizeof(telfsechdr)); 1074 fillchar(secnamebuf,sizeof(secnamebuf),0); 1075 oldofs:=filepos(e.f); 1076 seek(e.f,e.ImgOffset+e.secstrofs+elfsec.sh_name); 1077 blockread(e.f,secnamebuf,sizeof(secnamebuf)-1,bufsize); 1078 seek(e.f,oldofs); 1079 secname:=strpas(secnamebuf); 1080 if asecname=secname then 1081 begin 1082 secofs:=e.ImgOffset+elfsec.sh_offset; 1083 seclen:=elfsec.sh_size; 1084 FindSectionElf:=true; 1085 exit; 1086 end; 1087 end; 1088end; 1089{$endif ELF32 or ELF64} 1090 1091 1092{**************************************************************************** 1093 MACHO 1094****************************************************************************} 1095 1096{$ifdef darwin} 1097type 1098 MachoFatHeader= packed record 1099 magic: longint; 1100 nfatarch: longint; 1101 end; 1102 MachoHeader=packed record 1103 magic: longword; 1104 cpu_type_t: longint; 1105 cpu_subtype_t: longint; 1106 filetype: longint; 1107 ncmds: longint; 1108 sizeofcmds: longint; 1109 flags: longint; 1110 end; 1111 cmdblock=packed record 1112 cmd: longint; 1113 cmdsize: longint; 1114 end; 1115 symbSeg=packed record 1116 symoff : longint; 1117 nsyms : longint; 1118 stroff : longint; 1119 strsize: longint; 1120 end; 1121 tstab=packed record 1122 strpos : longint; 1123 ntype : byte; 1124 nother : byte; 1125 ndesc : word; 1126 nvalue : dword; 1127 end; 1128 1129 1130function OpenMachO32PPC(var e:TExeFile):boolean; 1131var 1132 mh:MachoHeader; 1133begin 1134 OpenMachO32PPC:= false; 1135 E.FunctionRelative:=false; 1136 if e.size<sizeof(mh) then 1137 exit; 1138 blockread (e.f, mh, sizeof(mh)); 1139 e.sechdrofs:=filepos(e.f); 1140 e.nsects:=mh.ncmds; 1141 OpenMachO32PPC:=true; 1142end; 1143 1144 1145function FindSectionMachO32PPC(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean; 1146var 1147 i: longint; 1148 block:cmdblock; 1149 symbolsSeg: symbSeg; 1150begin 1151 FindSectionMachO32PPC:=false; 1152 seek(e.f,e.sechdrofs); 1153 for i:= 1 to e.nsects do 1154 begin 1155 {$I-} 1156 blockread (e.f, block, sizeof(block)); 1157 {$I+} 1158 if IOResult <> 0 then 1159 Exit; 1160 if block.cmd = $2 then 1161 begin 1162 blockread (e.f, symbolsSeg, sizeof(symbolsSeg)); 1163 if asecname='.stab' then 1164 begin 1165 secofs:=symbolsSeg.symoff; 1166 { the caller will divide again by sizeof(tstab) } 1167 seclen:=symbolsSeg.nsyms*sizeof(tstab); 1168 FindSectionMachO32PPC:=true; 1169 end 1170 else if asecname='.stabstr' then 1171 begin 1172 secofs:=symbolsSeg.stroff; 1173 seclen:=symbolsSeg.strsize; 1174 FindSectionMachO32PPC:=true; 1175 end; 1176 exit; 1177 end; 1178 Seek(e.f, FilePos (e.f) + block.cmdsize - sizeof(block)); 1179 end; 1180end; 1181{$endif darwin} 1182 1183 1184{**************************************************************************** 1185 CRC 1186****************************************************************************} 1187 1188var 1189 Crc32Tbl : array[0..255] of cardinal; 1190 1191procedure MakeCRC32Tbl; 1192var 1193 crc : cardinal; 1194 i,n : integer; 1195begin 1196 for i:=0 to 255 do 1197 begin 1198 crc:=i; 1199 for n:=1 to 8 do 1200 if (crc and 1)<>0 then 1201 crc:=(crc shr 1) xor cardinal($edb88320) 1202 else 1203 crc:=crc shr 1; 1204 Crc32Tbl[i]:=crc; 1205 end; 1206end; 1207 1208 1209Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:LongInt):cardinal; 1210var 1211 i : LongInt; 1212 p : pchar; 1213begin 1214 if Crc32Tbl[1]=0 then 1215 MakeCrc32Tbl; 1216 p:=@InBuf; 1217 UpdateCrc32:=not InitCrc; 1218 for i:=1 to InLen do 1219 begin 1220 UpdateCrc32:=Crc32Tbl[byte(UpdateCrc32) xor byte(p^)] xor (UpdateCrc32 shr 8); 1221 inc(p); 1222 end; 1223 UpdateCrc32:=not UpdateCrc32; 1224end; 1225 1226 1227{**************************************************************************** 1228 Generic Executable Open/Close 1229****************************************************************************} 1230 1231type 1232 TOpenProc=function(var e:TExeFile):boolean; 1233 TFindSectionProc=function(var e:TExeFile;const asecname:string;var secofs,seclen:longint):boolean; 1234 1235 TExeProcRec=record 1236 openproc : TOpenProc; 1237 findproc : TFindSectionProc; 1238 end; 1239 1240const 1241 ExeProcs : TExeProcRec = ( 1242{$ifdef go32v2} 1243 openproc : @OpenGo32Coff; 1244 findproc : @FindSectionCoff; 1245{$endif} 1246{$ifdef PE32} 1247 openproc : @OpenPeCoff; 1248 findproc : @FindSectionCoff; 1249{$endif} 1250{$ifdef PE32PLUS} 1251 openproc : @OpenPePlusCoff; 1252 findproc : @FindSectionCoff; 1253{$endif PE32PLUS} 1254{$if defined(ELF32) or defined(ELF64)} 1255 openproc : @OpenElf; 1256 findproc : @FindSectionElf; 1257{$endif ELF32 or ELF64} 1258{$ifdef darwin} 1259 openproc : @OpenMachO32PPC; 1260 findproc : @FindSectionMachO32PPC; 1261{$endif darwin} 1262{$IFDEF EMX} 1263 openproc : @OpenEMXaout; 1264 findproc : @FindSectionEMXaout; 1265{$ENDIF EMX} 1266{$ifdef netware} 1267 openproc : @OpenNetwareNLM; 1268 findproc : @FindSectionNetwareNLM; 1269{$endif} 1270 ); 1271 1272function OpenExeFile(var e:TExeFile;const fn:string):boolean; 1273var 1274 ofm : word; 1275begin 1276 OpenExeFile:=false; 1277 fillchar(e,sizeof(e),0); 1278 e.bufsize:=sizeof(e.buf); 1279 e.filename:=fn; 1280 if fn='' then // we don't want to read stdin 1281 exit; 1282 assign(e.f,fn); 1283 {$I-} 1284 ofm:=filemode; 1285 filemode:=$40; 1286 reset(e.f,1); 1287 filemode:=ofm; 1288 {$I+} 1289 if ioresult<>0 then 1290 exit; 1291 e.isopen:=true; 1292 // cache filesize 1293 e.size:=filesize(e.f); 1294 1295 E.FunctionRelative := true; 1296 E.ImgOffset := 0; 1297 if ExeProcs.OpenProc<>nil then 1298 OpenExeFile:=ExeProcs.OpenProc(e); 1299end; 1300 1301 1302function CloseExeFile(var e:TExeFile):boolean; 1303begin 1304 CloseExeFile:=false; 1305 if not e.isopen then 1306 exit; 1307 e.isopen:=false; 1308 close(e.f); 1309 CloseExeFile:=true; 1310end; 1311 1312 1313function FindExeSection(var e:TExeFile;const secname:string;var secofs,seclen:longint):boolean; 1314begin 1315 FindExeSection:=false; 1316 if not e.isopen then 1317 exit; 1318 if ExeProcs.FindProc<>nil then 1319 FindExeSection:=ExeProcs.FindProc(e,secname,secofs,seclen); 1320end; 1321 1322 1323 1324function CheckDbgFile(var e:TExeFile;const fn:string;dbgcrc:cardinal):boolean; 1325var 1326 c : cardinal; 1327 ofm : word; 1328 g : file; 1329begin 1330 CheckDbgFile:=false; 1331 assign(g,fn); 1332 {$I-} 1333 ofm:=filemode; 1334 filemode:=$40; 1335 reset(g,1); 1336 filemode:=ofm; 1337 {$I+} 1338 if ioresult<>0 then 1339 exit; 1340 { We reuse the buffer from e here to prevent too much stack allocation } 1341 c:=0; 1342 repeat 1343 blockread(g,e.buf,e.bufsize,e.bufcnt); 1344 c:=UpdateCrc32(c,e.buf,e.bufcnt); 1345 until e.bufcnt<e.bufsize; 1346 close(g); 1347 CheckDbgFile:=(dbgcrc=c); 1348end; 1349 1350 1351function ReadDebugLink(var e:TExeFile;var dbgfn:string):boolean; 1352var 1353 dbglink : array[0..255] of char; 1354 i, 1355 dbglinklen, 1356 dbglinkofs : longint; 1357 dbgcrc : cardinal; 1358begin 1359 ReadDebugLink:=false; 1360 if not FindExeSection(e,'.gnu_debuglink',dbglinkofs,dbglinklen) then 1361 exit; 1362 if dbglinklen>sizeof(dbglink)-1 then 1363 exit; 1364 fillchar(dbglink,sizeof(dbglink),0); 1365 seek(e.f,dbglinkofs); 1366 blockread(e.f,dbglink,dbglinklen); 1367 dbgfn:=strpas(dbglink); 1368 if length(dbgfn)=0 then 1369 exit; 1370 i:=align(length(dbgfn)+1,4); 1371 if (i+4)>dbglinklen then 1372 exit; 1373 move(dbglink[i],dbgcrc,4); 1374 { current dir } 1375 if CheckDbgFile(e,dbgfn,dbgcrc) then 1376 begin 1377 ReadDebugLink:=true; 1378 exit; 1379 end; 1380 { executable dir } 1381 i:=length(e.filename); 1382 while (i>0) and not(e.filename[i] in AllowDirectorySeparators) do 1383 dec(i); 1384 if i>0 then 1385 begin 1386 dbgfn:=copy(e.filename,1,i)+dbgfn; 1387 if CheckDbgFile(e,dbgfn,dbgcrc) then 1388 begin 1389 ReadDebugLink:=true; 1390 exit; 1391 end; 1392 end; 1393end; 1394 1395 1396begin 1397{$ifdef FIND_BASEADDR_ELF} 1398 UnixGetModuleByAddrHook:=@GetExeInMemoryBaseAddr; 1399{$endif FIND_BASEADDR_ELF} 1400end. 1401