abtartyp.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

  { Tar archives have no overall header data }
end;

procedure TAbTarStreamHelper.WriteArchiveItem(AStream: TStream);
var
  PadBuff : PAnsiChar;
  PadSize : Integer;
begin
  { transfer actual item data }
  FStream.CopyFrom(AStream, AStream.Size);

  { Pad to Next block }
  PadSize := RoundToTarBlock(AStream.Size) - AStream.Size;
  GetMem(PadBuff, PadSize);
  FillChar(PadBuff^, PadSize, #0);
  FStream.Write(PadBuff^, PadSize);
  FreeMem(PadBuff, PadSize);
end;

procedure TAbTarStreamHelper.WriteArchiveTail;
var
  PadBuff : PAnsiChar;
  PadSize : Integer;
begin
  { append terminating null block }
  PadSize := AB_TAR_RECORDSIZE;
  GetMem(PadBuff, PadSize );
  FillChar(PadBuff^, PadSize, #0);
  FStream.Write(PadBuff^, PadSize);
  FreeMem(PadBuff, PadSize);
end;

{ TAbTarArchive }

constructor TAbTarArchive.Create(FileName: string; Mode: Word);
begin
  inherited Create(FileName, Mode);
end;

destructor TAbTarArchive.Destroy;
begin
  inherited Destroy;
end;


function TAbTarArchive.CreateItem(const FileSpec: string): TAbArchiveItem;
var
  Buff : array [0..255] of AnsiChar;
  Item : TAbTarItem;
begin
  Item := TAbTarItem.Create;
  try
    Item.CompressedSize := 0;
    Item.CRC32 := 0;
    StrPCopy(Buff, ExpandFileName(FileSpec));
    {$IFDEF MSWINDOWS }
    AnsiToOEM(Buff, Buff);
    {$ENDIF MSWINDOWS }
    Item.DiskFileName := Buff;
    StrPCopy(Buff, FixName(FileSpec));
    {$IFDEF MSWINDOWS }
    AnsiToOEM(Buff, Buff);
    {$ENDIF MSWINDOWS }
    Item.FileName := Buff;
  finally
    Result := Item;
  end;
end;


procedure TAbTarArchive.ExtractItemAt(Index: Integer;
  const NewName: string);
var
  OutStream : TFileStream;
  UseName : string;
  CurItem : TAbTarItem;
{$IFDEF LINUX}                                                           {!!.01}
  FileDateTime  : TDateTime;                                             {!!.01}
  LinuxFileTime : LongInt;                                               {!!.01}
{$ENDIF LINUX}                                                           {!!.01}
begin
  UseName := NewName;
  CurItem := TAbTarItem(ItemList[Index]);

  { check if path to save to is okay }
  if AbConfirmPath(BaseDirectory, UseName, ExtractOptions, FOnConfirmOverwrite) then
  begin
    OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone);

    try
      try {OutStream}
        ExtractItemToStreamAt(Index, OutStream);

        {$IFDEF MSWINDOWS}
        FileSetDate(OutStream.Handle, (Longint(CurItem.LastModFileDate) shl 16)
          + CurItem.LastModFileTime);
        AbFileSetAttr(UseName, AbUnix2DosFileAttributes(CurItem.ExternalFileAttributes));
        {$ENDIF}
        {$IFDEF LINUX}
        FileDateTime := AbDosFileDateToDateTime(CurItem.LastModFileDate, {!!.01}
          CurItem.LastModFileTime);                                      {!!.01}
        LinuxFileTime := AbDateTimeToUnixTime(FileDateTime);             {!!.01}
//!! MVC not yet implemented        FileSetDate(UseName, LinuxFileTime);                             {!!.01}
        AbFileSetAttr(UseName, CurItem.ExternalFileAttributes);          {!!.01}
        {$ENDIF}
      finally {OutStream}
        OutStream.Free;
      end; {OutStream}

    except
      on E : EAbUserAbort do begin
        FStatus := asInvalid;
        if FileExists(UseName) then
          DeleteFile(UseName);
        raise;
      end else begin
        if FileExists(UseName) then
          DeleteFile(UseName);
        raise;
      end;
    end;
  end;
end;

procedure TAbTarArchive.ExtractItemToStreamAt(Index: Integer;
  aStream: TStream);
var
  TarHelp : TAbTarStreamHelper;
  Found : Boolean;
begin
  { create helper }
  TarHelp := TAbTarStreamHelper.Create(FStream);

  Found := TarHelp.SeekItemData(Index);

  try {TarHelp}

    if Found {(idx = Index)} then begin
      TarHelp.ExtractItemData(aStream);
    end
    else begin
      raise Exception.Create('Index out of range');
    end;
  finally {TarHelp}
    { Clean Up }
    TarHelp.Free;
  end; {TarHelp}
end;

procedure TAbTarArchive.LoadArchive;
var
  TarHelp      : TAbTarStreamHelper;
  Item         : TAbTarItem;
  ItemFound    : Boolean;
  Abort        : Boolean;
  Confirm      : Boolean;
  TotalEntries : Integer;
  i            : Integer;
  Progress     : Byte;
begin
  { create helper }
  TarHelp := TAbTarStreamHelper.Create(FStream);
  try {TarHelp}
    TotalEntries := TarHelp.GetItemCount;

    {build Items list from tar header records}
    i := 0;

    { reset Tar }
    ItemFound := TarHelp.FindFirstItem;

    { while more data in Tar }
    while (FStream.Position < FStream.Size) and ItemFound do begin
      Item := TAbTarItem.Create;
      try  {Item}
        Item.LoadTarHeaderFromStream(FStream);
        {if it's a file}
        if Item.LinkFlag in [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL] then begin
        {create new Item}
          Item.Action := aaNone;
          FItemList.Add(Item);
          Inc(i);
        end { end if }
        else begin
        { unhandled Tar file system entity, notify user, but otherwise ignore }
          if Assigned(FOnConfirmProcessItem) then
            FOnConfirmProcessItem(self, Item, ptFoundUnhandled, Confirm);
        end;

        { show progress and allow for aborting }
        Progress := (i * 100) div TotalEntries;
        DoArchiveProgress(Progress, Abort);
        if Abort then begin
          FStatus := asInvalid;
          raise EAbUserAbort.Create;
        end;

        { get the next item }
        ItemFound := TarHelp.FindNextItem;
      except {Item}
        raise EAbException.Create('Invalid Item');
      end; {Item}
    end; {end while }

    DoArchiveProgress(100, Abort);
    FIsDirty := False;

  finally {TarHelp}
    { Clean Up }
    TarHelp.Free;
  end; {TarHelp}
end;


function TAbTarArchive.FixName(Value: string): string;
{ fixup filename for storage }
begin
  {$IFDEF MSWINDOWS}
  if DOSMode then begin
    {Add the base directory to the filename before converting }
    {the file spec to the short filespec format. }
    if BaseDirectory <> '' then begin
      {Does the filename contain a drive or a leading backslash? }
      if not ((Pos(':', Value) = 2) or (Pos(AbPathDelim, Value) = 1)) then
        {If not, add the BaseDirectory to the filename.}
        Value := BaseDirectory + AbPathDelim + Value;
    end;
    Value := AbGetShortFileSpec( Value );
  end;
  {$ENDIF MSWINDOWS}

  { Should always trip drive info if on a Win/Dos system }
  StoreOptions := StoreOptions + [soStripDrive];

  { strip drive stuff }
  if soStripDrive in StoreOptions then
    AbStripDrive( Value );

  { check for a leading slash }
  if Value[1] = AbPathDelim then
    System.Delete( Value, 1, 1 );

  if soStripPath in StoreOptions then
    Value := ExtractFileName(Value);

  if soRemoveDots in StoreOptions then
    AbStripDots(Value);

  AbFixName(Value);

  Result := Value;
end;

{!!.03 - Added }
function TAbTarArchive.GetItem(Index: Integer): TAbTarItem;
begin
  Result := TAbTarItem(FItemList.Items[Index]);
end;

procedure TAbTarArchive.PutItem(Index: Integer; const Value: TAbTarItem);
begin
  FItemList.Items[Index] := Value;
end;
{!!.03 - End Added }

procedure TAbTarArchive.SaveArchive;
var
  InTarHelp,
  OutTarHelp         : TAbTarStreamHelper;
  Abort              : Boolean;
  i                  : Integer;
  NewStream          : TAbVirtualMemoryStream;
  WorkingStream      : TAbVirtualMemoryStream;
  UncompressedStream : TStream;
  DateTime           : LongInt;
  SaveDir            : string;
  CurItem            : TAbTarItem;
  {$IFDEF LINUX}
  TmpDT              : TDateTime;
  {$ENDIF}
begin
  InTarHelp := TAbTarStreamHelper.Create(FStream);
  try { InTarHelp }

    {init new archive stream}
    NewStream := TAbVirtualMemoryStream.Create;
    OutTarHelp := TAbTarStreamHelper.Create(NewStream);

    try {NewStream/OutTarHelp}

      { create helper }
      NewStream.SwapFileDirectory := ExtractFilePath(AbGetTempFile(FTempDir, False));

      {build new archive from existing archive}
      for i := 0 to pred(Count) do begin
        FCurrentItem := ItemList[i];
        CurItem      := TAbTarItem(ItemList[i]);

        case CurItem.Action of
          aaNone, aaMove : begin
          {just copy the file to new stream}
            WorkingStream := TAbVirtualMemoryStream.Create;
            try
              InTarHelp.SeekItemData(i);
              InTarHelp.ExtractItemData(WorkingStream);
              WorkingStream.Position := 0;
              CurItem.SaveTarHeaderToStream(NewStream);
              OutTarHelp.WriteArchiveItem(WorkingStream);
            finally
              WorkingStream.Free;
            end;
          end;

          aaDelete: {doing nothing omits file from new stream} ;

          aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin
            try
              if (CurItem.Action = aaStreamAdd) then begin
              { adding from a stream }
                CurItem.SaveTarHeaderToStream(NewStream);
                OutTarHelp.WriteArchiveItem(InStream);
              end
              else begin
              { it's coming from a file }
                GetDir(0, SaveDir);
                try {SaveDir}
                  if (BaseDirectory <> '') then
                    ChDir(BaseDirectory);
                  UncompressedStream := TFileStream.Create(CurItem.DiskFileName,
                    fmOpenRead or fmShareDenyWrite );

                  {Now get the file's attributes}
                  CurItem.ExternalFileAttributes :=
                     AbDOS2UnixFileAttributes(AbFileGetAttr(CurItem.DiskFileName));
                  CurItem.UncompressedSize := UncompressedStream.Size;
                finally {SaveDir}
                  ChDir( SaveDir );
                end; {SaveDir}

                try {UncompressedStream}
                  DateTime := FileAge(CurItem.DiskFileName);
                  {$IFDEF LINUX}                                         {!!.01}
                  TmpDT := AbUnixTimeToDateTime(DateTime);               {!!.01}
                  DateTime := AbDateTimeToDosFileDate(TmpDT);            {!!.01}
                  {$ENDIF}                                               {!!.01}

                  CurItem.LastModFileTime := LongRec(DateTime).Lo;
                  CurItem.LastModFileDate := LongRec(DateTime).Hi;

                  CurItem.SaveTarHeaderToStream(NewStream);
                  OutTarHelp.WriteArchiveItem(UncompressedStream);

                finally {UncompressedStream}
                  UncompressedStream.Free;
                end; {UncompressedStream}

              end;
            except
              ItemList[i].Action := aaDelete;
              DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);
            end;
          end;


        end; {case}
      end;

      {copy new stream to FStream}
      OutTarHelp.WriteArchiveTail;
      NewStream.Position := 0;
      if (FStream is TMemoryStream) then
        TMemoryStream(FStream).LoadFromStream(NewStream)
      else if (FStream is TAbVirtualMemoryStream) then
        TAbVirtualMemoryStream(FStream).CopyFrom(NewStream, NewStream.Size)
      else begin
        { need new stream to write }
        FStream.Free;
        FStream := TAbSpanStream.Create(FArchiveName, fmOpenWrite or fmShareDenyWrite, mtLocal, FSpanningThreshold);
          FStream.CopyFrom(NewStream, NewStream.Size);

        TAbSpanStream(FStream).OnRequestImage := DoSpanningMediaRequest;
        TAbSpanStream(FStream).OnArchiveProgress := DoArchiveSaveProgress; {!!.04}
      end;

      {update Items list}
      for i := pred( Count ) downto 0 do begin
        if ItemList[i].Action = aaDelete then
          FItemList.Delete( i )
        else if ItemList[i].Action <> aaFailed then
          ItemList[i].Action := aaNone;
      end;

      DoArchiveSaveProgress( 100, Abort );                             {!!.04}
      DoArchiveProgress( 100, Abort );
    finally {NewStream/OutTarHelp}
      OutTarHelp.Free;
      NewStream.Free;
    end;

  finally { InTarHelp }
    { Clean Up }
    InTarHelp.Free;
  end;
end;

procedure TAbTarArchive.TestItemAt(Index: Integer);
var
  Hlpr : TAbTarStreamHelper;
begin
  Hlpr := TAbTarStreamHelper.Create(FStream);
  try
    Hlpr.SeekItem(Index);
    if VerifyTar(FStream) <> atTar then
      raise EAbException.Create('Invalid Tar');
  finally
    Hlpr.Free;
  end;
end;

end.