2235 lines
84 KiB
ObjectPascal
2235 lines
84 KiB
ObjectPascal
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower Abbrevia
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1997-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
* Joel Haynie
|
|
* Craig Peterson <capeterson@users.sourceforge.net>
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{*********************************************************}
|
|
{* ABBREVIA: AbTarTyp.pas *}
|
|
{*********************************************************}
|
|
{* ABBREVIA: TAbTarArchive, TAbTarItem classes *}
|
|
{*********************************************************}
|
|
{* Misc. constants, types, and routines for working *}
|
|
{* with Tar files *}
|
|
{*********************************************************}
|
|
|
|
unit AbTarTyp;
|
|
|
|
{$I AbDefine.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
AbUtils, AbArcTyp;
|
|
|
|
const
|
|
AB_TAR_RECORDSIZE = 512; {Note: SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE}
|
|
AB_TAR_NAMESIZE = 100;
|
|
AB_TAR_V7_EMPTY_SIZE = 167;
|
|
AB_TAR_USTAR_PREFIX_SIZE = 155;
|
|
AB_TAR_STAR_PREFIX_SIZE = 131;
|
|
AB_TAR_OLD_GNU_EMPTY1_SIZE = 5;
|
|
AB_TAR_OLD_GNU_SPARSE_SIZE = 96;
|
|
AB_TAR_OLD_GNU_EMPTY2_SIZE = 17;
|
|
AB_TAR_SIZE_AFTER_STDHDR = 167;
|
|
AB_TAR_TUSRNAMELEN = 32;
|
|
AB_TAR_TGRPNAMELEN = 32;
|
|
|
|
|
|
{ The checksum field is filled with this while the checksum is computed. }
|
|
AB_TAR_CHKBLANKS = ' '; { 8 blank spaces(#20), no null }
|
|
AB_TAR_L_HDR_NAME = '././@LongLink'; { As seen in the GNU File Examples}
|
|
AB_TAR_L_HDR_USR_NAME='root'; { On Cygwin this is #0, Redhat it is 'root' }
|
|
AB_TAR_L_HDR_GRP_NAME='root'; { Same on all OS's }
|
|
AB_TAR_L_HDR_ARR8_0 ='0000000'#0; { 7 zeros and one null }
|
|
AB_TAR_L_HDR_ARR12_0 ='00000000000'#0;{ 11 zeros and one null }
|
|
AB_TAR_MAGIC_VAL = 'ustar'#0; { 5 chars & a nul }
|
|
AB_TAR_MAGIC_VER = '00'; { 2 chars }
|
|
AB_TAR_MAGIC_GNUOLD = 'ustar '#0; { 7 chars & a null }
|
|
AB_TAR_MAGIC_V7_NONE = #0#0#0#0#0#0#0#0;{ 8, #0 }
|
|
|
|
{ The linkflag defines the type of file(FH), and Meta Data about File(MDH) }
|
|
AB_TAR_LF_OLDNORMAL = #0; { FH, Normal disk file, Unix compatible } { Historically used for V7 }
|
|
AB_TAR_LF_NORMAL = '0'; { FH, Normal disk file }
|
|
AB_TAR_LF_LINK = '1'; { FH, Link to previously archived file }
|
|
AB_TAR_LF_SYMLINK = '2'; { FH, Symbolic(soft) link }
|
|
AB_TAR_LF_CHR = '3'; { FH, Character special file }{ Used for device nodes, Conditionally compiled into GNUTAR }
|
|
AB_TAR_LF_BLK = '4'; { FH, Block special file }{ Used for device nodes, Conditionally compiled into GNUTAR }
|
|
AB_TAR_LF_DIR = '5'; { FH, Directory, Zero size File }
|
|
AB_TAR_LF_FIFO = '6'; { FH, FIFO special file }{ Used for fifo files(pipe like), Conditionally complied into GNUTAR }
|
|
AB_TAR_LF_CONTIG = '7'; { FH, Contiguous file } { Normal File, but All blocks should be contiguos on the disk }
|
|
AB_TAR_LF_XHDR = 'x'; { MDH, POSIX, Next File has Extended Header }
|
|
AB_TAR_LF_XGL = 'g'; { MDH, POSIX, Global Extended Header }
|
|
AB_TAR_LF_DUMPDIR = 'D'; { FH, Extra GNU, Dump Directory} { Generated Dump of Files in a directory, has a size }
|
|
AB_TAR_LF_LONGLINK = 'K'; { MDH, Extra GNU, Next File has Long LinkName}
|
|
AB_TAR_LF_LONGNAME = 'L'; { MDH, Extra GNU, Next File has Long Name}
|
|
AB_TAR_LF_MULTIVOL = 'M'; { FH, Extra GNU, MultiVolume File Cont.}{ End of a file that spans multiple TARs }
|
|
AB_TAR_LF_SPARSE = 'S'; { FH, Extra GNU, Sparse File Cont.}
|
|
AB_TAR_LF_VOLHDR = 'V'; { FH, Extra GNU, File is Volume Header }
|
|
AB_TAR_LF_EXHDR = 'X'; { MDH, Extra GNU, Solaris Extended Header }
|
|
{ The only questionable MetaData type is 'V', file or meta-data? will treat as file header }
|
|
AB_SUPPORTED_F_HEADERS = [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL, AB_TAR_LF_LINK,
|
|
AB_TAR_LF_SYMLINK, AB_TAR_LF_DIR];
|
|
AB_UNSUPPORTED_F_HEADERS = [AB_TAR_LF_CHR, AB_TAR_LF_BLK, AB_TAR_LF_FIFO,
|
|
AB_TAR_LF_CONTIG, AB_TAR_LF_DUMPDIR, AB_TAR_LF_MULTIVOL,
|
|
AB_TAR_LF_SPARSE, AB_TAR_LF_VOLHDR];
|
|
AB_SUPPORTED_MD_HEADERS = [AB_TAR_LF_LONGNAME, AB_TAR_LF_LONGLINK];
|
|
AB_UNSUPPORTED_MD_HEADERS= [AB_TAR_LF_XHDR, AB_TAR_LF_XGL, AB_TAR_LF_EXHDR];
|
|
AB_GNU_MD_HEADERS = [AB_TAR_LF_LONGLINK, AB_TAR_LF_LONGNAME]; { If present then OLD_/GNU_FORMAT }
|
|
AB_PAX_MD_HEADERS = [AB_TAR_LF_XHDR, AB_TAR_LF_XGL]; { If present then POSIX_FORMAT }
|
|
AB_IGNORE_SIZE_HEADERS = [AB_TAR_LF_LINK, AB_TAR_LF_SYMLINK, AB_TAR_LF_CHR,
|
|
AB_TAR_LF_BLK, AB_TAR_LF_DIR, AB_TAR_LF_FIFO];
|
|
{ The rest of the Chars are unsupported and unknown types Treat those headers as File types }
|
|
{ Further link types may be defined later. }
|
|
|
|
{ Bits used in the mode field - values in octal }
|
|
AB_TAR_TSUID = $0800; { Set UID on execution }
|
|
AB_TAR_TSGID = $0400; { Set GID on execution }
|
|
AB_TAR_TSVTX = $0200; { Save text (sticky bit) }
|
|
|
|
|
|
type
|
|
Arr8 = array [0..7] of AnsiChar;
|
|
Arr12 = array [0..11] of AnsiChar;
|
|
Arr12B = array[0..11] of Byte;
|
|
ArrName = array [0..AB_TAR_NAMESIZE-1] of AnsiChar;
|
|
TAbTarHeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT,
|
|
USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT);
|
|
TAbTarItemType = (SUPPORTED_ITEM, UNSUPPORTED_ITEM, UNKNOWN_ITEM);
|
|
TAbTarHeaderType = (FILE_HEADER, META_DATA_HEADER, MD_DATA_HEADER, UNKNOWN_HEADER);
|
|
TAbTarMagicType = (GNU_OLD, NORMAL);
|
|
TAbTarMagicRec = packed record
|
|
case TAbTarMagicType of
|
|
GNU_OLD: (gnuOld : array[0..7] of AnsiChar); { Old GNU magic: (Magic.gnuOld) }
|
|
NORMAL : (value : array[0..5] of AnsiChar; { Magic value: (Magic.value)}
|
|
version: array[0..1] of AnsiChar); { Version: (Magic.version) }
|
|
end;
|
|
|
|
{ Notes from GNU Tar & POSIX Spec.: }
|
|
{All the first 345 bytes are the same. }
|
|
{ "USTAR_header": Prefix(155): 345-499,
|
|
empty(12): 500-511 }
|
|
{ "old_gnu_header": atime(12): 345-356,
|
|
ctime(12): 357-368,
|
|
offset(12): 369-380,
|
|
longnames(4): 381-384,
|
|
empty(1): 385,
|
|
sparse structs(4x(12+12)=96): 386-481,
|
|
isextended(1): 482,
|
|
realsize(12): 483-494,
|
|
empty(16): 495-511 }
|
|
{ "star_header": Prefix(131): 345-475,
|
|
atime(12): 476-487,
|
|
ctime(12): 488-499,
|
|
empty(12): 500-511 }
|
|
{ "star_in_header": prefix(1): 345,
|
|
empty(9): 346-354,
|
|
isextended(1): 355,
|
|
sparse structs(4x(12+12)=96): 356-451,
|
|
realsize(12): 452-463,
|
|
offset(12): 464-475,
|
|
atime(12): 476-487,
|
|
ctime(12): 488-499,
|
|
empty(8): 500-507,
|
|
xmagic(4): 508-511 }
|
|
{ "sparse_header": These two structs are the same, and they are Meta data about file. }
|
|
{"star_ext_header": sparse structs(21x(12+12)=504): 0-503,
|
|
isextended(1): 504 }
|
|
{POSIX(PAX) extended header: is a buffer packed with content of this form:
|
|
This if from the POSIX spec. References the C printf command string.
|
|
"%d %s=%s\n". Then they are simply concatenated. }
|
|
{ PAX Extended Header Keywords: }
|
|
{ 'atime', 'charset', 'comment', 'ctime', 'gid', 'gname', 'linkpath', 'mtime', 'path',
|
|
'realtime.', 'security.', 'size', 'uid', 'uname' }
|
|
{ GNU Added PAX Extended Header Keywords: }
|
|
{ 'GNU.sparse.name', 'GNU.sparse.major', 'GNU.sparse.minor',
|
|
'GNU.sparse.realsize', 'GNU.sparse.numblocks', 'GNU.sparse.size',
|
|
'GNU.sparse.offset', 'GNU.sparse.numbytes', 'GNU.sparse.map', 'GNU.dumpdir',
|
|
'GNU.volume.label', 'GNU.volume.filename', 'GNU.volume.size',
|
|
'GNU.volume.offset' }
|
|
|
|
{ V7 uses AB_TAR_LF_OLDNORMAL linkflag, has no magic field & no Usr/Grp Names }
|
|
{ V7 Format ends Empty(padded with zeros), as does the POSIX record. }
|
|
TAbTarEnd_Empty_Rec = packed record
|
|
Empty: array[0..AB_TAR_V7_EMPTY_SIZE-1] of Byte; { 345-511, $159-1FF, Empty Space }
|
|
end;
|
|
{ UStar End Format }
|
|
TAbTarEnd_UStar_Rec = packed record
|
|
Prefix: array[0..AB_TAR_USTAR_PREFIX_SIZE-1] of AnsiChar;
|
|
{ 345-499, $159-1F3, Prefix of file & path name, null terminated ASCII string }
|
|
Empty : Arr12B;{ 500-512, $1F4-1FF, Empty Space }
|
|
end;
|
|
{ Old GNU End Format }
|
|
TAbTarEnd_GNU_old_Rec = packed record
|
|
Atime : Arr12; { 345-356, $159-164, time of last access (UNIX Date in ASCII coded Octal)}
|
|
Ctime : Arr12; { 357-368, $165-170, time of last status change (UNIX Date in ASCII coded Octal)}
|
|
Offset: Arr12; { 369-380, $171-17C, Multirecord specific value }
|
|
Empty1: array[0..AB_TAR_OLD_GNU_EMPTY1_SIZE-1] of Byte;
|
|
{ 381-385, $17D-181, Empty Space, Once contained longname ref. }
|
|
Sparse: array[0..AB_TAR_OLD_GNU_SPARSE_SIZE-1] of Byte;
|
|
{ 386-481, $182-1E1, Sparse File specific values }
|
|
IsExtended: byte;{ 482, $ 1E2, Flag to signify Sparse file headers follow }
|
|
RealSize: Arr12;{ 483-494, $1E3-1EE, Real size of a Sparse File. }
|
|
Empty2: array[0..AB_TAR_OLD_GNU_EMPTY2_SIZE-1] of Byte;
|
|
{ 495-511, $1EF-1FF, Empty Space }
|
|
end;
|
|
{ Star End Format }
|
|
TAbTarEnd_Star_Rec = packed record
|
|
Prefix: array[0..AB_TAR_STAR_PREFIX_SIZE-1] of AnsiChar;
|
|
{ 345-499, $159-1F3, prefix of file & path name, null terminated ASCII string }
|
|
Atime : Arr12; { 476-487, $1DC-1E7, time of last access (UNIX Date in ASCII coded Octal)}
|
|
Ctime : Arr12; { 488-499, $1E8-1F3, time of last status change (UNIX Date in ASCII coded Octal)}
|
|
Empty : Arr12B;{ 500-512, $1F4-1FF, Empty Space }
|
|
end;
|
|
{ When support for sparse files is added, Add another record for sparse in header }
|
|
|
|
|
|
{ Note: SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE by design }
|
|
PAbTarHeaderRec = ^TAbTarHeaderRec; { Declare pointer type for use in the list }
|
|
TAbTarHeaderRec = packed record
|
|
Name : ArrName; { 0- 99, $ 0- 63, filename, null terminated ASCII string, unless length is 100 }
|
|
Mode : Arr8; { 100-107, $ 64- 6B, file mode (UNIX style, ASCII coded Octal) }
|
|
uid : Arr8; { 108-115, $ 6C- 73, usrid # (UNIX style, ASCII coded Octal) }
|
|
gid : Arr8; { 116-123, $ 74- 7B, grpid # (UNIX style, ASCII coded Octal) }
|
|
Size : Arr12; { 124-135, $ 7C- 87, size of TARred file (ASCII coded Octal) }
|
|
ModTime : Arr12; { 136-147, $ 88- 93, time of last modification.(UNIX Date in ASCII coded Octal)
|
|
UTC time }
|
|
ChkSum : Arr8; { 148-155, $ 94- 9B, checksum of header (6 bytes ASCII coded Octal, #00, #20) }
|
|
LinkFlag: AnsiChar; { 156, $ 9C, type of item, one of the Link Flag constants from above }
|
|
LinkName: ArrName; { 157-256, $ 9D-100, name of link, null terminated ASCII string }
|
|
Magic : TAbTarMagicRec;
|
|
{ 257-264, $101-108, identifier, usually 'ustar'#00'00' }
|
|
UsrName : array [0..AB_TAR_TUSRNAMELEN-1] of AnsiChar;
|
|
{ 265-296, $109-128, username, null terminated ASCII string }
|
|
GrpName : array [0..AB_TAR_TGRPNAMELEN-1] of AnsiChar;
|
|
{ 297-328, $129-148, groupname, null terminated ASCII string }
|
|
DevMajor: Arr8; { 329-336, $149-150, major device ID (UNIX style, ASCII coded Octal) }
|
|
DevMinor: Arr8; { 337-344, $151-158, minor device ID (UNIX style, ASCII coded Octal) }
|
|
case TAbTarHeaderFormat of{ 345-511, $159-1FF See byte Definitions above.}
|
|
V7_FORMAT : ( v7 : TAbTarEnd_Empty_Rec );
|
|
OLDGNU_FORMAT: ( gnuOld: TAbTarEnd_GNU_old_Rec );
|
|
GNU_FORMAT : ( gnu : TAbTarEnd_GNU_old_Rec );
|
|
USTAR_FORMAT : ( ustar : TAbTarEnd_UStar_Rec );
|
|
STAR_FORMAT : ( star : TAbTarEnd_Star_Rec );
|
|
POSIX_FORMAT : ( pax : TAbTarEnd_Empty_Rec );
|
|
end;{ end TAbTarHeaderRec }
|
|
{ There are three main types of headers we will see in a Tar file }
|
|
{ TAbTarHeaderType = (STANDARD_HDR, SPARSE_HDR, POSIX_EXTENDED_HDR); }
|
|
{ The 1st is defined above, The later two are simply organized data types. }
|
|
|
|
TAbTarItemRec = record
|
|
{ Note: that the actual The name needs to be coherient with the name Inherited
|
|
from parent type TAbArchiveItem }
|
|
Name : string; { Path & File name. }
|
|
Mode : LongWord; { File Permissions }
|
|
uid : Integer; { User ID }
|
|
gid : Integer; { Group ID }
|
|
Size : Int64; { Tared File size }
|
|
ModTime : Int64; { Last time of Modification, in UnixTime }
|
|
ChkSumPass : Boolean; { Header Check sum found to be good }
|
|
LinkFlag : AnsiChar; { Link Flag, Echos the actual File Type of this Item. }
|
|
ItemType : TAbTarItemType; { Item Type Assigned from LinkFlag Header Types. }
|
|
LinkName : string; { Link Name }
|
|
Magic : AnsiString; { Magic value }
|
|
Version : Integer; { Version Number }
|
|
UsrName : string; { User Name, for User ID }
|
|
GrpName : string; { Group Name, for Group ID }
|
|
DevMajor : Integer; { Major Device ID }
|
|
DevMinor : Integer; { Minor Device ID }
|
|
{ Additional Types used for holding info. }
|
|
AccessTime : Int64; { Time of Last Access, in UnixTime }
|
|
ChangeTime : Int64; { Time of Last Status Change, in UnixTime }
|
|
ArchiveFormat: TAbTarHeaderFormat; { Type of Archive of this record }
|
|
StreamPosition: Int64; { Pointer to the top of the item in the file. }
|
|
Dirty : Boolean; { Indication if this record needs to have its headers CheckSum recalculated }
|
|
ItemReadOnly: Boolean; { Indication if this record is READ ONLY }
|
|
FileHeaderCount:Integer;{ Number of Headers in the Orginal TarHeaders in the File Stream }
|
|
end;
|
|
|
|
type
|
|
PTAbTarItem = ^TAbTarItem;
|
|
TAbTarItem = class(TAbArchiveItem)
|
|
private
|
|
{ The following private members are used for Stuffing FTarItem struct }
|
|
procedure ParseTarHeaders; { Error in header if }
|
|
procedure DetectHeaderFormat; { Helper to stuff HeaderFormat }
|
|
procedure GetFileNameFromHeaders; { Helper to pull name from Headers }
|
|
procedure GetLinkNameFromHeaders; { Helper to pull name from Headers }
|
|
function TestCheckSum: Boolean; { Helper to Calculate Checksum of a header. }
|
|
procedure DoGNUExistingLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);
|
|
procedure DoGNUNewLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);
|
|
protected {private}
|
|
PTarHeader: PAbTarHeaderRec;{ Points to FTarHeaderList.Items[FTarHeaderList.Count-1] }
|
|
FTarHeaderList: TList; { List of The Headers }
|
|
FTarHeaderTypeList: TList; { List of the Header Types }
|
|
FTarItem: TAbTarItemRec; { Data about current TAR Item }
|
|
protected
|
|
function GetDevMajor: Integer;
|
|
function GetDevMinor: Integer;
|
|
function GetGroupID: Integer;
|
|
function GetGroupName: string;
|
|
function GetLinkName: string;
|
|
function GetUserID: Integer;
|
|
function GetUserName: string;
|
|
function GetModTime: Int64;
|
|
function GetNumHeaders: Integer;
|
|
function GetMagic: string;
|
|
|
|
{ All Sets shall update the headers Or add headers as needed. }
|
|
procedure SetDevMajor(const Value: Integer);
|
|
procedure SetDevMinor(const Value: Integer);
|
|
procedure SetGroupID(const Value: Integer); { Extended Headers }
|
|
procedure SetGroupName(const Value: string); { Extended Headers }
|
|
procedure SetLinkFlag(Value: AnsiChar);
|
|
procedure SetLinkName(const Value: string); { Extended Headers }
|
|
procedure SetUserID(const Value: Integer); { Extended Headers }
|
|
procedure SetUserName(const Value: string); { Extended Headers }
|
|
procedure SetModTime(const Value: Int64);
|
|
Procedure SetMagic(const Value: string);
|
|
{ TODO: add support for Atime and Ctime here }
|
|
|
|
{ Overrides for Inherited Properties from type TAbArchiveItem }
|
|
function GetCompressedSize : Int64; override;
|
|
function GetExternalFileAttributes : LongWord; override;
|
|
function GetFileName : string; override;
|
|
function GetIsDirectory: Boolean; override;
|
|
function GetIsEncrypted : Boolean; override;
|
|
function GetLastModFileDate : Word; override;
|
|
function GetLastModFileTime : Word; override;
|
|
function GetLastModTimeAsDateTime: TDateTime; override;
|
|
function GetNativeFileAttributes : LongInt; override;
|
|
function GetUncompressedSize : Int64; override;
|
|
|
|
procedure SetCompressedSize(const Value : Int64); override; { Extended Headers }
|
|
procedure SetExternalFileAttributes( Value : LongWord ); override;
|
|
procedure SetFileName(const Value : string); override; { Extended Headers }
|
|
procedure SetIsEncrypted(Value : Boolean); override;
|
|
procedure SetLastModFileDate(const Value : Word); override; { Extended Headers }
|
|
procedure SetLastModFileTime(const Value : Word); override; { Extended Headers }
|
|
procedure SetLastModTimeAsDateTime(const Value: TDateTime); override;
|
|
procedure SetUncompressedSize(const Value : Int64); override; { Extended Headers }
|
|
|
|
procedure SaveTarHeaderToStream(AStream : TStream);
|
|
procedure LoadTarHeaderFromStream(AStream : TStream);
|
|
|
|
property Magic : string { Magic value }
|
|
read GetMagic write SetMagic;
|
|
public
|
|
{ property Name : STRING; Path & File name. Inherited from parent type TAbArchiveItem }
|
|
{ read GetFileName write SetFileName; overridden above}
|
|
property Mode : LongWord { File Permissions }
|
|
read GetExternalFileAttributes write SetExternalFileAttributes;
|
|
property UserID : Integer { User ID }
|
|
read GetUserID write SetUserID;
|
|
property GroupID : Integer { Group ID }
|
|
read GetGroupID write SetGroupID;
|
|
property ModTime : Int64
|
|
read GetModTime write SetModTime;
|
|
{ property UncompressedSize/CompressedSize(Size): Int64; File size (comp/uncomp) Inherited from parent type TAbArchiveItem }
|
|
{ read GetUncompressedSize, GetCompressedSize; overridden above }
|
|
{ write SetUncompressedSize, SetCompressedSize; overridden above }
|
|
{ property LastModFileTime/LastModFileDate(ModeTime): TDateTime; Last time of Modification Inherited from parent type TAbArchiveItem }
|
|
{ read GetLastModFileTime, GetLastModFileDate; overridden above }
|
|
{ write SetLastModFileTime, SetLastModFileDate; overridden above }
|
|
|
|
property CheckSumGood: Boolean
|
|
read FTarItem.ChkSumPass; { Header Check sum found to be good }
|
|
property LinkFlag : AnsiChar { Link Flag of File Header }
|
|
read FTarItem.LinkFlag write SetLinkFlag;
|
|
property LinkName : string { Link Name }
|
|
read GetLinkName write SetLinkName;
|
|
property UserName : string { User Name, for User ID }
|
|
read GetUserName write SetUserName;
|
|
property GroupName : string { Group Name, for Group ID }
|
|
read GetGroupName write SetGroupName;
|
|
property DevMajor : Integer { Major Device ID }
|
|
read GetDevMajor write SetDevMajor;
|
|
property DevMinor : Integer { Minor Device ID }
|
|
read GetDevMinor write SetDevMinor;
|
|
{ TODO: Add support ATime and CTime }
|
|
{AccessTime : TDateTime;} { Time of Last Access }
|
|
{ChangeTime : TDateTime;} { Time of Last Status Change }
|
|
{ Additional Types used for holding info. }
|
|
property ExternalFileAttributes;
|
|
property ArchiveFormat: TAbTarHeaderFormat
|
|
read FTarItem.ArchiveFormat write FTarItem.ArchiveFormat;
|
|
property ItemType: TAbTarItemType
|
|
read FTarItem.ItemType write FTarItem.ItemType;
|
|
property ItemReadOnly: Boolean
|
|
read FTarItem.ItemReadOnly write FTarItem.ItemReadOnly;
|
|
property FileHeaderCount: Integer
|
|
read FTarItem.FileHeaderCount;
|
|
property HeaderCount: Integer
|
|
read GetNumHeaders;
|
|
property StreamPosition: Int64
|
|
read FTarItem.StreamPosition write FTarItem.StreamPosition;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end; { end TAbArchiveItem }
|
|
|
|
|
|
TAbTarStreamHelper = class(TAbArchiveStreamHelper)
|
|
private
|
|
function FindItem: Boolean; { Tool for FindFirst/NextItem functions }
|
|
protected
|
|
FTarHeader : TAbTarHeaderRec; { Speed-up Buffer only }
|
|
FCurrItemSize : Int64; { Current Item size }
|
|
FCurrItemPreHdrs: Integer; { Number of Meta-data Headers before the Item }
|
|
public
|
|
destructor Destroy; override;
|
|
procedure ExtractItemData(AStream : TStream); override;
|
|
function FindFirstItem : Boolean; override;
|
|
function FindNextItem : Boolean; override;
|
|
procedure ReadHeader; override;
|
|
procedure ReadTail; override;
|
|
function SeekItem(Index : Integer): Boolean; override;
|
|
procedure WriteArchiveHeader; override;
|
|
procedure WriteArchiveItem(AStream : TStream); override;
|
|
procedure WriteArchiveItemSize(AStream : TStream; Size: Int64);
|
|
procedure WriteArchiveTail; override;
|
|
function GetItemCount : Integer; override;
|
|
end;
|
|
|
|
|
|
TAbTarArchive = class(TAbArchive)
|
|
private
|
|
FArchReadOnly : Boolean;
|
|
FArchFormat: TAbTarHeaderFormat;
|
|
protected
|
|
function CreateItem(const FileSpec : string): TAbArchiveItem;
|
|
override;
|
|
procedure ExtractItemAt(Index : Integer; const UseName : string);
|
|
override;
|
|
procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);
|
|
override;
|
|
procedure LoadArchive;
|
|
override;
|
|
procedure SaveArchive;
|
|
override;
|
|
procedure TestItemAt(Index : Integer);
|
|
override;
|
|
function FixName(const Value: string): string;
|
|
override;
|
|
function GetSupportsEmptyFolders: Boolean;
|
|
override;
|
|
|
|
function GetItem(Index: Integer): TAbTarItem;
|
|
procedure PutItem(Index: Integer; const Value: TAbTarItem);
|
|
|
|
public {methods}
|
|
constructor CreateFromStream(aStream : TStream; const aArchiveName : string);
|
|
override;
|
|
property UnsupportedTypesDetected : Boolean
|
|
read FArchReadOnly;
|
|
property Items[Index : Integer] : TAbTarItem
|
|
read GetItem
|
|
write PutItem; default;
|
|
end;
|
|
|
|
function VerifyTar(Strm : TStream) : TAbArchiveType;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}
|
|
Windows, // Fix inline warnings
|
|
{$ENDIF MSWINDOWS}
|
|
Math, RTLConsts, SysUtils,
|
|
{$IFDEF HasAnsiStrings}AnsiStrings, {$ENDIF}
|
|
AbCharset, AbVMStrm, AbExcept;
|
|
|
|
{ ****************** Helper functions Not from Classes Above ***************** }
|
|
function OctalToInt(const Oct : PAnsiChar; aLen : integer): Int64;
|
|
var
|
|
i : integer;
|
|
begin
|
|
Result := 0;
|
|
|
|
i := 0;
|
|
while (i < aLen) and (Oct[i] = ' ') do
|
|
inc(i);
|
|
|
|
if (i = aLen) then
|
|
Exit;
|
|
|
|
while (i < aLen) and (Oct[i] in ['0'..'7']) do begin
|
|
Result := (Result * 8) + (Ord(Oct[i]) - Ord('0'));
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
function IntToOctal(Value : Int64): AnsiString;
|
|
const
|
|
OctDigits : array[0..7] of AnsiChar = '01234567';
|
|
begin
|
|
if Value = 0 then
|
|
Result := '0'
|
|
else begin
|
|
Result := '';
|
|
while Value > 0 do begin
|
|
Result := OctDigits[Value and 7] + Result;
|
|
Value := Value shr 3;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function CalcTarHeaderChkSum(const TarH : TAbTarHeaderRec): LongInt;
|
|
var
|
|
HdrBuffer : PAnsiChar;
|
|
HdrChkSum : LongInt;
|
|
j : Integer;
|
|
begin
|
|
{ prepare for the checksum calculation }
|
|
HdrBuffer := PAnsiChar(@TarH);
|
|
HdrChkSum := 0;
|
|
|
|
{calculate the checksum, a simple sum of the bytes in the header}
|
|
for j := 0 to Pred(SizeOf(TAbTarHeaderRec)) do
|
|
HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]);
|
|
|
|
Result := HdrChkSum;
|
|
end;
|
|
|
|
function VerifyTar(Strm : TStream) : TAbArchiveType;
|
|
{ assumes Tar positioned correctly for test of item }
|
|
var
|
|
TarItem : TAbTarItem;
|
|
StartPos : Int64;
|
|
begin
|
|
StartPos := Strm.Position;
|
|
try
|
|
{ Verifies that the header checksum is valid, and Item type is understood.
|
|
This does not mean that extraction is supported. }
|
|
TarItem := TAbTarItem.Create;
|
|
try
|
|
{ get current Tar Header }
|
|
TarItem.LoadTarHeaderFromStream(Strm);
|
|
if TarItem.CheckSumGood then
|
|
Result := atTar
|
|
else
|
|
Result := atUnknown;
|
|
finally
|
|
TarItem.Free;
|
|
end;
|
|
except
|
|
on EReadError do
|
|
Result := atUnknown;
|
|
end;
|
|
Strm.Position := StartPos;
|
|
end;
|
|
|
|
function PadString(const S : AnsiString; Places : Integer) : AnsiString;
|
|
{
|
|
Pads a string (S) with one right space and as many left spaces as
|
|
needed to fill Places
|
|
|
|
If length S greater than Places, just returns S
|
|
|
|
Some TAR utilities evidently expect Octal numeric fields to be in
|
|
this format
|
|
}
|
|
begin
|
|
if Length(S) >= LongInt(Places) then
|
|
Result := S
|
|
else begin
|
|
Result := S + ' ';
|
|
Result := StringOfChar(AnsiChar(' '), Places - Length(Result)) + Result;
|
|
end;
|
|
end;
|
|
|
|
{ Round UP to the nearest Tar Block Boundary. }
|
|
function RoundToTarBlock(Size: Int64) : Int64;
|
|
begin
|
|
Result := (Size + (AB_TAR_RECORDSIZE - 1)) and
|
|
not (AB_TAR_RECORDSIZE - 1);
|
|
end;
|
|
|
|
|
|
{ ****************************** TAbTarItem ********************************** }
|
|
constructor TAbTarItem.Create;
|
|
begin
|
|
inherited Create;
|
|
FTarHeaderList := TList.Create;
|
|
FTarHeaderTypeList := TList.Create;
|
|
GetMem(PTarHeader, AB_TAR_RECORDSIZE); { PTarHeader is our new Header }
|
|
FillChar(PTarHeader^, AB_TAR_RECORDSIZE, #0);
|
|
FTarHeaderList.Add(PTarHeader);
|
|
FTarHeaderTypeList.Add(Pointer(FILE_HEADER));
|
|
FTarItem.FileHeaderCount := 1;
|
|
{ set defaults }
|
|
FTarItem.ArchiveFormat := UNKNOWN_FORMAT;
|
|
|
|
FileName := '';
|
|
Mode := AB_FPERMISSION_GENERIC;
|
|
UserID := 0;
|
|
GroupID := 0;
|
|
UncompressedSize := 0;
|
|
{ ModTime }
|
|
LinkFlag := AB_TAR_LF_OLDNORMAL;
|
|
{ Link Name }
|
|
PTarHeader.Magic.gnuOld := AB_TAR_MAGIC_V7_NONE; { Default to GNU type }
|
|
UserName := '';
|
|
GroupName := '';
|
|
DevMajor := 0;
|
|
DevMinor := 0;
|
|
{ TODO: atime, ctime }
|
|
FTarItem.ItemType := SUPPORTED_ITEM;
|
|
FTarItem.Dirty := True; { Checksum needs to be generated }
|
|
FTarItem.ItemReadOnly := False;
|
|
end;
|
|
|
|
destructor TAbTarItem.Destroy;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
if Assigned(FTarHeaderList) then
|
|
begin
|
|
for i := 0 to FTarHeaderList.Count - 1 do
|
|
FreeMem(FTarHeaderList.Items[i]); { This list holds PAbTarHeaderRec's }
|
|
FTarHeaderList.Free;
|
|
end;
|
|
FTarHeaderTypeList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TAbTarItem.GetCompressedSize: Int64;
|
|
{ TAR includes no internal compression, returns same value as GetUncompressedSize }
|
|
begin
|
|
Result := FTarItem.Size;
|
|
end;
|
|
|
|
function TAbTarItem.GetDevMajor: Integer;
|
|
begin
|
|
Result := FTarItem.DevMajor;
|
|
end;
|
|
|
|
function TAbTarItem.GetDevMinor: Integer;
|
|
begin
|
|
Result := FTarItem.DevMinor;
|
|
end;
|
|
|
|
function TAbTarItem.GetExternalFileAttributes: LongWord;
|
|
begin
|
|
Result := FTarItem.Mode;
|
|
end;
|
|
|
|
function TAbTarItem.GetFileName: string;
|
|
begin
|
|
Result := FTarItem.Name; { Inherited String from Parent Class }
|
|
end;
|
|
|
|
function TAbTarItem.GetGroupID: Integer;
|
|
begin
|
|
Result := FTarItem.gid;
|
|
end;
|
|
|
|
function TAbTarItem.GetGroupName: string;
|
|
begin
|
|
Result := FTarItem.GrpName;
|
|
end;
|
|
|
|
function TAbTarItem.GetIsDirectory: Boolean;
|
|
begin
|
|
Result := (LinkFlag = AB_TAR_LF_DIR);
|
|
end;
|
|
|
|
function TAbTarItem.GetIsEncrypted: Boolean;
|
|
begin
|
|
{ TAR has no native encryption }
|
|
Result := False;
|
|
end;
|
|
|
|
function TAbTarItem.GetLastModFileDate: Word;
|
|
begin
|
|
{ convert to local DOS file Date }
|
|
Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Hi;
|
|
end;
|
|
|
|
function TAbTarItem.GetLastModFileTime: Word;
|
|
begin
|
|
{ convert to local DOS file Time }
|
|
Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Lo;
|
|
end;
|
|
|
|
function TAbTarItem.GetLastModTimeAsDateTime: TDateTime;
|
|
begin
|
|
Result := AbUnixTimeToLocalDateTime(FTarItem.ModTime);
|
|
end;
|
|
|
|
function TAbTarItem.GetLinkName: string;
|
|
begin
|
|
Result := FTarItem.LinkName;
|
|
end;
|
|
|
|
function TAbTarItem.GetMagic: string;
|
|
begin
|
|
Result := string(FTarItem.Magic);
|
|
end;
|
|
|
|
function TAbTarItem.GetNativeFileAttributes : LongInt;
|
|
begin
|
|
Result := GetExternalFileAttributes;
|
|
{$IFDEF MSWINDOWS}
|
|
Result := AbUnix2DosFileAttributes(Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TAbTarItem.GetUncompressedSize: Int64;
|
|
{ TAR includes no internal compression, returns same value as GetCompressedSize }
|
|
begin
|
|
Result := FTarItem.Size;
|
|
end;
|
|
|
|
function TAbTarItem.GetUserID: Integer;
|
|
begin
|
|
Result := FTarItem.uid;
|
|
end;
|
|
|
|
function TAbTarItem.GetUserName: string;
|
|
begin
|
|
Result := FTarItem.UsrName;
|
|
end;
|
|
|
|
function TAbTarItem.GetModTime: Int64;
|
|
begin
|
|
Result := FTarItem.ModTime;
|
|
end;
|
|
|
|
{ Get Number of tar headers currently for this item }
|
|
function TAbTarItem.GetNumHeaders: Integer;
|
|
begin
|
|
Result := FTarHeaderList.Count;
|
|
end;
|
|
|
|
{ Takes data from Supported Header types stored in TAbTarItem.FTarHeaderList }
|
|
{ and updates values in the TAbTarItem.FTarItem.X }
|
|
|
|
procedure TAbTarItem.DetectHeaderFormat;
|
|
begin
|
|
if FTarItem.ArchiveFormat <> UNKNOWN_FORMAT then
|
|
Exit;{ We have already set the format. }
|
|
{ In the previous header parsing if pax headers are detected the format is changed }
|
|
{ GNU_FORMAT is detected by the presence of GNU extended headers. }
|
|
|
|
{ These detections are similar to GNU tar's. }
|
|
if (PTarHeader.Magic.value = AB_TAR_MAGIC_VAL) then
|
|
begin { We have one of three types, STAR_FORMAT, USTAR_FORMAT, POSIX_FORMAT }
|
|
{ Detect STAR format. Leave disabled until explicit STAR support is added. }
|
|
{if (PTarHeader.star.Prefix[130] = #00) and
|
|
(PTarHeader.star.Atime[0] in ['0'..'7']) and
|
|
(PTarHeader.star.Atime[11] = #20) and
|
|
(PTarHeader.star.Ctime[0]in ['0'..'7']) and
|
|
(PTarHeader.star.Ctime[11] = #20) then
|
|
begin
|
|
FTarItme.ArchiveType := STAR_FORMAT;
|
|
end }
|
|
{ else if } { POSIX uses the existance of x headers }
|
|
|
|
{ This can define false positives, Pax headers/ STAR format could be detected as this }
|
|
FTarItem.ArchiveFormat := USTAR_FORMAT;
|
|
end
|
|
else if (PTarHeader.Magic.gnuOld = AB_TAR_MAGIC_GNUOLD) then
|
|
begin
|
|
FTarItem.ArchiveFormat := OLDGNU_FORMAT;
|
|
end
|
|
else { V7 uses AB_TAR_LF_OLDNORMAL linkflag, has no magic field & no Usr/Grp Names }
|
|
begin
|
|
FTarItem.ArchiveFormat := V7_FORMAT; { Lowest Common Denominator }
|
|
end;
|
|
end;
|
|
|
|
{ Extract the file name from the headers }
|
|
procedure TAbTarItem.GetFileNameFromHeaders;
|
|
var
|
|
I, J : Integer;
|
|
PHeader: PAbTarHeaderRec;
|
|
FoundName: Boolean;
|
|
NameLength : Int64;
|
|
NumMHeaders: integer;
|
|
ExtraName: integer;
|
|
RawFileName, TempStr: AnsiString;
|
|
begin
|
|
{ UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT }
|
|
FoundName := False;
|
|
I := 0;
|
|
while (not FoundName) and (I <= (FTarHeaderList.Count - 1)) do
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
if PHeader.LinkFlag = AB_TAR_LF_LONGNAME then
|
|
begin
|
|
FoundName := True;
|
|
RawFileName := '';
|
|
NameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));
|
|
NumMHeaders := NameLength div AB_TAR_RECORDSIZE;
|
|
ExtraName := NameLength mod AB_TAR_RECORDSIZE; { Chars in the last Header }
|
|
{ NumMHeaders should never be zero }
|
|
{ It appears that it is not null terminated in the blocks }
|
|
for J := 1 to NumMHeaders do
|
|
begin
|
|
{ Copy entire content of Header to String }
|
|
PHeader := FTarHeaderList.Items[I+J];
|
|
SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE);
|
|
RawFileName := RawFileName + TempStr;
|
|
end;
|
|
if ExtraName <> 0 then
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I+NumMHeaders+1];
|
|
SetString(TempStr, PAnsiChar(PHeader), ExtraName-1);
|
|
RawFileName := RawFileName + TempStr;
|
|
end
|
|
else { We already copied the entire name, but the string is still null terminated. }
|
|
begin
|
|
{ Removed the last zero }
|
|
SetLength(RawFileName, (Length(RawFileName)-1));
|
|
end;
|
|
end { end long filename link flag }
|
|
else
|
|
I := I + 1;
|
|
end; { End While }
|
|
|
|
if not FoundName then
|
|
begin
|
|
if (FTarItem.ArchiveFormat = USTAR_FORMAT) and
|
|
(PTarHeader.ustar.Prefix[0] <> #0) then
|
|
RawFileName := PTarHeader.ustar.Prefix+'/'+PTarHeader.Name
|
|
else
|
|
{ V7_FORMAT, OLDGNU_FORMAT }
|
|
RawFileName := PTarHeader.Name;
|
|
end; { End not FoundName }
|
|
|
|
FTarItem.Name := AbRawBytesToString(RawFileName);
|
|
end;
|
|
|
|
{ Extract the file name from the headers }
|
|
procedure TAbTarItem.GetLinkNameFromHeaders;
|
|
var
|
|
I, J : Integer;
|
|
PHeader: PAbTarHeaderRec;
|
|
FoundName: Boolean;
|
|
NameLength : Int64;
|
|
NumMHeaders: integer;
|
|
ExtraName: integer;
|
|
RawLinkName, TempStr: AnsiString;
|
|
begin
|
|
{ UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT }
|
|
PHeader := nil;
|
|
FoundName := False;
|
|
I := 0;
|
|
{ Note that: FTarHeaderList.Count <= 1, always }
|
|
while (not FoundName) and (I <= (FTarHeaderList.Count - 1)) do
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
if PHeader.LinkFlag = AB_TAR_LF_LONGLINK then
|
|
begin
|
|
FoundName := True;
|
|
RawLinkName := '';
|
|
NameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));
|
|
NumMHeaders := NameLength div AB_TAR_RECORDSIZE;
|
|
ExtraName := NameLength mod AB_TAR_RECORDSIZE; { Chars in the last Header }
|
|
{ NumMHeaders should never be zero }
|
|
{ It appears that it is not null terminated in the blocks }
|
|
for J := 1 to NumMHeaders do
|
|
begin
|
|
{ Copy entire content of Header to String }
|
|
PHeader := FTarHeaderList.Items[I+J];
|
|
SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE);
|
|
RawLinkName := RawLinkName + TempStr;
|
|
end;
|
|
if ExtraName <> 0 then
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I+NumMHeaders+1];
|
|
SetString(TempStr, PAnsiChar(PHeader), ExtraName-1);
|
|
RawLinkName := RawLinkName + TempStr;
|
|
end
|
|
else { We already copied the entire name, but the string is still null terminated. }
|
|
begin
|
|
{ Removed the last zero }
|
|
SetLength(RawLinkName, (Length(RawLinkName)-1));
|
|
end;
|
|
end { end long filename link flag }
|
|
else
|
|
I := I + 1;
|
|
end; { End While }
|
|
|
|
if not FoundName then
|
|
RawLinkName := PHeader.LinkName;
|
|
|
|
FTarItem.LinkName := AbRawBytesToString(RawLinkName);
|
|
end;
|
|
|
|
{ Return True if CheckSum passes out. }
|
|
function TAbTarItem.TestCheckSum : Boolean;
|
|
var
|
|
TarChkSum : LongInt;
|
|
TarChkSumArr : Arr8; { ChkSum field is Arr8 }
|
|
PHeader: PAbTarHeaderRec;
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
{ Check sums are in valid headers but NOT in the data headers. }
|
|
for I := 0 to FTarHeaderList.Count - 1 do
|
|
begin
|
|
if TAbTarHeaderType(FTarHeaderTypeList.Items[I]) in [FILE_HEADER, META_DATA_HEADER] then
|
|
begin
|
|
PHeader := FTarHeaderList.Items[i];
|
|
{ Save off old Check sum }
|
|
Move(PHeader.ChkSum, TarChkSumArr, SizeOf(PHeader.ChkSum));
|
|
TarChkSum := OctalToInt(TarChkSumArr, SizeOf(TarChkSumArr));
|
|
{ Set to Generator Value }
|
|
PHeader.ChkSum := AB_TAR_CHKBLANKS;
|
|
if CalcTarHeaderChkSum(PHeader^) <> TarChkSum then
|
|
Result := False; { Pass unless one miss-compares }
|
|
{ Save back old checksum }
|
|
Move(TarChkSumArr, PHeader.ChkSum, SizeOf(TarChkSumArr));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TAbTarItem.ParseTarHeaders;
|
|
begin
|
|
{ The final index is the Item index }
|
|
DetectHeaderFormat;
|
|
{ Long term this parsing is not correct, as the values in extended headers
|
|
override the later values in this header }
|
|
FTarItem.Mode := OctalToInt(PTarHeader.Mode, SizeOf(PTarHeader.Mode));
|
|
FTarItem.uid := OctalToInt(PTarHeader.uid, SizeOf(PTarHeader.uid)); { Extended in PAX Headers }
|
|
FTarItem.gid := OctalToInt(PTarHeader.gid, SizeOf(PTarHeader.gid)); { Extended in PAX Headers }
|
|
FTarItem.Size := OctalToInt(PTarHeader.Size, SizeOf(PTarHeader.Size)); { Extended in PAX Headers }
|
|
{ ModTime should be an Int64 but no tool support, No issues until Feb 6th, 2106 :) }
|
|
{ ModTime is Extended in PAX Headers }
|
|
FTarItem.ModTime := OctalToInt(PTarHeader.ModTime, SizeOf(PTarHeader.ModTime));
|
|
FTarItem.ChkSumPass := TestCheckSum();
|
|
FTarItem.LinkFlag := PTarHeader.LinkFlag;
|
|
GetLinkNameFromHeaders; { Extended in PAX Headers }
|
|
FTarItem.Magic := PTarHeader.Magic.value;
|
|
FTarItem.Version := OctalToInt(PTarHeader.Magic.version, SizeOf(PTarHeader.Magic.version));
|
|
FTarItem.UsrName := string(PTarHeader.UsrName); { Extended in PAX Headers }
|
|
FTarItem.GrpName := string(PTarHeader.GrpName); { Extended in PAX Headers }
|
|
FTarItem.DevMajor := OctalToInt(PTarHeader.DevMajor, SizeOf(PTarHeader.DevMajor));
|
|
FTarItem.DevMinor := OctalToInt(PTarHeader.DevMinor, SizeOf(PTarHeader.DevMinor));
|
|
GetFileNameFromHeaders;
|
|
{ FTarItem.ArchiveFormat; Already stuffed }
|
|
{ FTarItem.StreamPosition: Already Stuffed }
|
|
{ FTarItem.Dirty; Stuffed upon creaction }
|
|
end;
|
|
|
|
procedure TAbTarItem.LoadTarHeaderFromStream(AStream: TStream);
|
|
var
|
|
NumMHeaders : Integer;
|
|
I : Integer;
|
|
FoundItem : Boolean;
|
|
begin
|
|
{ Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }
|
|
{ We should expect FindNext/FirstItem, and next check for bounds. }
|
|
if FTarHeaderList.Count > 0 then
|
|
begin { We're Going to stomp over the headers that are already present }
|
|
{ We need to destory the memory we've used }
|
|
PTarHeader := nil;
|
|
for i := 0 to FTarHeaderList.Count - 1 do
|
|
FreeMem(FTarHeaderList.Items[i]); { This list holds PAbTarHeaderRec's }
|
|
FTarHeaderList.Clear;
|
|
FTarHeaderTypeList.Clear;
|
|
FTarItem.FileHeaderCount := 0;
|
|
{ All pointers should now be removed from those headers }
|
|
end;
|
|
{ Now lets start filling up that list. }
|
|
FTarItem.ItemType := UNKNOWN_ITEM; { We don't know what we have yet }
|
|
FoundItem := False;
|
|
while not FoundItem do
|
|
begin
|
|
{ Create a Header to be Stored in the Items List }
|
|
GetMem(PTarHeader, AB_TAR_RECORDSIZE);
|
|
AStream.ReadBuffer(PTarHeader^, AB_TAR_RECORDSIZE);
|
|
FTarHeaderList.Add(PTarHeader); { Store the Header to the list }
|
|
{ Parse header based on LinkFlag }
|
|
if PTarHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then
|
|
begin { This Header type is in the Set of un/supported Meta data type headers }
|
|
if PTarHeader.LinkFlag in AB_UNSUPPORTED_MD_HEADERS then
|
|
FTarItem.ItemReadOnly := True; { We don't fully support this meta-data type }
|
|
if (PTarHeader.LinkFlag in AB_PAX_MD_HEADERS) and (PTarHeader.Magic.value = AB_TAR_MAGIC_VAL) then
|
|
FTarItem.ArchiveFormat := POSIX_FORMAT; { We have a POSIX_FORMAT, has x headers, and Magic matches }
|
|
if PTarHeader.LinkFlag in AB_GNU_MD_HEADERS then
|
|
FTarItem.ArchiveFormat := OLDGNU_FORMAT; { We have a OLDGNU_FORMAT, has L/K headers }
|
|
{ There can be a unknown number of Headers of data }
|
|
{ We are for sure going to read at least one more header, but are we going to read more than that? }
|
|
FTarHeaderTypeList.Add(Pointer(META_DATA_HEADER));
|
|
NumMHeaders := Ceil(OctalToInt(PTarHeader.Size, SizeOf(PTarHeader.Size)) / AB_TAR_RECORDSIZE);
|
|
{ NumMHeasder should never be zero }
|
|
for I := 1 to NumMHeaders do
|
|
begin
|
|
GetMem(PTarHeader, AB_TAR_RECORDSIZE); { Create a new Header }
|
|
AStream.ReadBuffer(PTarHeader^, AB_TAR_RECORDSIZE); { Get the Meta Data }
|
|
FTarHeaderList.Add(PTarHeader); { Store the Header to the list }
|
|
FTarHeaderTypeList.Add(Pointer(MD_DATA_HEADER));
|
|
end;
|
|
{ Loop and reparse }
|
|
end
|
|
else if PTarHeader.LinkFlag in AB_SUPPORTED_F_HEADERS then
|
|
begin { This Header type is in the Set of supported File type Headers }
|
|
FoundItem := True; { Exit Criterion }
|
|
FTarItem.ItemType := SUPPORTED_ITEM;
|
|
if FTarItem.ItemReadOnly then { Since some of the Headers are read only. }
|
|
FTarItem.ItemType := UNSUPPORTED_ITEM; { This Item is unsupported }
|
|
FTarHeaderTypeList.Add(Pointer(FILE_HEADER));
|
|
end
|
|
else if PTarHeader.LinkFlag in AB_UNSUPPORTED_F_HEADERS then
|
|
begin { This Header type is in the Set of unsupported File type Headers }
|
|
FoundItem := True; { Exit Criterion }
|
|
FTarItem.ItemType := UNSUPPORTED_ITEM;
|
|
FTarHeaderTypeList.Add(Pointer(FILE_HEADER));
|
|
end
|
|
else { These are unknown header types }
|
|
begin { Note: Some of these unknown types could have known Meta-data headers }
|
|
FoundItem := True;
|
|
FTarItem.ItemType := UNKNOWN_ITEM;
|
|
FTarHeaderTypeList.Add(Pointer(UNKNOWN_HEADER));
|
|
end;{ end LinkFlag parsing }
|
|
end; { end Found Item While }
|
|
{ PTarHeader points to FTarHeaderList.Items[FTarHeaderList.Count-1]; }
|
|
|
|
{ Re-wind the Stream back to the begining of this Item inc. all headers }
|
|
AStream.Seek(-(FTarHeaderList.Count*AB_TAR_RECORDSIZE), soCurrent);
|
|
{ AStream.Position := FTarItem.StreamPosition; } { This should be equivalent as above }
|
|
FTarItem.FileHeaderCount := FTarHeaderList.Count;
|
|
if FTarItem.ItemType <> UNKNOWN_ITEM then
|
|
begin
|
|
ParseTarHeaders; { Update FTarItem values }
|
|
FFileName := FTarItem.Name; {FTarHeader.Name;}
|
|
FDiskFileName := FileName;
|
|
AbUnfixName(FDiskFileName);
|
|
end;
|
|
Action := aaNone;
|
|
Tagged := False;
|
|
end;
|
|
|
|
|
|
{ ****************** BEGIN SET ********************** }
|
|
|
|
procedure TAbTarItem.SaveTarHeaderToStream(AStream: TStream);
|
|
var
|
|
i : Integer;
|
|
j : Integer;
|
|
PHeader : PAbTarHeaderRec;
|
|
HdrChkSum : Integer;
|
|
HdrChkStr : AnsiString;
|
|
HdrBuffer : PAnsiChar;
|
|
SkipNextChkSum: Integer;
|
|
SkipChkSum: Boolean;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }
|
|
if FTarItem.Dirty then
|
|
SkipNextChkSum := 0
|
|
else
|
|
SkipNextChkSum := FTarHeaderList.Count; { Don't recalc any chkSums }
|
|
|
|
{ The first header in the Item list must have a checksum calculation }
|
|
for i := 0 to (FTarHeaderList.Count-1) do
|
|
begin
|
|
SkipChkSum := False;
|
|
PHeader := FTarHeaderList.Items[i];
|
|
if (SkipNextChkSum = 0) then
|
|
begin { We need to parse this header }
|
|
if PHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then
|
|
begin { We have a Meta-Data Header, Calculate how many headers to skip. }
|
|
{ These meta-data headers have non-Header buffers after this Header }
|
|
SkipNextChkSum := Ceil(OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE);
|
|
{ Ceil will mandate one run through, and will handle 512 correctly }
|
|
end
|
|
else if PHeader.LinkFlag in AB_SUPPORTED_F_HEADERS then
|
|
begin
|
|
SkipNextChkSum := 0;
|
|
end
|
|
else
|
|
begin { Un-Supported Header type, Copy but do nothing to the data }
|
|
SkipNextChkSum := 0;
|
|
SkipChkSum := True;
|
|
end;{ end LinkFlag parsing }
|
|
end
|
|
else
|
|
begin { Do not calcuate the check sum on this meta Data header buffer }
|
|
SkipNextChkSum := SkipNextChkSum - 1;
|
|
SkipChkSum := True;
|
|
end;{ end SkipNextChkSum }
|
|
|
|
if not SkipChkSum then
|
|
begin { We are Calculating the Checksum for this Header }
|
|
{Tar ChkSum is "odd" The check sum field is filled with #20 chars as empty }
|
|
{ ChkSum field itself is #20'd and has an effect on the sum }
|
|
PHeader.ChkSum := AB_TAR_CHKBLANKS;
|
|
{ Set up the buffers }
|
|
HdrBuffer := PAnsiChar(PHeader);
|
|
HdrChkSum := 0;
|
|
{ Calculate the checksum, a simple sum of the bytes in the header }
|
|
for j := 0 to (AB_TAR_RECORDSIZE-1) do
|
|
HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]);
|
|
{ set the checksum in the header }
|
|
HdrChkStr := PadString(IntToOctal(HdrChkSum), SizeOf(PHeader.ChkSum));
|
|
Move(HdrChkStr[1], PHeader.ChkSum, Length(HdrChkStr));
|
|
end; { end Skip Check Sum }
|
|
{ write header to the file }
|
|
AStream.Write(PHeader^, AB_TAR_RECORDSIZE);
|
|
end; { End for the number of headers in the list }
|
|
{ Updated here as the stream is now updated to the latest number of headers }
|
|
FTarItem.FileHeaderCount := FTarHeaderList.Count;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetCompressedSize(const Value: Int64);
|
|
var
|
|
S : AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Size is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }
|
|
FTarItem.Size := Value; { Store our Vitrual Copy }
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header }
|
|
Move(S[1], PTarHeader.Size, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetDevMajor(const Value: Integer);
|
|
var
|
|
S : AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Dev Major and Minor are Only used for AB_TAR_LF_CHR, AB_TAR_LF_BLK }
|
|
{ Otherwise they are stuffed with #00 }
|
|
FTarItem.DevMajor := Value; { Store to the struct }
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr8));
|
|
Move(S[1], PTarHeader.DevMajor, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetDevMinor(const Value: Integer);
|
|
var
|
|
S : AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Dev Major and Minor are Only used for AB_TAR_LF_CHR, AB_TAR_LF_BLK }
|
|
{ Otherwise they are stuffed with #00 }
|
|
FTarItem.DevMinor := Value;
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr8));
|
|
Move(S[1], PTarHeader.DevMinor, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetExternalFileAttributes(Value: LongWord);
|
|
var
|
|
S : AnsiString;
|
|
I: Integer;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
FTarItem.Mode := Value;
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr8));
|
|
for I := 0 to FTarHeaderList.Count - 1 do
|
|
if TAbTarHeaderType(FTarHeaderTypeList.Items[I]) in [FILE_HEADER, META_DATA_HEADER] then
|
|
Move(S[1], PAbTarHeaderRec(FTarHeaderList.Items[I]).Mode, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
{ Add/Remove Headers as needed To/From Existing GNU Long (Link/Name) TarItems }
|
|
procedure TAbTarItem.DoGNUExistingLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);
|
|
var
|
|
PHeader: PAbTarHeaderRec;
|
|
J: Integer;
|
|
OldNameLength: Integer;
|
|
TotalOldNumHeaders: Integer;
|
|
TotalNewNumHeaders: Integer;
|
|
NumHeaders: Integer;
|
|
ExtraName: Integer;
|
|
tempStr: AnsiString;
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
|
|
{ Need this data from the old header }
|
|
OldNameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));{ inlcudes Null termination }
|
|
{ Length(FTarItem.Name)+1 = OldNameLength; }{ This should be true, always }
|
|
|
|
{ Save off the new Length, so we don't have to change the pointers later. }
|
|
tempStr := PadString(IntToOctal(Length(Value)+1), SizeOf(PHeader.Size));
|
|
Move(tempStr[1], PHeader.Size, Length(tempStr));
|
|
|
|
TotalOldNumHeaders := Ceil(OldNameLength / AB_TAR_RECORDSIZE);
|
|
TotalNewNumHeaders := Ceil((Length(Value)+1) / AB_TAR_RECORDSIZE);{ Null terminated }
|
|
{Length(Value)+1: 1-512 = 1, 513-1024 = 2 ... }
|
|
J := TotalOldNumHeaders - TotalNewNumHeaders;
|
|
while J <> 0 do
|
|
begin
|
|
if J > 0 then
|
|
begin { Old > New, Have to many Headers, Remove }
|
|
FreeMem(FTarHeaderList.Items[I+J]); { Free the Memory for the extra Header }
|
|
FTarHeaderList.Delete(I+J); { Delete the List index }
|
|
FTarHeaderTypeList.Delete(I+J);
|
|
J := J - 1;
|
|
end
|
|
else { if J < 0 then }
|
|
begin { Old < New, Need more Headers, Insert }
|
|
GetMem(PHeader, AB_TAR_RECORDSIZE);
|
|
FTarHeaderList.Insert(I+1,PHeader);{ Insert: Inserts at index }
|
|
FTarHeaderTypeList.Insert(I+1,Pointer(MD_DATA_HEADER));{ We are only adding MD Data headers here }
|
|
J := J + 1;
|
|
end;
|
|
end;{ end numHeaders while }
|
|
{ Yes, GNU Tar adds a Nil filled MD data header if Length(Value) mod AB_TAR_RECORDSIZE = 0 }
|
|
NumHeaders := (Length(Value)+1) div AB_TAR_RECORDSIZE; { Include Null terminator }
|
|
ExtraName := (Length(Value)+1) mod AB_TAR_RECORDSIZE; { Chars in the last Header }
|
|
{ Now we have the number of headers set up, stuff the name in the Headers }
|
|
TempStr := AnsiString(Value);
|
|
for J := 1 to NumHeaders do
|
|
begin
|
|
{ Copy entire next AB_TAR_RECORDSIZE bytes of tempString to content of Header }
|
|
{ There may only be AB_TAR_RECORDSIZE-1 bytes if this is the last rounded header }
|
|
PHeader := FTarHeaderList.Items[I+J];
|
|
Move(TempStr[1], PHeader^, AB_TAR_RECORDSIZE);
|
|
if Length(TempStr) >= AB_TAR_RECORDSIZE then
|
|
Delete(TempStr, 1, AB_TAR_RECORDSIZE);{ Crop string }
|
|
end;
|
|
if ExtraName <> 0 then
|
|
begin
|
|
{ Copy whatever is left in tempStr into the rest of the buffer }
|
|
PHeader := FTarHeaderList.Items[I+NumHeaders+1];
|
|
FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block }
|
|
Move(TempStr[1], PHeader^, ExtraName-1); { The string is null terminated }
|
|
end
|
|
else { We already copied the entire name, but it must be null terminated }
|
|
begin
|
|
FillChar(Pointer(PtrInt(PHeader)+AB_TAR_RECORDSIZE-1)^, 1, #0); { Zero rest of the block }
|
|
end;
|
|
|
|
{ Finally we need to stuff the file type Header. }
|
|
{ Note: Value.length > AB_TAR_NAMESIZE(100) }
|
|
if LinkFlag = AB_TAR_LF_LONGNAME then
|
|
Move(Value[1], PTarHeader.Name, AB_TAR_NAMESIZE)
|
|
else
|
|
Move(Value[1], PTarHeader.LinkName, AB_TAR_NAMESIZE);
|
|
end;
|
|
|
|
|
|
{ Always inserts the L/K Headers at index 0+ }
|
|
procedure TAbTarItem.DoGNUNewLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);
|
|
var
|
|
PHeader: PAbTarHeaderRec;
|
|
J: Integer;
|
|
NumHeaders: Integer;
|
|
ExtraName: Integer;
|
|
tempStr: AnsiString;
|
|
begin
|
|
{ We have a GNU_FORMAT, and no L/K Headers.}
|
|
{ Add a new MD Header and MD Data Headers }
|
|
{ Make an L/K header }
|
|
GetMem(PHeader, AB_TAR_RECORDSIZE);
|
|
FTarHeaderList.Insert(I, PHeader);{ Insert: Inserts at base index }
|
|
FTarHeaderTypeList.Insert(I, Pointer( META_DATA_HEADER));{ This is the L/K Header }
|
|
FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block }
|
|
AbStrPCopy(PHeader.Name, AB_TAR_L_HDR_NAME); { Stuff L/K String Name }
|
|
AbStrPCopy(PHeader.Mode, AB_TAR_L_HDR_ARR8_0); { Stuff zeros }
|
|
AbStrPCopy(PHeader.uid, AB_TAR_L_HDR_ARR8_0); { Stuff zeros }
|
|
AbStrPCopy(PHeader.gid, AB_TAR_L_HDR_ARR8_0); { Stuff zeros }
|
|
tempStr := PadString(IntToOctal(Length(Value)+1), SizeOf(PHeader.Size)); { Stuff Size }
|
|
Move(tempStr[1], PHeader.Size, Length(tempStr));
|
|
AbStrPCopy(PHeader.ModTime, AB_TAR_L_HDR_ARR12_0); { Stuff zeros }
|
|
{ Check sum will be calculated as the Dirty flag is in caller. }
|
|
PHeader.LinkFlag := LinkFlag; { Stuff Link FlagSize }
|
|
AbStrPCopy(PHeader.Magic.gnuOld, AB_TAR_MAGIC_GNUOLD); { Stuff the magic }
|
|
AbStrPCopy(PHeader.UsrName, AB_TAR_L_HDR_USR_NAME);
|
|
AbStrPCopy(PHeader.GrpName, AB_TAR_L_HDR_GRP_NAME);
|
|
{ All else stays as Zeros. }
|
|
{ Completed with L/K Header }
|
|
|
|
{ OK, now we need to add the proper number of MD Data Headers, and intialize to new name }
|
|
{ Yes, GNU Tar adds an extra Nil filled MD data header if Length(Value) mod AB_TAR_RECORDSIZE = 0 }
|
|
NumHeaders := Ceil((Length(Value)+1) / AB_TAR_RECORDSIZE); { Include Null terminator }
|
|
ExtraName := (Length(Value)+1) mod AB_TAR_RECORDSIZE; { Chars in the last Header }
|
|
{ Now we have the number of headers set up, stuff the name in the Headers }
|
|
TempStr := AnsiString(Value);
|
|
for J := 1 to NumHeaders-1 do
|
|
begin
|
|
{ Make a buffer, and copy entire next AB_TAR_RECORDSIZE bytes of tempStr to content of Header }
|
|
{ There may only be AB_TAR_RECORDSIZE-1 bytes if this is the last rounded header }
|
|
GetMem(PHeader, AB_TAR_RECORDSIZE);
|
|
FTarHeaderList.Insert(J+I, PHeader);
|
|
FTarHeaderTypeList.Insert(J+I, Pointer(MD_DATA_HEADER));{ We are adding MD Data headers here }
|
|
Move(TempStr[1], PHeader^, AB_TAR_RECORDSIZE);
|
|
if Length(TempStr) >= AB_TAR_RECORDSIZE then
|
|
Delete(TempStr, 1, AB_TAR_RECORDSIZE);{ Crop string }
|
|
end;
|
|
if ExtraName <> 0 then
|
|
begin
|
|
{ Copy what ever is left in tempStr into the rest of the buffer }
|
|
{ Create the last MD Data Header }
|
|
GetMem(PHeader, AB_TAR_RECORDSIZE);
|
|
FTarHeaderList.Insert(I+NumHeaders, PHeader);{ Insert: Inserts at base index }
|
|
FTarHeaderTypeList.Insert(I+NumHeaders, Pointer(MD_DATA_HEADER));{ We are only adding MD Data headers here }
|
|
FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block }
|
|
Move(TempStr[1], PHeader^, ExtraName-1); { The string is null terminated in the header }
|
|
end
|
|
else { We already copied the entire name, but it must be null terminated }
|
|
begin
|
|
FillChar(Pointer(PtrInt(PHeader)+AB_TAR_RECORDSIZE-1)^, 1, #0); { Zero rest of the block }
|
|
end;
|
|
|
|
{ Finally we need to stuff the file type Header. }
|
|
{ Note: Value.length > AB_TAR_NAMESIZE(100) }
|
|
if LinkFlag = AB_TAR_LF_LONGNAME then
|
|
Move(Value[1], PHeader.Name, AB_TAR_NAMESIZE)
|
|
else
|
|
Move(Value[1], PHeader.LinkName, AB_TAR_NAMESIZE);
|
|
end;
|
|
|
|
procedure TAbTarItem.SetFileName(const Value: string);
|
|
var
|
|
FoundMetaDataHeader: Boolean;
|
|
PHeader: PAbTarHeaderRec;
|
|
I, J: Integer;
|
|
TotalOldNumHeaders: Integer;
|
|
RawFileName: AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Assume ItemReadOnly is set for all Unsupported Type. }
|
|
|
|
{ Cases:
|
|
New File Name is short, Length <= 100,
|
|
All formats: Zero Name field and move new name to field.
|
|
V7: Work complete, 1 header
|
|
USTAR: zero prefix field, 1 Header
|
|
OLD_GNU & GNU: Remove old name headers, 1 header.
|
|
STAR & PAX: And should not yet get here.
|
|
New File Name is Long, Length >=101
|
|
Note: The Header Parsing sets any V7 to GNU if 'L'/'K" Headers are present
|
|
V7: Raise an exception, as this can NOT be done, no change to header.
|
|
USTAR: if new length <= 254 zero fill header, update name fields, 1 updated Header
|
|
if new Length >= 255 raise an exception, as this can NOT be done, no change to header
|
|
if old was Short, Add files to match format,
|
|
OLD_GNU & GNU: Create new Name header, Add N Headers for name, Update name in file header, update name fields, min 3 headers
|
|
STAR & PAX: And should not yet get here.
|
|
if old was Long,
|
|
OLD_GNU & GNU: Add N Headers for name, Update name in MD header, update name field in File Headers, min 3 headers
|
|
|
|
Add headers to length of new Name Length, update name in file header, update name fields }
|
|
RawFileName := AbStringToUnixBytes(Value);
|
|
{ In all cases zero out the name fields in the File Header. }
|
|
if Length(RawFileName) > AB_TAR_NAMESIZE then begin { Must be null terminated except at 100 char length }
|
|
{ Look for long name meta-data headers already in the archive. }
|
|
FoundMetaDataHeader := False;
|
|
I := 0;
|
|
{ FTarHeaderList.Count <= 1 always }
|
|
while (not FoundMetaDataHeader) and (I <= (FTarHeaderList.Count - 1)) do begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
if PHeader.LinkFlag = AB_TAR_LF_LONGNAME then begin
|
|
{ We are growing or Shriking the Name MD Data fields. }
|
|
FoundMetaDataHeader := True;
|
|
DoGNUExistingLongNameLink(AB_TAR_LF_LONGNAME, I, RawFileName);
|
|
{ Need to copy the Name to the header. }
|
|
FTarItem.Name := Value;
|
|
end
|
|
else
|
|
I := I + 1;
|
|
end; { End While }
|
|
{ MD Headers & MD Data Headers have been stuffed if FoundMetaDataHeader }
|
|
{ Still need to stuff the File type header contents. }
|
|
if not FoundMetaDataHeader then
|
|
begin
|
|
case FTarItem.ArchiveFormat of
|
|
V7_FORMAT: raise EAbTarBadFileName.Create; { File Name to Long }
|
|
USTAR_FORMAT:
|
|
begin
|
|
{ Longest file name is AB_TAR_NAMESIZE(100) chars }
|
|
{ Longest Prefix is AB_TAR_USTAR_PREFIX_SIZE(155) chars }
|
|
{ These two fields are delimted by a '/' char }
|
|
{0123456789012345, Length = 15, NameLength = 5, PrefixLength = 9}
|
|
{ AAAA/BBBB/C.txt, Stored as Name := 'C.txt', Prefix := 'AAAA/BBBB' }
|
|
{ That means Theoretical maximum is 256 for Length(RawFileName) }
|
|
if Length(RawFileName) > (AB_TAR_NAMESIZE+AB_TAR_USTAR_PREFIX_SIZE+1) then { Check the obvious one. }
|
|
raise EAbTarBadFileName.Create; { File Name to Long }
|
|
for I := Length(RawFileName) downto Length(RawFileName)-AB_TAR_NAMESIZE-1 do begin
|
|
if RawFileName[I] = '/' then begin
|
|
if (I <= AB_TAR_USTAR_PREFIX_SIZE+1) and (Length(RawFileName)-I <= AB_TAR_NAMESIZE) then begin
|
|
{ We have a successfull parse. }
|
|
FillChar(PTarHeader.Name, SizeOf(PTarHeader.Name), #0);
|
|
FillChar(PTarHeader.ustar.Prefix, SizeOf(PTarHeader.ustar.Prefix), #0);
|
|
Move(RawFileName[I+1], PTarHeader.Name, Length(RawFileName)-I);
|
|
Move(RawFileName[1], PTarHeader.ustar.Prefix, I);
|
|
break;
|
|
end
|
|
else if (Length(RawFileName)-I > AB_TAR_NAMESIZE) then
|
|
raise EAbTarBadFileName.Create { File Name not splittable }
|
|
{ else continue; }
|
|
end;
|
|
end;{ End for I... }
|
|
end; { End USTAR Format }
|
|
OLDGNU_FORMAT: DoGNUNewLongNameLink(AB_TAR_LF_LONGNAME, 0, RawFileName); {GNU_FORMAT}
|
|
else begin
|
|
{ UNKNOWN_FORMAT, STAR_FORMAT, POSIX_FORMAT }
|
|
raise EAbTarBadOp.Create; { Unknown Archive Format }
|
|
end;{ End of Else for case statement }
|
|
end;{ End of case statement }
|
|
FTarItem.Name := Value;
|
|
end; { if no Meta data header found }
|
|
end { End "name length larger than 100" }
|
|
else
|
|
begin { Short new name, Simple Case Just put it in the Name Field & remove any headers }
|
|
{ PTarHeader Points to the File type Header }
|
|
{ Zero the Name field }
|
|
FillChar(PTarHeader.Name, SizeOf(PTarHeader.Name), #0);
|
|
if FTarItem.ArchiveFormat in [USTAR_FORMAT] then { Zero the prefix field }
|
|
FillChar(PTarHeader.ustar.Prefix, SizeOf(PTarHeader.ustar.Prefix), #0);
|
|
if FTarItem.ArchiveFormat in [GNU_FORMAT, OLDGNU_FORMAT] then
|
|
begin { We may have AB_TAR_LF_LONGNAME Headers to be removed }
|
|
{ Remove long file names Headers if they exist}
|
|
FoundMetaDataHeader := False;
|
|
I := 0;
|
|
while not FoundMetaDataHeader and (I <= (FTarHeaderList.Count - 1)) do
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
if PHeader.LinkFlag in [AB_TAR_LF_LONGNAME] then
|
|
begin { Delete this Header, and the data Headers. }
|
|
FoundMetaDataHeader := True;
|
|
TotalOldNumHeaders := Ceil( OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE);
|
|
for J := TotalOldNumHeaders downto 0 do
|
|
begin { Note 0 will delete the Long Link MD Header }
|
|
FreeMem(FTarHeaderList.Items[I+J]); { This list holds PAbTarHeaderRec's }
|
|
FTarHeaderList.Delete(I+J);
|
|
FTarHeaderTypeList.Delete(I+J);
|
|
end;
|
|
end
|
|
else
|
|
I := I + 1; { Got to next header }
|
|
end;{ End While not found... }
|
|
end; { End if GNU... }
|
|
{ Save off the new name and store to the Header }
|
|
FTarItem.Name := Value;
|
|
{ Must add Null Termination before we store to Header }
|
|
AbStrPLCopy(PTarHeader.Name, RawFileName, AB_TAR_NAMESIZE);
|
|
end;{ End else Short new name,... }
|
|
|
|
{ Update the inherited file names. }
|
|
FFileName := FTarItem.Name;
|
|
DiskFileName := FFileName;
|
|
AbUnfixName(FDiskFileName);
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetGroupID(const Value: Integer);
|
|
var
|
|
S : AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ gid is extendable in PAX Headers, Rember PAX extended Header Over Rule File Headers }
|
|
FTarItem.gid := Value;
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr8));
|
|
Move(S[1], PTarHeader.gid, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetGroupName(const Value: string);
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ GrpName is extendable in PAX Headers, Rember PAX extended Header Over Rule File Headers }
|
|
FTarItem.GrpName := Value;
|
|
AbStrPLCopy(PTarHeader.GrpName, AnsiString(Value), SizeOf(PTarHeader.GrpName));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetIsEncrypted(Value: Boolean);
|
|
begin
|
|
{ do nothing, TAR has no native encryption }
|
|
end;
|
|
|
|
procedure TAbTarItem.SetLastModFileDate(const Value: Word);
|
|
begin
|
|
{ replace date, keep existing time }
|
|
LastModTimeAsDateTime :=
|
|
EncodeDate(
|
|
Value shr 9 + 1980,
|
|
Value shr 5 and 15,
|
|
Value and 31) +
|
|
Frac(LastModTimeAsDateTime);
|
|
end;
|
|
|
|
procedure TAbTarItem.SetLastModFileTime(const Value: Word);
|
|
begin
|
|
{ keep current date, replace time }
|
|
LastModTimeAsDateTime :=
|
|
Trunc(LastModTimeAsDateTime) +
|
|
EncodeTime(
|
|
Value shr 11,
|
|
Value shr 5 and 63,
|
|
Value and 31 shl 1, 0);
|
|
end;
|
|
|
|
procedure TAbTarItem.SetLastModTimeAsDateTime(const Value: TDateTime);
|
|
begin
|
|
// TAR stores always Unix time.
|
|
SetModTime(AbLocalDateTimeToUnixTime(Value)); // also updates headers
|
|
end;
|
|
|
|
procedure TAbTarItem.SetLinkFlag(Value: AnsiChar);
|
|
begin
|
|
if FTarItem.ItemReadOnly then
|
|
Exit;
|
|
FTarItem.LinkFlag := Value;
|
|
PTarHeader.LinkFlag := Value;
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetLinkName(const Value: string);
|
|
var
|
|
FoundMetaDataHeader: Boolean;
|
|
PHeader: PAbTarHeaderRec;
|
|
I, J: Integer;
|
|
TotalOldNumHeaders: Integer;
|
|
RawLinkName: AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Cases:
|
|
New Link Name is short, Length <= 100,
|
|
All formats: Zero Name field and move new name to field.
|
|
V7: Work complete, 1 header
|
|
USTAR: Work complete, 1 Header
|
|
OLD_GNU & GNU: Remove old link headers, 1 header.
|
|
STAR & PAX: And should not yet get here.
|
|
New File Name is Long, Length >=101
|
|
Note: The Header Parsing sets any V7 to GNU if 'L'/'K' Headers are present
|
|
V7: Raise an exception, as this can NOT be done, no change to header.
|
|
USTAR: Raise an exception, as this can NOT be done, no change to header.
|
|
if old was Short, Add files to match format,
|
|
OLD_GNU & GNU: Create new Link header, Add N Headers for name, Update name in file header, update name fields, min 3 headers
|
|
if old was Long,
|
|
OLD_GNU & GNU: Add N Headers for name, Update name in MD header, update name field in File Headers, min 3 headers
|
|
STAR & PAX: And should not yet get here.}
|
|
RawLinkName := AbStringToUnixBytes(Value);
|
|
if Length(RawLinkName) > AB_TAR_NAMESIZE then { Must be null terminated except at 100 char length }
|
|
begin
|
|
{ Look for long name meta-data headers already in the archive. }
|
|
FoundMetaDataHeader := False;
|
|
I := 0;
|
|
{ FTarHeaderList.Count <= 1 always }
|
|
while (not FoundMetaDataHeader) and (I <= (FTarHeaderList.Count - 1)) do begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
if PHeader.LinkFlag = AB_TAR_LF_LONGLINK then
|
|
begin { We are growing or Shriking the Name MD Data fields. }
|
|
FoundMetaDataHeader := True;
|
|
DoGNUExistingLongNameLink(AB_TAR_LF_LONGLINK, I, RawLinkName);
|
|
{ Need to copy the Name to the header. }
|
|
FTarItem.LinkName := Value;
|
|
end
|
|
else
|
|
I := I + 1;
|
|
end; { End While }
|
|
{ MD Headers & MD Data Headers have been stuffed if FoundMetaDataHeader }
|
|
{ Still need to stuff the File type header contents. }
|
|
if not FoundMetaDataHeader then
|
|
begin
|
|
case FTarItem.ArchiveFormat of
|
|
V7_FORMAT: raise EAbTarBadLinkName.Create; { Link Name to Long }
|
|
USTAR_FORMAT: raise EAbTarBadLinkName.Create; { Link Name to Long }
|
|
OLDGNU_FORMAT: DoGNUNewLongNameLink(AB_TAR_LF_LONGLINK, 0, RawLinkName); {GNU_FORMAT}
|
|
else
|
|
begin
|
|
{ UNKNOWN_FORMAT, STAR_FORMAT, POSIX_FORMAT }
|
|
raise EAbTarBadOp.Create; { Unknown Archive Format }
|
|
end;{ End of Else for case statement }
|
|
end;{ End of case statement }
|
|
FTarItem.LinkName := Value;
|
|
end; { if no Meta data header found }
|
|
end { End "name length larger than 100" }
|
|
else
|
|
begin { Short new name, Simple Case Just put it in the Link Field & remove any headers }
|
|
{ PTarHeader Points to the File type Header }
|
|
{ Zero the Link field }
|
|
FillChar(PTarHeader.LinkName, SizeOf(PTarHeader.LinkName), #0);
|
|
if FTarItem.ArchiveFormat in [GNU_FORMAT, OLDGNU_FORMAT] then
|
|
begin { We may have AB_TAR_LF_LONGNAME Headers to be removed }
|
|
{ Remove long file names Headers if they exist}
|
|
FoundMetaDataHeader := False;
|
|
I := 0;
|
|
while not FoundMetaDataHeader and (I <= (FTarHeaderList.Count - 1)) do
|
|
begin
|
|
PHeader := FTarHeaderList.Items[I];
|
|
if PHeader.LinkFlag in [AB_TAR_LF_LONGLINK] then
|
|
begin { Delete this Header, and the data Headers. }
|
|
FoundMetaDataHeader := True;
|
|
TotalOldNumHeaders := Ceil( OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE);
|
|
for J := TotalOldNumHeaders downto 0 do
|
|
begin { Note 0 will delete the Long Link MD Header }
|
|
FreeMem(FTarHeaderList.Items[I+J]); { This list holds PAbTarHeaderRec's }
|
|
FTarHeaderList.Delete(I+J);
|
|
FTarHeaderTypeList.Delete(I+J);
|
|
end;
|
|
end
|
|
else
|
|
I := I + 1; { Got to next header }
|
|
end;{ End While not found... }
|
|
end; { End if GNU... }
|
|
{ Save off the new name and store to the Header }
|
|
FTarItem.LinkName := Value;
|
|
AbStrPLCopy(PTarHeader.LinkName, RawLinkName, AB_TAR_NAMESIZE);
|
|
end;{ End else Short new name,... }
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetMagic(const Value: String);
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
FTarItem.Magic := AnsiString(Value);
|
|
Move(Value[1], PTarHeader.Magic, SizeOf(TAbTarMagicRec));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetUncompressedSize(const Value: Int64);
|
|
var
|
|
S : AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ Size is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }
|
|
FTarItem.Size := Value; { Store our Vitrual Copy }
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header }
|
|
Move(S[1], PTarHeader.Size, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetUserID(const Value: Integer);
|
|
var
|
|
S : AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ uid is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }
|
|
FTarItem.uid := Value;
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr8));
|
|
Move(S[1], PTarHeader.uid, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetUserName(const Value: string);
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ UsrName is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }
|
|
FTarItem.UsrName := Value;
|
|
AbStrPLCopy(PTarHeader.UsrName, AnsiString(Value), SizeOf(PTarHeader.UsrName));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
procedure TAbTarItem.SetModTime(const Value: Int64);
|
|
var
|
|
S: AnsiString;
|
|
begin
|
|
if FTarItem.ItemReadOnly then { Read Only - Do Not Save }
|
|
Exit;
|
|
{ ModTime is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }
|
|
FTarItem.ModTime := Value; { Store our Virtual Copy }
|
|
S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header }
|
|
Move(S[1], PTarHeader.ModTime, Length(S));
|
|
FTarItem.Dirty := True;
|
|
end;
|
|
|
|
|
|
{ ************************** TAbTarStreamHelper ****************************** }
|
|
destructor TAbTarStreamHelper.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ This is slow, use the archive class instead }
|
|
procedure TAbTarStreamHelper.ExtractItemData(AStream: TStream);
|
|
begin
|
|
{ Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }
|
|
if FCurrItemSize <> 0 then
|
|
begin
|
|
{ copy stored data to output }
|
|
AStream.CopyFrom(FStream, FCurrItemSize);
|
|
{reset the stream to the start of the item}
|
|
FStream.Seek(-(FCurrItemPreHdrs*AB_TAR_RECORDSIZE+FCurrItemSize), soCurrent);
|
|
end;
|
|
{ else do nothing }
|
|
end;
|
|
|
|
{ This function Should only be used from LoadArchive, as it is slow. }
|
|
function TAbTarStreamHelper.FindItem: Boolean;
|
|
var
|
|
DataRead : LongInt;
|
|
FoundItem: Boolean;
|
|
SkipHdrs : Integer;
|
|
begin
|
|
{ Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }
|
|
{ Note: Standard LBA size of hard disks is 512 bytes = AB_TAR_RECORDSIZE }
|
|
FoundItem := False;
|
|
{ Getting an new Item reset these numbers }
|
|
FCurrItemSize := 0;
|
|
FCurrItemPreHdrs := 0;
|
|
DataRead := FStream.Read(FTarHeader, AB_TAR_RECORDSIZE); { Read in a header }
|
|
{ DataRead <> AB_TAR_RECORDSIZE means end of stream, and the End Of Archive
|
|
record is all #0's, which the StrLen(FTarHeader.Name) check will catch }
|
|
while (DataRead = AB_TAR_RECORDSIZE) and (AbStrLen(FTarHeader.Name) > 0) and not FoundItem do
|
|
begin { Either exit when we find a supported file or end of file or an invalid header name. }
|
|
if FTarHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then
|
|
begin { We have a un/supported Meta-Data Header }
|
|
{ FoundItem := False } { Value remains False. }
|
|
SkipHdrs := Ceil(OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size))/AB_TAR_RECORDSIZE);
|
|
FStream.Seek(SkipHdrs*AB_TAR_RECORDSIZE, soCurrent);
|
|
{ Tally new Headers: Consumed + Current }
|
|
FCurrItemPreHdrs := FCurrItemPreHdrs + SkipHdrs + 1;
|
|
{ Read our next header, Loop, and re-parse }
|
|
DataRead := FStream.Read(FTarHeader, AB_TAR_RECORDSIZE);
|
|
end
|
|
else if FTarHeader.LinkFlag in (AB_SUPPORTED_F_HEADERS+AB_UNSUPPORTED_F_HEADERS) then
|
|
begin { We have a un/supported File Header. }
|
|
FoundItem := True;
|
|
if not (FTarHeader.LinkFlag in AB_IGNORE_SIZE_HEADERS) then
|
|
FCurrItemSize := OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size))
|
|
else FCurrItemSize := 0; { Per The spec these Headers do not have file content }
|
|
FCurrItemPreHdrs := FCurrItemPreHdrs + 1; { Tally current header }
|
|
end
|
|
else
|
|
begin{ We Have an Unknown header }
|
|
FoundItem := True;
|
|
FCurrItemSize := 0;
|
|
{ We could have many un/supported headers before this unknown type }
|
|
FCurrItemPreHdrs := FCurrItemPreHdrs + 1; { Tally current header }
|
|
{ These Headers should throw exceptions when TAbTarItem.LoadTarHeaderFromStream is called }
|
|
end; { End of Link Flag parsing }
|
|
end;
|
|
{ Rewind to the "The Beginning" of this Item }
|
|
{ Really that means to the first supported Header Type before a supported Item Type }
|
|
if FoundItem then
|
|
FStream.Seek(-(FCurrItemPreHdrs*AB_TAR_RECORDSIZE), soCurrent);
|
|
Result := FoundItem;
|
|
end;
|
|
|
|
{ Should only be used from LoadArchive, as it is slow. }
|
|
function TAbTarStreamHelper.FindFirstItem: Boolean;
|
|
begin
|
|
FStream.Seek(0, soBeginning);
|
|
Result := FindItem;
|
|
end;
|
|
|
|
{ Should only be used from LoadArchive, as it is slow. }
|
|
function TAbTarStreamHelper.FindNextItem: Boolean;
|
|
begin
|
|
{ Fast Forward Past the current Item }
|
|
FStream.Seek((FCurrItemPreHdrs*AB_TAR_RECORDSIZE + RoundToTarBlock(FCurrItemSize)), soCurrent);
|
|
Result := FindItem;
|
|
end;
|
|
|
|
{ This is slow, use the archive class instead }
|
|
function TAbTarStreamHelper.GetItemCount : Integer;
|
|
var
|
|
Found : Boolean;
|
|
begin
|
|
Result := 0;
|
|
Found := FindFirstItem;
|
|
while Found do begin
|
|
Inc(Result);
|
|
Found := FindNextItem;
|
|
end;
|
|
end;
|
|
|
|
procedure TAbTarStreamHelper.ReadHeader;
|
|
begin
|
|
{ do nothing }
|
|
{ Tar archives have no overall header data }
|
|
end;
|
|
|
|
procedure TAbTarStreamHelper.ReadTail;
|
|
begin
|
|
{ do nothing }
|
|
{ Tar archives have no overall tail data }
|
|
end;
|
|
|
|
{ This is slow, use the archive class instead }
|
|
function TAbTarStreamHelper.SeekItem(Index: Integer): Boolean;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
Result := FindFirstItem; { see if can get to first item }
|
|
i := 1;
|
|
while Result and (i < Index) do begin
|
|
Result := FindNextItem;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
procedure TAbTarStreamHelper.WriteArchiveHeader;
|
|
begin
|
|
{ do nothing }
|
|
{ Tar archives have no overall header data }
|
|
end;
|
|
|
|
procedure TAbTarStreamHelper.WriteArchiveItem(AStream: TStream);
|
|
begin
|
|
WriteArchiveItemSize(AStream, AStream.Size);
|
|
end;
|
|
|
|
procedure TAbTarStreamHelper.WriteArchiveItemSize(AStream: TStream; Size: Int64);
|
|
var
|
|
PadBuff : PAnsiChar;
|
|
PadSize : Integer;
|
|
begin
|
|
if Size = 0 then
|
|
Exit;
|
|
{ transfer actual item data }
|
|
FStream.CopyFrom(AStream, Size);
|
|
|
|
{ Pad to Next block }
|
|
PadSize := RoundToTarBlock(Size) - 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 2 terminating null blocks }
|
|
PadSize := AB_TAR_RECORDSIZE;
|
|
GetMem(PadBuff, PadSize);
|
|
try
|
|
FillChar(PadBuff^, PadSize, #0);
|
|
FStream.Write(PadBuff^, PadSize);
|
|
FStream.Write(PadBuff^, PadSize);
|
|
finally
|
|
FreeMem(PadBuff, PadSize);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ ***************************** TAbTarArchive ******************************** }
|
|
constructor TAbTarArchive.CreateFromStream(aStream : TStream; const aArchiveName : string);
|
|
begin
|
|
inherited;
|
|
FArchFormat := V7_FORMAT; // Default for new archives
|
|
end;
|
|
|
|
function TAbTarArchive.CreateItem(const FileSpec: string): TAbArchiveItem;
|
|
var
|
|
Item : TAbTarItem;
|
|
S : String;
|
|
I: Integer;
|
|
begin
|
|
if FArchReadOnly then
|
|
raise EAbTarBadOp.Create; { Create Item Unsupported in this Archive }
|
|
|
|
S := FixName(FileSpec);
|
|
Item := TAbTarItem.Create;
|
|
try
|
|
// HeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT);
|
|
if FArchFormat in [OLDGNU_FORMAT, GNU_FORMAT] then
|
|
begin
|
|
Item.ArchiveFormat := FArchFormat;
|
|
Item.LinkFlag := AB_TAR_LF_NORMAL;
|
|
Item.Magic := AB_TAR_MAGIC_GNUOLD;
|
|
end
|
|
else if FArchFormat in [USTAR_FORMAT] then
|
|
begin
|
|
Item.ArchiveFormat := USTAR_FORMAT;
|
|
Item.LinkFlag := AB_TAR_LF_NORMAL;
|
|
Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER;
|
|
end
|
|
else if (FArchFormat = V7_FORMAT) and (Length(S) > 100) then
|
|
begin { Switch the rep over to GNU so it can have long file names. }
|
|
FArchFormat := OLDGNU_FORMAT;
|
|
Item.ArchiveFormat := OLDGNU_FORMAT;
|
|
{ Leave the Defaults for LinkFlag, and Magic }
|
|
{ Update all the rest so that it can transistion to GNU_FORMAT }
|
|
for I := 0 to FItemList.Count - 1 do
|
|
TAbTarItem(FItemList.Items[i]).ArchiveFormat := OLDGNU_FORMAT;
|
|
end;{ This should not execute... }{
|
|
else if FArchFormat in [STAR_FORMAT, POSIX_FORMAT] then
|
|
begin
|
|
Item.ArchiveFormat := FArchFormat;
|
|
Item.LinkFlag := AB_TAR_LF_NORMAL;
|
|
Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER;
|
|
end;
|
|
}{ else FArchFormat in [ UNKNOWN_FORMAT, V7_FORMAT and Length(S) <= 100 ] } { This is the default. }
|
|
|
|
{ Most others are initialized in the .Create }
|
|
Item.CRC32 := 0;
|
|
{ Note this can raise exceptions for file name lengths. }
|
|
Item.FileName := FixName(FileSpec);
|
|
Item.DiskFileName := ExpandFileName(FileSpec);
|
|
Item.Action := aaNone;
|
|
finally
|
|
Result := Item;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TAbTarArchive.ExtractItemAt(Index: Integer; const UseName: string);
|
|
var
|
|
OutStream : TFileStream;
|
|
CurItem : TAbTarItem;
|
|
begin
|
|
{ Check the index is not out of range. }
|
|
if(Index >= ItemList.Count) then
|
|
raise EListError.CreateFmt(SListIndexError, [Index]);
|
|
|
|
CurItem := TAbTarItem(ItemList[Index]);
|
|
|
|
if CurItem.ItemType in [UNKNOWN_ITEM] then
|
|
raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }
|
|
if (CurItem.ItemType = UNSUPPORTED_ITEM) and
|
|
((Length(CurItem.FileName) >= AB_TAR_NAMESIZE) or
|
|
(Length(CurItem.LinkName) >= AB_TAR_NAMESIZE)) then
|
|
raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }
|
|
{ We will allow extractions if the file name/Link name are strickly less than 100 chars }
|
|
|
|
if CurItem.IsDirectory then
|
|
AbCreateDirectory(UseName)
|
|
else begin
|
|
OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone);
|
|
try
|
|
try {OutStream}
|
|
ExtractItemToStreamAt(Index, OutStream);
|
|
finally {OutStream}
|
|
OutStream.Free;
|
|
end; {OutStream}
|
|
except
|
|
if ExceptObject is EAbUserAbort then
|
|
FStatus := asInvalid;
|
|
DeleteFile(UseName);
|
|
raise;
|
|
end;
|
|
end;
|
|
AbSetFileTime(UseName, CurItem.LastModTimeAsDateTime);
|
|
AbSetFileAttr(UseName, CurItem.NativeFileAttributes);
|
|
end;
|
|
|
|
procedure TAbTarArchive.ExtractItemToStreamAt(Index: Integer;
|
|
aStream: TStream);
|
|
var
|
|
CurItem : TAbTarItem;
|
|
begin
|
|
if(Index >= ItemList.Count) then
|
|
raise EListError.CreateFmt(SListIndexError, [Index]);
|
|
|
|
CurItem := TAbTarItem(ItemList[Index]);
|
|
|
|
if CurItem.ItemType in [UNKNOWN_ITEM] then
|
|
raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }
|
|
if (CurItem.ItemType = UNSUPPORTED_ITEM) and
|
|
((Length(CurItem.FileName) >= AB_TAR_NAMESIZE) or
|
|
(Length(CurItem.LinkName) >= AB_TAR_NAMESIZE)) then
|
|
raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }
|
|
{ We will allow extractions if the file name is strictly less than 100 chars }
|
|
|
|
FStream.Position := CurItem.StreamPosition+CurItem.FileHeaderCount*AB_TAR_RECORDSIZE;
|
|
if CurItem.UncompressedSize <> 0 then
|
|
aStream.CopyFrom(FStream, CurItem.UncompressedSize);
|
|
{ Else there is nothing to copy. }
|
|
end;
|
|
|
|
procedure TAbTarArchive.LoadArchive;
|
|
var
|
|
TarHelp : TAbTarStreamHelper;
|
|
Item : TAbTarItem;
|
|
ItemFound : Boolean;
|
|
Abort : Boolean;
|
|
Confirm : Boolean;
|
|
i : Integer;
|
|
Progress : Byte;
|
|
|
|
begin
|
|
{ create helper }
|
|
TarHelp := TAbTarStreamHelper.Create(FStream);
|
|
try {TarHelp}
|
|
{build Items list from tar header records}
|
|
|
|
{ reset Tar }
|
|
ItemFound := (FStream.Size > 0) and TarHelp.FindFirstItem;
|
|
if ItemFound then FArchFormat := UNKNOWN_FORMAT
|
|
else FArchFormat := V7_FORMAT;
|
|
|
|
{ while more data in Tar }
|
|
while (FStream.Position < FStream.Size) and ItemFound do begin
|
|
{create new Item}
|
|
Item := TAbTarItem.Create;
|
|
Item.FTarItem.StreamPosition := FStream.Position;
|
|
try {Item}
|
|
Item.LoadTarHeaderFromStream(FStream);
|
|
if Item.ItemReadOnly then
|
|
FArchReadOnly := True; { Set Archive as Read Only }
|
|
if Item.ItemType in [SUPPORTED_ITEM, UNSUPPORTED_ITEM] then begin
|
|
{ List of supported Item/File Types. }
|
|
{ Add the New Supported Item to the List }
|
|
if FArchFormat < Item.ArchiveFormat then
|
|
FArchFormat := Item.ArchiveFormat; { Take the max format }
|
|
Item.Action := aaNone;
|
|
FItemList.Add(Item);
|
|
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 := (FStream.Position*100) div FStream.Size;
|
|
DoArchiveProgress(Progress, Abort);
|
|
if Abort then begin
|
|
FStatus := asInvalid;
|
|
raise EAbUserAbort.Create;
|
|
end;
|
|
|
|
{ get the next item }
|
|
ItemFound := TarHelp.FindNextItem;
|
|
except {Item}
|
|
raise EAbTarBadOp.Create; { Invalid Item }
|
|
end; {Item}
|
|
end; {end while }
|
|
|
|
{ All the items need to reflect this information. }
|
|
for i := 0 to FItemList.Count - 1 do
|
|
begin
|
|
TAbTarItem(FItemList.Items[i]).ArchiveFormat := FArchFormat;
|
|
TAbTarItem(FItemList.Items[i]).ItemReadOnly := FArchReadOnly;
|
|
end;
|
|
|
|
DoArchiveProgress(100, Abort);
|
|
FIsDirty := False;
|
|
|
|
finally {TarHelp}
|
|
{ Clean Up }
|
|
TarHelp.Free;
|
|
end; {TarHelp}
|
|
end;
|
|
|
|
|
|
function TAbTarArchive.FixName(const Value: string): string;
|
|
{ fixup filename for storage }
|
|
var
|
|
lValue : string;
|
|
begin
|
|
lValue := Value;
|
|
{$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(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then
|
|
{If not, add the BaseDirectory to the filename.}
|
|
lValue := BaseDirectory + AbPathDelim + lValue;
|
|
end;
|
|
lValue := AbGetShortFileSpec( lValue );
|
|
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( lValue );
|
|
|
|
{ check for a leading slash }
|
|
if lValue[1] = AbPathDelim then
|
|
System.Delete( lValue, 1, 1 );
|
|
|
|
if soStripPath in StoreOptions then
|
|
lValue := ExtractFileName(lValue);
|
|
|
|
if soRemoveDots in StoreOptions then
|
|
AbStripDots(lValue);
|
|
|
|
AbFixName(lValue);
|
|
|
|
Result := lValue;
|
|
end;
|
|
|
|
function TAbTarArchive.GetItem(Index: Integer): TAbTarItem;
|
|
begin
|
|
Result := TAbTarItem(FItemList.Items[Index]);
|
|
end;
|
|
|
|
function TAbTarArchive.GetSupportsEmptyFolders: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TAbTarArchive.PutItem(Index: Integer; const Value: TAbTarItem);
|
|
begin
|
|
//TODO: Remove this from all archives
|
|
FItemList.Items[Index] := Value;
|
|
end;
|
|
|
|
procedure TAbTarArchive.SaveArchive;
|
|
var
|
|
OutTarHelp : TAbTarStreamHelper;
|
|
Abort : Boolean;
|
|
i : Integer;
|
|
NewStream : TAbVirtualMemoryStream;
|
|
TempStream : TStream;
|
|
SaveDir : string;
|
|
CurItem : TAbTarItem;
|
|
AttrEx : TAbAttrExRec;
|
|
begin
|
|
if FArchReadOnly then
|
|
raise EAbTarBadOp.Create; { Archive is read only }
|
|
|
|
{init new archive stream}
|
|
NewStream := TAbVirtualMemoryStream.Create;
|
|
OutTarHelp := TAbTarStreamHelper.Create(NewStream);
|
|
|
|
try {NewStream/OutTarHelp}
|
|
{ create helper }
|
|
NewStream.SwapFileDirectory := FTempDir;
|
|
|
|
{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}
|
|
{ "Seek" to the Item Data } { SaveTarHeaders, Updates FileHeaderCount }
|
|
FStream.Position := CurItem.StreamPosition+CurItem.FileHeaderCount*AB_TAR_RECORDSIZE;
|
|
CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. }
|
|
{ Flush The Headers to the new stream }
|
|
CurItem.SaveTarHeaderToStream(NewStream);
|
|
{ Copy to new Stream, Round to the AB_TAR_RECORDSIZE boundry, and Pad zeros}
|
|
outTarhelp.WriteArchiveItemSize(FStream, CurItem.UncompressedSize);
|
|
end;
|
|
|
|
aaDelete: {doing nothing omits file from new stream} ;
|
|
|
|
aaStreamAdd : begin
|
|
try
|
|
{ adding from a stream }
|
|
CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. }
|
|
CurItem.UncompressedSize := InStream.Size;
|
|
CurItem.SaveTarHeaderToStream(NewStream);
|
|
OutTarHelp.WriteArchiveItemSize(InStream, InStream.Size);
|
|
except
|
|
ItemList[i].Action := aaDelete;
|
|
DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);
|
|
end;
|
|
end;
|
|
|
|
aaAdd, aaFreshen, aaReplace: begin
|
|
try
|
|
{ it's coming from a file }
|
|
GetDir(0, SaveDir);
|
|
try {SaveDir}
|
|
if (BaseDirectory <> '') then
|
|
ChDir(BaseDirectory);
|
|
{ update metadata }
|
|
if not AbFileGetAttrEx(CurItem.DiskFileName, AttrEx) then
|
|
raise EAbFileNotFound.Create;
|
|
CurItem.ExternalFileAttributes := AttrEx.Mode;
|
|
CurItem.LastModTimeAsDateTime := AttrEx.Time;
|
|
{ TODO: uid, gid, uname, gname should be added here }
|
|
{ TODO: Add support for different types of files here }
|
|
if (AttrEx.Mode and AB_FMODE_DIR) <> 0 then begin
|
|
CurItem.LinkFlag := AB_TAR_LF_DIR;
|
|
CurItem.UncompressedSize := 0;
|
|
CurItem.SaveTarHeaderToStream(NewStream);
|
|
end
|
|
else begin
|
|
TempStream := TFileStream.Create(CurItem.DiskFileName,
|
|
fmOpenRead or fmShareDenyWrite );
|
|
try { TempStream }
|
|
CurItem.UncompressedSize := TempStream.Size;
|
|
CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. }
|
|
CurItem.SaveTarHeaderToStream(NewStream);
|
|
OutTarHelp.WriteArchiveItemSize(TempStream, TempStream.Size);
|
|
finally { TempStream }
|
|
TempStream.Free;
|
|
end; { TempStream }
|
|
end;
|
|
finally {SaveDir}
|
|
ChDir( SaveDir );
|
|
end; {SaveDir}
|
|
except
|
|
ItemList[i].Action := aaDelete;
|
|
DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);
|
|
end;
|
|
end; { aaAdd ... }
|
|
end; { case }
|
|
end; { for i ... }
|
|
|
|
if NewStream.Size <> 0 then
|
|
OutTarHelp.WriteArchiveTail; { Terminate the TAR }
|
|
{ Size of NewStream is still 0, and max of the stream will also be 0 }
|
|
|
|
{copy new stream to FStream}
|
|
NewStream.Position := 0;
|
|
if (FStream is TMemoryStream) then
|
|
TMemoryStream(FStream).LoadFromStream(NewStream)
|
|
else if (FStream is TAbVirtualMemoryStream) or not FOwnsStream then begin
|
|
FStream.Size := 0;
|
|
FStream.Position := 0;
|
|
FStream.CopyFrom(NewStream, NewStream.Size);
|
|
end
|
|
else begin
|
|
{ write to a new stream }
|
|
FreeAndNil(FStream);
|
|
FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite);
|
|
FStream.CopyFrom(NewStream, NewStream.Size);
|
|
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 );
|
|
DoArchiveProgress( 100, Abort );
|
|
finally {NewStream/OutTarHelp}
|
|
OutTarHelp.Free;
|
|
NewStream.Free;
|
|
end;
|
|
end;
|
|
|
|
{ This assumes that LoadArchive has been called. }
|
|
procedure TAbTarArchive.TestItemAt(Index: Integer);
|
|
begin
|
|
FStream.Position := TAbTarItem(FItemList[Index]).StreamPosition;
|
|
if VerifyTar(FStream) <> atTar then
|
|
raise EAbTarInvalid.Create; { Invalid Tar }
|
|
end;
|
|
|
|
end.
|