freepascal.compiler/utils/fpcres/elfresfix.pas

{ *********************************************************************** }
{                                                                         }
{  elfresfix - Free Pascal Resource to ELF object compiler - fixup tool   }
{  Part of the Free Pascal and CrossFPC distributions                     }
{                                                                         }
{  Copyright (C) 2005 Simon Kissel                                        }
{                                                                         }
{  See the file COPYING.FPC, included in the FPC 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.                   }
{                                                                         }
{ *********************************************************************** }

{
This tool will update the fpc.resptrs section of an ELF executable to point
to the various resource sections in the file. This is done so that the FPC
RTL at runtime is able to get pointers to these sections.

This tool is automatically run on any fpc compiled ELF executable that
contains ELF resources.

fpcresfix builds with Delphi, Kylix and FPC.

Currently this only works on 32Bit targets, but support for 64Bit targets
is in the works. Support for big endian systems is completely missing,
though.
}
{$ifdef fpc}
{$mode objfpc}
{$endif}
{$h+}

unit elfresfix;

interface

uses
  SysUtils, Classes, elfbfd;
  
Type

  TLogEvent = Procedure(Const Msg : String) of object;
  
  { TElfResourceFixer }

  TElfResourceFixer = Class(TObject)
  private
    FFileName: String;
    FOnVerbose: TLogEvent;
    FVerbose: Boolean;
    Procedure DoVerbose(Msg : String);
  public
    Procedure FixFile(AFileName : String);
    Procedure DoFixStream(Stream : TStream); virtual; abstract;
    Property Verbose : Boolean read FVerbose write FVerbose;
    Property FileName : String Read FFileName;
    Property Onverbose : TLogEvent Read FOnVerbose Write FOnVerbose;
  end;
  
  { TElf32ResourceFixer }

  TElf32ResourceFixer = Class(TElfResourceFixer)
    Procedure DoFixStream(Stream : TStream); override;
  end;
  
  { TElf64ResourceFixer }

  TElf64ResourceFixer = Class(TElfResourceFixer)
    Procedure DoFixStream(Stream : TStream); override;
  end;

  EElfResFixError = Class(Exception);

Implementation

ResourceString
  SCheckingHeader           = 'Checking ELF Header... ';
  SReadingSectionHeaders    = 'Reading Section Headers...';
  SHeaderOK                 = 'ELF Header is OK';
  SCheckingHeaderTable      = 'Checking Section Header table...';
  SStrTabFound              = 'Found strtab...';
  SProcessingSection        = 'Processing section: ';
  SUpdatingResptrs          = 'Updating resptrs section...';
  SFileFixed                = 'File fixed successfully!';
  SNothingToFix             = 'There was nothing to fix in this file.';
  
  SErrUnsupportedHeaderSize = 'Unsupported Section Header size.';
  SErrInvalidELFHeader      = 'Not a valid linux ELF binary.';
  SErrResPtrsNotFound       = 'Unable to find resptrs section.';
  
Procedure DoError (Msg : String);

begin
  Raise EElfResFixError.Create(Msg);
end;

Procedure DoErrorFmt (Msg : String; Args : Array of const);

begin
  Raise EElfResFixError.CreateFmt(Msg,Args);
end;

{ TElfResourceFixer }

procedure TElfResourceFixer.DoVerbose(Msg: String);
begin
  If FVerbose and Assigned(FOnVerbose) then
    FOnVerbose(Msg);
end;

procedure TElfResourceFixer.FixFile(AFileName: String);

Var
  F : TStream;

begin
  FFileName:=AFileName;
  F:=TFileStream.Create(AFilename,fmOpenReadWrite or fmShareDenyWrite);
  Try
    DoFixStream(F);
  Finally
    F.Free;
  end;
end;

{ TElf32ResourceFixer }

procedure TElf32ResourceFixer.DoFixStream(Stream: TStream);

var
  ElfHeader:TElf32header;
  ResourceSectionTable: TElf32ResourceSectionTable;
  SectionHeaders: array of TElf32sechdr;

  i:integer;
  sn:string;
  SectionHeaderOffset:integer;
  fixed: boolean;
  strtab:string;
  SectionName: string;
  ResPtrsSection: integer;

begin
  Fixed:=False;
  Stream.Read(ElfHeader,sizeof(TElf32header));
  DoVerbose(SCheckingHeader);
  if (ElfHeader.magic0123<>$464C457F) then
    DoError(SErrInvalidELFheader);
  if ElfHeader.e_shentsize=sizeof(TElf32sechdr) then
    DoVerbose(SHeaderOK)
  else
    DoError(SErrUnSupportedHeaderSize);
  DoVerbose(SReadingSectionHeaders);

  setlength(SectionHeaders,ElfHeader.e_shnum);
  SectionHeaderOffset:=ElfHeader.e_shoff;
  Stream.Position:=SectionHeaderOffset;

  for i:=0 to ElfHeader.e_shnum-1 do
    begin
    Stream.Read(SectionHeaders[i],sizeof(TElf32sechdr));
    end;

  DoVerbose(SCheckingHeaderTable);

  // Get the section header strtab
  i:=ElfHeader.e_shstrndx;
  if SectionHeaders[i].sh_type=SHT_STRTAB then
    begin
    DoVerbose(SStrTabFound);
    // read the strtab
    Stream.Position:=SectionHeaders[i].sh_offset;
    setlength(strtab,SectionHeaders[i].sh_size);
    Stream.Read(strtab[1],SectionHeaders[i].sh_size);
  end
  else
  begin
    writeln('Error: Unable to find strtab.');
    halt(5);
  end;

  ResPtrsSection:=-1;
  ResourceSectionTable.version:=66;

  // Next cycle through all sections to gather pointers to all the resource
  // sections, and note the index of the resptrs section
  for i:=0 to ElfHeader.e_shnum-1 do
    begin
    SectionName:=copy(strtab,SectionHeaders[i].sh_name+1,32);
    SectionName:=copy(SectionName,1,pos(#0,SectionName)-1);
    DoVerbose(SProcessingSection+SectionName);
    sn:=Copy(SectionName,1,4);
    // FPC section ?
    if (sn='fpc.') then
      begin
      sn:=SectionName;
      Delete(SN,1,4);
      if SN='resptrs' then
        begin
        ResPtrsSection:=i;
        end
      else if sn='ressym' then
        begin
        ResourceSectionTable.ressym.ptr:=SectionHeaders[i].sh_addr;
        ResourceSectionTable.ressym.size:=SectionHeaders[i].sh_size;
        end
      else if sn='reshash' then
        begin
        ResourceSectionTable.reshash.ptr:=SectionHeaders[i].sh_addr;
        ResourceSectionTable.reshash.size:=SectionHeaders[i].sh_size;
        ResourceSectionTable.resentries:=SectionHeaders[i].sh_size DIV sizeof(TELF32ResourceInfo);
        end
      else if sn='resdata' then
        begin
        ResourceSectionTable.resdata.ptr:=SectionHeaders[i].sh_addr;
        ResourceSectionTable.resdata.size:=SectionHeaders[i].sh_size;
        end
      else if sn='resspare' then
        begin
        ResourceSectionTable.resspare.ptr:=SectionHeaders[i].sh_addr;
        ResourceSectionTable.resspare.size:=SectionHeaders[i].sh_size;
        end
      else if SectionName='resstr' then
        begin
        ResourceSectionTable.resstr.ptr:=SectionHeaders[i].sh_addr;
        ResourceSectionTable.resstr.size:=SectionHeaders[i].sh_size;
        end;
      end
  end;

  // Ok, we now have pointers to all resource sections and also
  // know the number of resources.
  // Now update the resptrs table
  if ResPtrsSection>-1 then
    begin
    Doverbose(SUpdatingResPtrs);
    Stream.Position:=SectionHeaders[ResPtrsSection].sh_offset;
    Stream.Write(ResourceSectionTable,sizeof(TELF32ResourceSectionTable));
    fixed:=true;
    end
  else
    DoError(SErrREsptrsNotFound);
  if fixed then
    DoVerbose(SFileFixed)
  else
    writeln(SNothingToFix);
end;

{ TElf64ResourceFixer }

procedure TElf64ResourceFixer.DoFixStream(Stream: TStream);
begin
  DoError('64-bit resources not yet supported');
end;

end.