virtualfilesystem/uvfsTarArchive.pas

unit uvfsTarArchive;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, libtar, syncobjs,

  uvfsManager;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvfsTarArchive = class(TvfsProvider)
  private
    fStream: TStream;
    fOwnsStream: Boolean;
    fFileSpec: String;
    fTar: TTarArchive;
    fTarCS: TCriticalSection;

  private
    function FindFile(const aFilename: String; out aRec: TTarDirRec): Boolean;
    function PrepareFilename(const aFilename: String): String;

  public { TvfsProvider }
    class function StorageName: string; override;

  public { TvfsProvider }
    function StorageGetFileSpec: string; override;
    function GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): Boolean; override;
    function Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean; override;
    function Rename(const OldName, NewName: string): boolean; override;
    function Delete(const aName: String): boolean; override;
    procedure DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean); override;

  public
    constructor Create(const FileSpec: string; const ExtendedData: string = ''); override;
    constructor Create(const aStream: TStream; const aOwnsStream: Boolean);
    destructor Destroy; override;
  end;


implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvfsTarArchive////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.FindFile(const aFilename: String; out aRec: TTarDirRec): Boolean;
var
  fn: String;
begin
  fn := PrepareFilename(aFilename);
  fTar.Reset;
  result := true;
  while fTar.FindNext(aRec{%H-}) do begin
    if (aRec.Name = fn) then
      exit;
  end;
  result := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.PrepareFilename(const aFilename: String): String;
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Delimiter       := VFS_PATH_DELIM;
    sl.StrictDelimiter := true;
    sl.DelimitedText   := vfsVirtualPathDelim(aFilename);
    i := 0;
    while (i < sl.Count) do begin
      if (sl[i] = '..') and (i > 0) then begin
        sl.Delete(i);
        dec(i);
        sl.Delete(i);
      end else
        inc(i);
    end;
    result := sl.DelimitedText;
  finally
    FreeAndNil(sl);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TvfsTarArchive.StorageName: string;
begin
  result := 'tar';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.StorageGetFileSpec: string;
begin
  result := fFileSpec;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): Boolean;
var
  rec: TTarDirRec;
begin
  result := FindFile(FileName, rec);
  if result then begin
    FileInfo.Size       := rec.Size;
    FileInfo.ModDate    := rec.DateTime;
    FileInfo.Attributes := 0;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean;
var
  ms: TMemoryStream;
  rec: TTarDirRec;
begin
  result := false;
  fTarCS.Enter;
  try
    if not FindFile(FileName, rec) then
      exit;

    ms := TMemoryStream.Create;
    fTar.ReadFile(ms);

    case OpenMode of
      omReadOnly: begin
        ms.Position := 0;
        Stream := TvfsStreamHandleRead.Create(ms);
      end;
    else
      raise ENotSupportedException.Create('tar archive only supports read operations');
    end;

    result := Assigned(Stream);
    if not result then
      FreeAndNil(ms);
  finally
    fTarCS.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.Rename(const OldName, NewName: string): boolean;
begin
  result := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvfsTarArchive.Delete(const aName: String): boolean;
begin
  result := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvfsTarArchive.DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean);
var
  rec: TTarDirRec;
  dirOK: Boolean;
  fp: String;
  a: TvfsDirectoryEntry;
begin
  fTarCS.Enter;
  try
    fTar.Reset;
    while fTar.FindNext(rec{%H-}) do begin
      fp := ExtractFilePath(rec.Name);
      if Subdirs then
        dirOK := (AnsiCompareStr(Path, copy(fp, 1, Length(Path))) = 0)
      else
        dirOk := (AnsiCompareFileName(Path, fp) = 0);

      if dirOK then begin
        a := TvfsDirectoryEntry.Create;
        a.FileInfo.Size       := rec.Size;
        a.FileInfo.ModDate    := rec.DateTime;
        a.FileInfo.Attributes := 0;
        AddFunction(rec.Name, a, List);
      end;
    end;
  finally
    fTarCS.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvfsTarArchive.Create(const FileSpec: string; const ExtendedData: string);
var
  fs: TFileStream;
begin
  fFileSpec := FileSpec;
  if not FileExists(fFileSpec) then
    EFileNotFoundException.Create(fFileSpec);
  fs := TFileStream.Create(fFileSpec, fmOpenRead);
  Create(fs, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvfsTarArchive.Create(const aStream: TStream; const aOwnsStream: Boolean);
begin
  inherited Create('', '');
  fOwnsStream := aOwnsStream;
  fStream     := aStream;
  fTar        := TTarArchive.Create(fStream);
  fTarCS      := TCriticalSection.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TvfsTarArchive.Destroy;
begin
  FreeAndNil(fTar);
  FreeAndNil(fTarCS);
  if (fOwnsStream) then
    FreeAndNil(fStream);
  inherited Destroy;
end;

initialization
  vfsManager.RegisterProvider(TvfsTarArchive);

end.