ADD: Zip - parse pax headers (issue 0001730)

This commit is contained in:
Alexander Koblov 2019-12-19 17:50:52 +00:00
commit 2fc6dc10e9
2 changed files with 250 additions and 29 deletions

View file

@ -274,6 +274,7 @@ type
private
{ The following private members are used for Stuffing FTarItem struct }
procedure ParseTarHeaders; { Error in header if }
procedure ParsePaxHeaders; { 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 }
@ -1004,6 +1005,107 @@ begin
{ FTarItem.Dirty; Stuffed upon creaction }
end;
procedure TAbTarItem.ParsePaxHeaders;
var
I, J : Integer;
ALength: Integer;
RawLength: Int64;
RawExtra: Integer;
S, P, O: PAnsiChar;
NumMHeaders: Integer;
PHeader: PAbTarHeaderRec;
AName, AValue: AnsiString;
RawValue, TempStr: AnsiString;
begin
RawValue := EmptyStr;
for I := 0 to FTarHeaderList.Count - 1 do
begin
PHeader := FTarHeaderList.Items[I];
if PHeader.LinkFlag = AB_TAR_LF_XHDR then
begin
RawLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));
// Number of headers
NumMHeaders := RawLength div AB_TAR_RECORDSIZE;
// Chars in the last header
RawExtra := RawLength mod AB_TAR_RECORDSIZE;
// Copy data from headers
for J := 1 to NumMHeaders do
begin
PHeader := FTarHeaderList.Items[I + J];
SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE);
RawValue := RawValue + TempStr;
end;
// Copy data from the last header
if RawExtra <> 0 then
begin
PHeader := FTarHeaderList.Items[I + NumMHeaders + 1];
SetString(TempStr, PAnsiChar(PHeader), RawExtra);
RawValue := RawValue + TempStr;
end;
Break;
end;
end;
// Parse pax headers
if (Length(RawValue) > 0) then
begin
O := nil;
ALength:= 0;
S:= Pointer(RawValue);
P:= S;
while (P^ <> #0) do
begin
case P^ of
#10:
begin
Inc(P);
S := P;
O := nil;
ALength:= 0;
end;
#32:
begin
P^:= #0;
Inc(P);
O:= P;
ALength:= StrToIntDef(S, 0);
end;
'=':
begin
// Something wrong, exit
if (ALength = 0) or (O = nil) then
Exit;
SetString(AName, O, P - O);
ALength:= ALength - (P - S) - 1;
if (AName = 'path') then
begin
SetString(AValue, P + 1, ALength - 1);
FTarItem.Name := CeRawToUtf8(AValue);
end
else if (AName = 'linkpath') then
begin
SetString(AValue, P + 1, ALength - 1);
FTarItem.LinkName := CeRawToUtf8(AValue);
end
else if (AName = 'size') then
begin
SetString(AValue, P + 1, ALength - 1);
FTarItem.Size := StrToInt64Def(AValue, FTarItem.Size);
end;
Inc(P, ALength);
end;
else begin
Inc(P);
end;
end;
end;
end;
end;
procedure TAbTarItem.LoadTarHeaderFromStream(AStream: TStream);
var
NumMHeaders : Integer;
@ -1085,6 +1187,7 @@ begin
if FTarItem.ItemType <> UNKNOWN_ITEM then
begin
ParseTarHeaders; { Update FTarItem values }
ParsePaxHeaders; { Update FTarItem values }
FFileName := FTarItem.Name; {FTarHeader.Name;}
// FDiskFileName := FileName;
// AbUnfixName(FDiskFileName);

View file

@ -1227,7 +1227,15 @@ Index: AbTarTyp.pas
===================================================================
--- AbTarTyp.pas (revision 512)
+++ AbTarTyp.pas (working copy)
@@ -320,6 +320,7 @@
@@ -274,6 +274,7 @@
private
{ The following private members are used for Stuffing FTarItem struct }
procedure ParseTarHeaders; { Error in header if }
+ procedure ParsePaxHeaders; { 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 }
@@ -320,6 +321,7 @@
function GetLastModFileTime : Word; override;
function GetLastModTimeAsDateTime: TDateTime; override;
function GetNativeFileAttributes : LongInt; override;
@ -1235,7 +1243,7 @@ Index: AbTarTyp.pas
function GetUncompressedSize : Int64; override;
procedure SetCompressedSize(const Value : Int64); override; { Extended Headers }
@@ -418,7 +419,8 @@
@@ -418,7 +420,8 @@
FArchReadOnly : Boolean;
FArchFormat: TAbTarHeaderFormat;
protected
@ -1245,7 +1253,7 @@ Index: AbTarTyp.pas
override;
procedure ExtractItemAt(Index : Integer; const UseName : string);
override;
@@ -448,6 +450,11 @@
@@ -448,6 +451,11 @@
write PutItem; default;
end;
@ -1257,7 +1265,7 @@ Index: AbTarTyp.pas
function VerifyTar(Strm : TStream) : TAbArchiveType;
@@ -454,10 +461,8 @@
@@ -454,10 +462,8 @@
implementation
uses
@ -1270,7 +1278,7 @@ Index: AbTarTyp.pas
{ ****************** Helper functions Not from Classes Above ***************** }
function OctalToInt(const Oct : PAnsiChar; aLen : integer): Int64;
@@ -566,7 +571,58 @@
@@ -566,7 +572,58 @@
not (AB_TAR_RECORDSIZE - 1);
end;
@ -1329,7 +1337,7 @@ Index: AbTarTyp.pas
{ ****************************** TAbTarItem ********************************** }
constructor TAbTarItem.Create;
begin
@@ -632,7 +688,7 @@
@@ -632,7 +689,7 @@
function TAbTarItem.GetExternalFileAttributes: LongWord;
begin
@ -1338,7 +1346,7 @@ Index: AbTarTyp.pas
end;
function TAbTarItem.GetFileName: string;
@@ -678,6 +734,19 @@
@@ -678,6 +735,19 @@
Result := AbUnixTimeToLocalDateTime(FTarItem.ModTime);
end;
@ -1358,7 +1366,7 @@ Index: AbTarTyp.pas
function TAbTarItem.GetLinkName: string;
begin
Result := FTarItem.LinkName;
@@ -734,7 +803,7 @@
@@ -734,7 +804,7 @@
{ GNU_FORMAT is detected by the presence of GNU extended headers. }
{ These detections are similar to GNU tar's. }
@ -1367,7 +1375,7 @@ Index: AbTarTyp.pas
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
@@ -750,7 +819,7 @@
@@ -750,7 +820,7 @@
{ This can define false positives, Pax headers/ STAR format could be detected as this }
FTarItem.ArchiveFormat := USTAR_FORMAT;
end
@ -1376,7 +1384,7 @@ Index: AbTarTyp.pas
begin
FTarItem.ArchiveFormat := OLDGNU_FORMAT;
end
@@ -819,7 +888,7 @@
@@ -819,7 +889,7 @@
RawFileName := PTarHeader.Name;
end; { End not FoundName }
@ -1385,7 +1393,7 @@ Index: AbTarTyp.pas
end;
{ Extract the file name from the headers }
@@ -876,7 +945,7 @@
@@ -876,7 +946,7 @@
if not FoundName then
RawLinkName := PHeader.LinkName;
@ -1394,7 +1402,115 @@ Index: AbTarTyp.pas
end;
{ Return True if CheckSum passes out. }
@@ -968,7 +1037,7 @@
@@ -935,6 +1005,107 @@
{ FTarItem.Dirty; Stuffed upon creaction }
end;
+procedure TAbTarItem.ParsePaxHeaders;
+var
+ I, J : Integer;
+ ALength: Integer;
+ RawLength: Int64;
+ RawExtra: Integer;
+ S, P, O: PAnsiChar;
+ NumMHeaders: Integer;
+ PHeader: PAbTarHeaderRec;
+ AName, AValue: AnsiString;
+ RawValue, TempStr: AnsiString;
+begin
+ RawValue := EmptyStr;
+
+ for I := 0 to FTarHeaderList.Count - 1 do
+ begin
+ PHeader := FTarHeaderList.Items[I];
+ if PHeader.LinkFlag = AB_TAR_LF_XHDR then
+ begin
+ RawLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));
+ // Number of headers
+ NumMHeaders := RawLength div AB_TAR_RECORDSIZE;
+ // Chars in the last header
+ RawExtra := RawLength mod AB_TAR_RECORDSIZE;
+ // Copy data from headers
+ for J := 1 to NumMHeaders do
+ begin
+ PHeader := FTarHeaderList.Items[I + J];
+ SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE);
+ RawValue := RawValue + TempStr;
+ end;
+ // Copy data from the last header
+ if RawExtra <> 0 then
+ begin
+ PHeader := FTarHeaderList.Items[I + NumMHeaders + 1];
+ SetString(TempStr, PAnsiChar(PHeader), RawExtra);
+ RawValue := RawValue + TempStr;
+ end;
+ Break;
+ end;
+ end;
+
+ // Parse pax headers
+ if (Length(RawValue) > 0) then
+ begin
+ O := nil;
+ ALength:= 0;
+ S:= Pointer(RawValue);
+ P:= S;
+ while (P^ <> #0) do
+ begin
+ case P^ of
+ #10:
+ begin
+ Inc(P);
+ S := P;
+ O := nil;
+ ALength:= 0;
+ end;
+ #32:
+ begin
+ P^:= #0;
+ Inc(P);
+ O:= P;
+ ALength:= StrToIntDef(S, 0);
+ end;
+ '=':
+ begin
+ // Something wrong, exit
+ if (ALength = 0) or (O = nil) then
+ Exit;
+
+ SetString(AName, O, P - O);
+ ALength:= ALength - (P - S) - 1;
+
+ if (AName = 'path') then
+ begin
+ SetString(AValue, P + 1, ALength - 1);
+ FTarItem.Name := CeRawToUtf8(AValue);
+ end
+ else if (AName = 'linkpath') then
+ begin
+ SetString(AValue, P + 1, ALength - 1);
+ FTarItem.LinkName := CeRawToUtf8(AValue);
+ end
+ else if (AName = 'size') then
+ begin
+ SetString(AValue, P + 1, ALength - 1);
+ FTarItem.Size := StrToInt64Def(AValue, FTarItem.Size);
+ end;
+
+ Inc(P, ALength);
+ end;
+ else begin
+ Inc(P);
+ end;
+ end;
+ end;
+ end;
+end;
+
procedure TAbTarItem.LoadTarHeaderFromStream(AStream: TStream);
var
NumMHeaders : Integer;
@@ -968,7 +1139,7 @@
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 }
@ -1403,9 +1519,11 @@ Index: AbTarTyp.pas
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 }
@@ -1017,8 +1086,8 @@
@@ -1016,9 +1187,10 @@
if FTarItem.ItemType <> UNKNOWN_ITEM then
begin
ParseTarHeaders; { Update FTarItem values }
+ ParsePaxHeaders; { Update FTarItem values }
FFileName := FTarItem.Name; {FTarHeader.Name;}
- FDiskFileName := FileName;
- AbUnfixName(FDiskFileName);
@ -1414,7 +1532,7 @@ Index: AbTarTyp.pas
end;
Action := aaNone;
Tagged := False;
@@ -1142,14 +1211,21 @@
@@ -1142,14 +1314,21 @@
var
S : AnsiString;
I: Integer;
@ -1438,7 +1556,7 @@ Index: AbTarTyp.pas
FTarItem.Dirty := True;
end;
@@ -1297,9 +1373,9 @@
@@ -1297,9 +1476,9 @@
{ Finally we need to stuff the file type Header. }
{ Note: Value.length > AB_TAR_NAMESIZE(100) }
if LinkFlag = AB_TAR_LF_LONGNAME then
@ -1450,7 +1568,7 @@ Index: AbTarTyp.pas
end;
procedure TAbTarItem.SetFileName(const Value: string);
@@ -1333,7 +1409,7 @@
@@ -1333,7 +1512,7 @@
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 }
@ -1459,7 +1577,7 @@ Index: AbTarTyp.pas
{ 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. }
@@ -1431,8 +1507,8 @@
@@ -1431,8 +1610,8 @@
{ Update the inherited file names. }
FFileName := FTarItem.Name;
@ -1470,7 +1588,7 @@ Index: AbTarTyp.pas
FTarItem.Dirty := True;
end;
@@ -1527,7 +1603,7 @@
@@ -1527,7 +1706,7 @@
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.}
@ -1479,7 +1597,7 @@ Index: AbTarTyp.pas
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. }
@@ -1838,16 +1914,19 @@
@@ -1838,16 +2017,19 @@
FArchFormat := V7_FORMAT; // Default for new archives
end;
@ -1502,7 +1620,7 @@ Index: AbTarTyp.pas
Item := TAbTarItem.Create;
try
// HeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT);
@@ -1863,7 +1942,7 @@
@@ -1863,7 +2045,7 @@
Item.LinkFlag := AB_TAR_LF_NORMAL;
Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER;
end
@ -1511,7 +1629,7 @@ Index: AbTarTyp.pas
begin { Switch the rep over to GNU so it can have long file names. }
FArchFormat := OLDGNU_FORMAT;
Item.ArchiveFormat := OLDGNU_FORMAT;
@@ -1882,9 +1961,10 @@
@@ -1882,9 +2064,10 @@
{ Most others are initialized in the .Create }
Item.CRC32 := 0;
@ -1524,7 +1642,7 @@ Index: AbTarTyp.pas
Item.Action := aaNone;
finally
Result := Item;
@@ -1894,12 +1974,13 @@
@@ -1894,12 +2077,13 @@
procedure TAbTarArchive.ExtractItemAt(Index: Integer; const UseName: string);
var
@ -1540,7 +1658,7 @@ Index: AbTarTyp.pas
CurItem := TAbTarItem(ItemList[Index]);
@@ -1911,21 +1992,50 @@
@@ -1911,21 +2095,50 @@
raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }
{ We will allow extractions if the file name/Link name are strickly less than 100 chars }
@ -1603,7 +1721,7 @@ Index: AbTarTyp.pas
end;
end;
AbSetFileTime(UseName, CurItem.LastModTimeAsDateTime);
@@ -2060,7 +2170,7 @@
@@ -2060,7 +2273,7 @@
AbStripDrive( lValue );
{ check for a leading slash }
@ -1612,7 +1730,7 @@ Index: AbTarTyp.pas
System.Delete( lValue, 1, 1 );
if soStripPath in StoreOptions then
@@ -2097,7 +2207,6 @@
@@ -2097,7 +2310,6 @@
i : Integer;
NewStream : TAbVirtualMemoryStream;
TempStream : TStream;
@ -1620,7 +1738,7 @@ Index: AbTarTyp.pas
CurItem : TAbTarItem;
AttrEx : TAbAttrExRec;
begin
@@ -2145,24 +2254,27 @@
@@ -2145,24 +2357,27 @@
aaAdd, aaFreshen, aaReplace: begin
try
@ -1664,7 +1782,7 @@ Index: AbTarTyp.pas
fmOpenRead or fmShareDenyWrite );
try { TempStream }
CurItem.UncompressedSize := TempStream.Size;
@@ -2173,9 +2285,13 @@
@@ -2173,9 +2388,13 @@
TempStream.Free;
end; { TempStream }
end;
@ -1681,7 +1799,7 @@ Index: AbTarTyp.pas
except
ItemList[i].Action := aaDelete;
DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);
@@ -2200,7 +2316,7 @@
@@ -2200,7 +2419,7 @@
else begin
{ need new stream to write }
FreeAndNil(FStream);
@ -1689,7 +1807,7 @@ Index: AbTarTyp.pas
+ FStream := TFileStreamEx.Create(FArchiveName, fmCreate or fmShareDenyWrite);
FStream.CopyFrom(NewStream, NewStream.Size);
end;
Index: AbUnzPrc.pas
===================================================================
--- AbUnzPrc.pas (revision 512)