unit TarFile;

interface

uses BinFile, Windows, LinuxFS;

type

{$A-}
  TTarBlock = record
    FileName   : array[1..100] of Char;   //  0    100 bytes  File name ('\0' terminated, 99 maxmum length)
    FileMode   : array[1..8] of Char;     //100      8 bytes  File mode (in octal ascii)
    UID        : array[1..8] of Char;     //108      8 bytes  User ID (in octal ascii)
    GID        : array[1..8] of Char;     //116      8 bytes  Group ID (in octal ascii)
    FileSize   : array[1..12] of Char;    //124     12 bytes  File size (s) (in octal ascii)
    Time       : array[1..12] of Char;    //136     12 bytes  Modify time (in octal ascii)
    Checksum   : array[1..8] of Char;     //148      8 bytes  Header checksum (in octal ascii)
    LinkFlag   : Char;                    //156      1 bytes  Link flag
    LinkName   : array[1..100] of Char;   //157    100 bytes  Linkname ('\0' terminated, 99 maxmum length)
    Magic      : array[1..8] of Char;     //257      8 bytes  Magic ("ustar  \0")
    UserName   : array[1..32] of Char;    //265     32 bytes  User name ('\0' terminated, 31 maxmum length)
    GroupName  : array[1..32] of Char;    //297     32 bytes  Group name ('\0' terminated, 31 maxmum length)
    MajorID    : array[1..8] of Char;     //329      8 bytes  Major device ID (in octal ascii)
    MinorID    : array[1..8] of Char;     //337      8 bytes  Minor device ID (in octal ascii)
    Padding    : array[1..167] of Char;   //345    167 bytes  Padding
//512   (s+p)bytes  File contents (s+p) := (((s) + 511) & ~511), round up to 512 bytes
end;
{$A+}

{Checksum:
int i, sum;
char* header = tar_header_pointer;
sum = 0;
for(i = 0; i < 512; i++)
    sum += 0xFF & header[i];}


///* The linkflag defines the type of file */
const
  LF_OLDNORMAL = #0;       //* Normal disk file, Unix compatible */
  LF_NORMAL    = '0';        //* Normal disk file */
  LF_LINK      = '1';        //* Link to previously dumped file */
  LF_SYMLINK   = '2';        //* Symbolic link */
  LF_CHR       = '3';        //* Character special file */
  LF_BLK       = '4';        //* Block special file */
  LF_DIR       = '5';        //* Directory */
  LF_FIFO      = '6';        //* FIFO special file */
  LF_CONTIG    = '7';        //* Contiguous file */


type
  TTarFile = class
  public
    constructor Create;
    destructor Destroy; override;

    procedure OpenTar(FileName : String);
    procedure DumpFile;

    procedure ExtractArchive(Path : String);
    procedure Extract(Part : TLinuxPartition; INodeNo : DWORD);

    procedure DumpBlock(Block : TTarBlock);

    function OctalToInt(Octal : array of Char) : LongInt;
    function FixPathName(Path : String) : String;

    procedure UnZipFile(GZFile : String; NewFile : String);

  private
    F : TBinaryFile;

    TarFile    : String;
    DeleteFile : Boolean;
  end;


implementation

uses SysUtils, Dialogs, Forms, ex2explore, INode, Blocks;

procedure TTarFile.DumpBlock(Block : TTarBlock);
begin
   Debug('TAR block', DebugHigh);
   Debug('FileName  :' + Block.FileName, DebugHigh);
   Debug('FileMode  :' + Block.FileMode, DebugHigh);
   Debug('UID       :' + Block.UID, DebugHigh);
   Debug('GID       :' + Block.GID, DebugHigh);
   Debug('FileSize  :' + IntToStr(OctalToInt(Block.FileSize)), DebugHigh);
   Debug('Time      :' + Block.Time, DebugHigh);
   Debug('CheckSum  :' + Block.CheckSum, DebugHigh);
   Debug('LinkFlag  :' + Block.LinkFlag, DebugHigh);
   case Block.LinkFlag of
      LF_OLDNORMAL : Debug('Unix compatible file', DebugHigh);
      LF_NORMAL    : Debug('Normal disk file', DebugHigh);
      LF_LINK      : Debug('Link to previously dumped file', DebugHigh);
      LF_SYMLINK   : Debug('Symbolic link', DebugHigh);
      LF_CHR       : Debug('Character special file', DebugHigh);
      LF_BLK       : Debug('Block special file', DebugHigh);
      LF_DIR       : Debug('Directory', DebugHigh);
      LF_FIFO      : Debug('FIFO special file', DebugHigh);
      LF_CONTIG    : Debug('Contiguous file', DebugHigh);
   end;

   Debug('LinkName  :' + Block.LinkName, DebugHigh);
   Debug('Magic     :' + Block.Magic, DebugHigh);
   Debug('UserName  :' + Block.UserName, DebugHigh);
   Debug('GroupName :' + Block.GroupName, DebugHigh);
   Debug('MajorID   :' + Block.MajorID, DebugHigh);
   Debug('MinorID   :' + Block.MinorID, DebugHigh);
end;

constructor TTarFile.Create;
begin
   F := nil;
   DeleteFile := False;
end;

destructor TTarFile.Destroy;
begin
   if Assigned(F) then
   begin
      F.Free;
   end;
   if DeleteFile then
   begin
      SysUtils.DeleteFile(TarFile);
   end;
end;

procedure TTarFile.OpenTar(FileName : String);
var
   p        : integer;

   function AdjustString(S : String) : String;
   var
      i : Integer;
   begin
      for i := 1 to Length(S) do
      begin
         if S[i] = #0 then
         begin
            Result := Copy(S, 1, i - 1);
            break;
         end;
      end;
   end;

   procedure Unzip;
   var
      Path : String;
   begin
      SetLength(Path, 256);
      GetTempPath(256, Pchar(Path));
      Path := AdjustString(Path);
      TarFile := Path + '\temp.tar';
      UnzipFile(FileName, TarFile);
      DeleteFile := True;
   end;
begin
   if Assigned(F) then
   begin
      F.Free;
   end;

   // see if the file is compressed
   p := Pos('.tar.gz', FileName);
   if p <> 0 then
   begin
      Unzip;
   end
   else
   begin
      p := Pos('.tgz', FileName);
      if p <> 0 then
      begin
         Unzip;
      end
      else
      begin
         TarFile := FileName;
      end;
   end;

   F := TBinaryFile.Create;
   F.Assign(TarFile);
end;

procedure TTarFile.DumpFile;
var
   Block       : TTarBlock;
   DataBlock   : TTarBlock;

   procedure SkipFile;
   var
      Count : LongInt;
   begin
      Count := OctalToInt(Block.FileSize);
      while Count > 0 do
      begin
         F.BlockRead(DataBlock, sizeof(DataBlock));
         Count := Count - sizeof(DataBlock);
      end;
   end;
begin
   // read a block
   // dump it
   // skip data blocks

   // till end of file...
   while not F.EOF do
   begin
      F.BlockRead(Block, sizeof(Block));
      if (AnsiCompareStr(Block.Magic, 'ustar  ') = 0) or (AnsiCompareStr(Block.Magic, 'ustar') = 0) then
      begin
         Debug(Block.FileName + Block.LinkName + ' ' + IntToStr(OctalToInt(Block.FileSize)), DebugHigh);
         DumpBlock(Block);
         SkipFile;
      end;
   end;
end;

procedure TTarFile.ExtractArchive(Path : String);
var
   Block       : TTarBlock;
   DataBlock   : TTarBlock;
   NewFile     : TBinaryFile;
   NewFileName : String;

   procedure SkipFile;
   var
      Count : LongInt;
   begin
      Count := OctalToInt(Block.FileSize);
      while Count > 0 do
      begin
         F.BlockRead(DataBlock, sizeof(DataBlock));
         Count := Count - sizeof(DataBlock);
      end;
   end;

   procedure ExtractFile;
   var
      Count : LongInt;
      Size  : Integer;
   begin
      Count := OctalToInt(Block.FileSize);
      while Count > 0 do
      begin
         F.BlockRead(DataBlock, sizeof(DataBlock));
         // write it to file....
         if Count > sizeof(DataBlock) then
         begin
            Size := Sizeof(DataBlock);
         end
         else
         begin
            Size := Count;
         end;
         NewFile.BlockWrite(DataBlock, Size);
         Count := Count - sizeof(DataBlock);
      end;
   end;
begin
   while not F.EOF do
   begin
      F.BlockRead(Block, sizeof(Block));
      if AnsiCompareStr(Block.Magic, 'ustar  ') = 0 then
      begin
         NewFileName := Path + '\' + FixPathName(Block.FileName + Block.LinkName);
         Debug('"' + NewFileName + '"', DebugHigh);
         if Block.LinkFlag = LF_DIR then
         begin
            Debug('Creating directory...', DebugHigh);
            MkDir(NewFileName);
            SkipFile; // just in case it has data....?
         end
         else if (Block.LinkFlag = LF_NORMAL) or (Block.LinkFlag = LF_OLDNORMAL) then
         begin
            Debug('Extracting file...', DebugHigh);
            NewFile := TBinaryFile.Create;
            try
               NewFile.Assign(NewFileName);
               ExtractFile;
            finally
               NewFile.Free;
            end;
         end
         else
         begin
            Debug('Unknown type....skipping', DebugHigh);
            SkipFile;
         end;
      end;
   end;
end;


function TTarFile.OctalToInt(Octal : array of Char) : LongInt;
var
   i : Integer;
begin
   Result := 0;
   for i := Low(Octal) to High(Octal) do
   begin
      if Octal[i] = ' ' then
      begin
      end
      else if Octal[i] in ['0'..'7'] then
      begin
         Result := Result * 8;
         Result := Result + Ord(Octal[i]) - Ord('0');
      end
      else
      begin
         break;
      end;
   end;
end;

function TTarFile.FixPathName(Path : String) : String;
var
   i : Integer;
begin
   // remove any leading . and fix slashes
   Result := '';
   for i := 1 to Length(Path) do
   begin
      if (Path[i] = '.') and (i = 1) then
      begin
      end
      else if Path[i] = '/' then
      begin
         Result := Result + '\';
      end
      else if Path[i] in [':'] then
      begin
         Result := Result + '~';
      end
      else
      begin
         Result := Result + Path[i];
      end;
   end;
end;

procedure TTarFile.UnZipFile(GZFile : String; NewFile : String);
var
   StartupInfo : TStartupInfo;
   ProcessInfo : TProcessInformation;
   CommandLine : String;
   ExitCode    : DWORD;
   PathToExe   : String;
begin
   // create the process
   ZeroMemory(@StartupInfo, sizeof(StartupInfo));
   StartupInfo.cb := Sizeof(StartupInfo);
   StartupInfo.wShowWindow := SW_HIDE;
   StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;

   PathToExe := ExtractFilePath(Application.ExeName);

   CommandLine := PathToExe + '\jzip -d "' + GZFile + '" "' + NewFile + '"';


   if not CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, nil, StartupInfo, ProcessInfo) then
   begin
      MessageDlg('Error ' + IntToStr(GetLastError) + ' creating process', mtError, [mbOK], 0);
   end
   else
   begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
      if ExitCode <> 0 then
      begin
         MessageDlg('Error calling jzip', mtError, [mbOK], 0);
      end;
   end;
end;

procedure TTarFile.Extract(Part : TLinuxPartition; INodeNo : DWORD);
var
   TarBlock    : TTarBlock;
   DataBlock   : TTarBlock;
   NewFileName : String;
   NewFileINode : ULONG;
   INodeO      : TINode;
   BlockNo     : ULong;
   BlockO      : TBlock;

   procedure SkipFile;
   var
      Count : LongInt;
   begin
      Count := OctalToInt(TarBlock.FileSize);
      while Count > 0 do
      begin
         F.BlockRead(DataBlock, sizeof(DataBlock));
         Count := Count - sizeof(DataBlock);
      end;
   end;

   procedure ExtractFile;
   var
      Count : LongInt;
      Size  : Integer;
   begin
      Count := OctalToInt(TarBlock.FileSize);
      while Count > 0 do
      begin
         F.BlockRead(DataBlock, sizeof(DataBlock));
         // write it to file....
         if Count > sizeof(DataBlock) then
         begin
            Size := Sizeof(DataBlock);
         end
         else
         begin
            Size := Count;
         end;
//         NewFile.BlockWrite(DataBlock, Size);
         BlockNo := INodeO.AddBlock;
         BlockO := TBlock.Create(Part, BlockNo, false);
         try
//            CopyMemory(BlockO.Block, DataBlock, sizeof(BlockO.Block)
         finally
            BlockO.Free;
         end;
         Count := Count - sizeof(DataBlock);
      end;
   end;
begin
   while not F.EOF do
   begin
      F.BlockRead(TarBlock, sizeof(TarBlock));
      if AnsiCompareStr(TarBlock.Magic, 'ustar  ') = 0 then
      begin
//         NewFileName := Path + '\' + FixPathName(Block.FileName + Block.LinkName);
//         Debug('"' + NewFileName + '"', DebugHigh);
         if TarBlock.LinkFlag = LF_DIR then
         begin
            Debug('Creating directory...', DebugHigh);
            Part.MakeDirectory(INodeNo, NewFileName);
            SkipFile; // just in case it has data....?
         end
         else if (TarBlock.LinkFlag = LF_NORMAL) or (TarBlock.LinkFlag = LF_OLDNORMAL) then
         begin
            Debug('Extracting file...', DebugHigh);
            NewFileINode := Part.CreateFile(INodeNo, TarBlock.LinkName);
            INodeO := TINode.Create(Part, NewFileINode);
            try
               ExtractFile;
            finally
               INodeO.Free;
            end;
         end
         else
         begin
            Debug('Unknown type....skipping', DebugHigh);
            SkipFile;
         end;
      end;
   end;
end;


end.
