diff --git a/packages/paszlib/examples/miniunz.pas b/packages/paszlib/examples/miniunz.pas index 3a150dafee..23224fea2e 100644 --- a/packages/paszlib/examples/miniunz.pas +++ b/packages/paszlib/examples/miniunz.pas @@ -9,7 +9,7 @@ program MiniUnz; -x like -e, but extract without path information -o overwrite an existing file without warning - Pascal tranlastion + Pascal translation Copyright (C) 2000 by Jacques Nomssi Nzali For conditions of distribution and use, see copyright notice in readme.txt }{$ifdef WIN32} diff --git a/packages/paszlib/src/zipper.pp b/packages/paszlib/src/zipper.pp index 30de5f46fc..c05f2c7b15 100644 --- a/packages/paszlib/src/zipper.pp +++ b/packages/paszlib/src/zipper.pp @@ -1,7 +1,7 @@ { $Id: header,v 1.3 2013/05/26 06:33:45 michael Exp $ This file is part of the Free Component Library (FCL) - Copyright (c) 1999-2013 by the Free Pascal development team + Copyright (c) 1999-2014 by the Free Pascal development team See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -90,7 +90,7 @@ Type Starting_Disk_Num : Word; Internal_Attributes : Word; External_Attributes : LongWord; - Local_Header_Offset : LongWord; //todo: use zip64 and set to 0xFFFFFFFF if needed + Local_Header_Offset : LongWord; // if zip64: 0xFFFFFFFF End; End_of_Central_Dir_Type = Packed Record //End of central directory record @@ -306,10 +306,11 @@ Type TZipFileEntry = Class(TCollectionItem) private - FArchiveFileName: String; + FArchiveFileName: String; //Name of the file as it appears in the zip file list FAttributes: LongInt; FDateTime: TDateTime; - FDiskFileName: String; + FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.); + uses local OS/filesystem directory separators} FHeaderPos: int64; FNeedsZip64: Boolean; //flags whether filesize is big enough so we need a zip64 entry FOS: Byte; @@ -317,6 +318,8 @@ Type FStream: TStream; FCompressionLevel: TCompressionlevel; function GetArchiveFileName: String; + procedure SetArchiveFileName(Const AValue: String); + procedure SetDiskFileName(Const AValue: String); Protected // For multi-disk support, a disk number property could be added here. Property HdrPos : int64 Read FHeaderPos Write FheaderPos; @@ -328,8 +331,8 @@ Type Procedure Assign(Source : TPersistent); override; Property Stream : TStream Read FStream Write FStream; Published - Property ArchiveFileName : String Read GetArchiveFileName Write FArchiveFileName; - Property DiskFileName : String Read FDiskFileName Write FDiskFileName; + Property ArchiveFileName : String Read GetArchiveFileName Write SetArchiveFileName; + Property DiskFileName : String Read FDiskFileName Write SetDiskFileName; Property Size : Int64 Read FSize Write FSize; Property DateTime : TDateTime Read FDateTime Write FDateTime; property OS: Byte read FOS write FOS; @@ -393,10 +396,14 @@ Type Constructor Create; Destructor Destroy;override; Procedure ZipAllFiles; virtual; + // Saves zip to file and changes FileName Procedure SaveToFile(AFileName: string); + // Saves zip to stream Procedure SaveToStream(AStream: TStream); + // Zips specified files into a zip with name AFileName Procedure ZipFiles(AFileName : String; FileList : TStrings); Procedure ZipFiles(FileList : TStrings); + // Zips specified entries into a zip with name AFileName Procedure ZipFiles(AFileName : String; Entries : TZipFileEntries); Procedure ZipFiles(Entries : TZipFileEntries); Procedure Clear; @@ -1513,7 +1520,7 @@ Var ACount : QWord; //entry counter ZFileName : string; //archive filename IsZip64 : boolean; //local header=zip64 format? - MinReqdVersion: word; //minimum + MinReqdVersion: word; //minimum needed to extract ExtInfoHeader : Extensible_Data_Field_Header_Type; Zip64ECD : Zip64_End_of_Central_Dir_type; Zip64ECDL : Zip64_End_of_Central_Dir_Locator_type; @@ -1779,6 +1786,7 @@ procedure TZipper.SaveToFile(AFileName: string); var lStream: TFileStream; begin + FFileName:=AFileName; lStream:=TFileStream.Create(FFileName,fmCreate); try SaveToStream(lStream); @@ -1956,13 +1964,22 @@ Begin as directory separator. We don't want that behavior here, since 'abc\' is a valid file name under Unix. - (mantis 15836) On the other hand, many archives on - Windows have '/' as pathseparator, even Windows - generated .odt files. So we disable this for Windows. + The zip standard appnote.txt says zip files must have '/' as path + separator, even on Windows: 4.4.17.1: + "The path stored MUST not contain a drive or device letter, or a leading + slash. All slashes MUST be forward slashes '/' as opposed to backwards + slashes '\'" See also mantis issue #15836 + However, old versions of FPC on Windows (and possibly other utilities) + created incorrect zip files with \ separator, so accept these as well as + they're not valid in Windows file names anyway. } OldDirectorySeparators:=AllowDirectorySeparators; - {$ifndef Windows} - AllowDirectorySeparators:=[DirectorySeparator]; + {$ifdef Windows} + // Explicitly allow / and \ regardless of what Windows supports + AllowDirectorySeparators:=['\','/']; + {$else} + // Follow the standard: only allow / regardless of actual separator on OS + AllowDirectorySeparators:=['/']; {$endif} Path:=ExtractFilePath(OutFileName); OutStream:=Nil; @@ -2365,7 +2382,9 @@ Var end; Begin ReadZipHeader(Item, ZMethod); - OutputFileName:=Item.DiskFileName; + // Normalize output filename to conventions of target platform. + // Zip file always has / path separators + OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll]); IsCustomStream := Assigned(FOnCreateStream); @@ -2377,7 +2396,8 @@ Begin {$IFNDEF UNIX} if IsLink and Not IsCustomStream then begin - {$warning TODO: Implement symbolic link creation for non-unix} + {$warning TODO: Implement symbolic link creation for non-unix, e.g. + Windows NTFS} IsLink := False; end; {$ENDIF} @@ -2618,7 +2638,7 @@ end; function TZipFileEntry.IsDirectory: Boolean; begin - Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] in ['/', '\']); + Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] = DirectorySeparator); if Attributes <> 0 then begin case OS of @@ -2640,6 +2660,30 @@ begin end; end; +procedure TZipFileEntry.SetArchiveFileName(const AValue: String); +var + Separator: char; +begin + if FArchiveFileName=AValue then Exit; + // Zip standard: filenames inside the zip archive have / path separator + if DirectorySeparator='/' then + FArchiveFileName:=AValue + else + FArchiveFileName:=StringReplace(AValue, DirectorySeparator, '/', [rfReplaceAll]); +end; + +procedure TZipFileEntry.SetDiskFileName(const AValue: String); +begin + if FDiskFileName=AValue then Exit; + // Zip file uses / as directory separator on all platforms + // so convert to separator used on current OS + if DirectorySeparator='/' then + FDiskFileName:=AValue + else + FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]); +end; + + procedure TZipFileEntry.Assign(Source: TPersistent); Var diff --git a/packages/paszlib/tests/tczipper.pp b/packages/paszlib/tests/tczipper.pp index f5b2e5a785..0231e7e847 100644 --- a/packages/paszlib/tests/tczipper.pp +++ b/packages/paszlib/tests/tczipper.pp @@ -1,7 +1,7 @@ program tczipper; { This file is part of the Free Pascal packages. - Copyright (c) 2012-2013 by the Free Pascal Development Team + Copyright (c) 2012-2014 by the Free Pascal Development Team Created by Reinier Olislagers Tests zip/unzip functionality provided by the FPC zipper.pp unit. @@ -17,7 +17,9 @@ program tczipper; //Define this if you want to inspect the generated zips etc {$define KEEPTESTFILES} -uses SysUtils, classes, zipper, unzip, zdeflate, zinflate, zip, md5, zstream, nullstream; +uses + SysUtils, classes, + zipper, unzip, zdeflate, zinflate, zip, md5, zstream, nullstream; type @@ -45,7 +47,7 @@ type procedure TCallBackHandler.EndOfFile(Sender: TObject; const Ratio: double); begin - writeln('End of file handler hit; ratio: '+floattostr(ratio)); + writeln('End of file handler hit; compression ratio: '+floattostr(ratio)); if (FPerformChecks) and (Ratio<0) then begin writeln('Found compression ratio '+floattostr(Ratio)+', which should never be lower than 0.'); @@ -120,9 +122,6 @@ var UnZipper: TUnZipper; begin result:=true; - UncompressedFile1:=SysUtils.GetTempFileName('', 'UNC'); - UncompressedFile2:=SysUtils.GetTempFileName('', 'UNC'); - CompressedFile:=SysUtils.GetTempFileName('', 'CC'); FileContents:=TStringList.Create; OurZipper:=TZipper.Create; @@ -132,16 +131,22 @@ begin // Set up uncompressed files FileContents.Add('This is an uncompressed file.'); FileContents.Add('And another line.'); + UncompressedFile1:=SysUtils.GetTempFileName('', 'UN1'); FileContents.SaveToFile(UncompressedFile1); FileContents.Clear; FileContents.Add('Have you looked into using fpcup today?'); FileContents.Add('It works nicely with fpc and goes well with a fruity red wine, too.'); + // Second GetTempFileName call needs to be done after saving first file because + // GetTempFileName checks for existing file names and may give the *same* file name + // if called before + UncompressedFile2:=SysUtils.GetTempFileName('', 'UN2'); FileContents.SaveToFile(UncompressedFile2); // Remember their content, so we can compare later. UncompressedFile1Hash:=MD5Print(MD5File(UncompressedFile1, MDDefBufSize)); UncompressedFile2Hash:=MD5Print(MD5File(UncompressedFile2, MDDefBufSize)); // Test zip functionality. + CompressedFile:=SysUtils.GetTempFileName('', 'CC'); OurZipper.FileName:=CompressedFile; // Add the files only with their filenames, we don't want to create // subdirectories: @@ -153,7 +158,7 @@ begin if not FileExists(CompressedFile) then begin writeln('Zip file was not created.'); - halt(5); + exit(false); end; // Delete original files @@ -505,6 +510,50 @@ begin {$ENDIF} end; +function SaveToFileTest: boolean; +var + NewFileName: string; + OldFileName: string; + z: TZipper; + zfe: TZipFileEntry; + s: string = 'abcd'; + DefaultStream: TStringStream; +begin + result:=true; + OldFileName:=SysUtils.GetTempFileName('', 'OLD'); + NewFileName:=SysUtils.GetTempFileName('', 'NEW'); + z:=TZipper.Create; + z.FileName:=OldFileName; + try + DefaultStream:=TStringStream.Create(s); + zfe:=z.Entries.AddFileEntry(DefaultStream, 'Compressed'); + z.ZipAllFiles; //saves to OldFileName + DeleteFile(NewFileName); //delete if present + z.SaveToFile(NewFileName); //should save to newfilename + if not(FileExists(NewFileName)) then + begin + writeln('Failure: file '+NewFileName+' does not exist.'); + result:=false; + end + else + begin + result:=true; + end; + finally + DefaultStream.Free; + z.Free; + end; + + {$IFNDEF KEEPTESTFILES} + try + DeleteFile(DestFile); + except + // ignore mess + end; + {$ENDIF} +end; + + function TestLargeFileName: boolean; // Zips/unzips 259-character filename @@ -557,17 +606,77 @@ begin {$ENDIF} end; +function TestWindowsPath: boolean; +// Zips filename in a subdirectory with a \ used as separator +// Zip standard requires using / +// On Linux, \ should be seen as a regular part of the filename +var + FileWithBackslash: string; + DestFile: string; + s: string = 'a'; + DefaultStream: TStringStream; + UnZipper: TUnZipper; + Zipper: TZipper; +begin + result:=true; + FileWithBackslash:='test\afile.txt'; //on Windows, zip should handle this and internally replace \ with / + // On *nix, this should just be a long file + DestFile:=SysUtils.GetTempFileName('', 'TW'); + Zipper:=TZipper.Create; + Zipper.FileName:=DestFile; + try + DefaultStream:=TStringStream.Create(s); + Zipper.Entries.AddFileEntry(DefaultStream, FileWithBackslash); + Zipper.ZipAllFiles; + finally + DefaultStream.Free; + Zipper.Free; + end; + + UnZipper:=TUnZipper.Create; + try + UnZipper.FileName:=DestFile; + Unzipper.Examine; + {$ifdef mswindows} + if (pos('\',Unzipper.Entries[0].ArchiveFileName)>0) then + begin + result:=false; + writeln('Failed: found \ in archive filename; expected /:'); + writeln('*'+Unzipper.Entries[0].ArchiveFileName+'*'); + exit; + end; + {$else} + if (pos('\',Unzipper.Entries[0].ArchiveFileName)<=0) then + begin + result:=false; + writeln('Failed: did not find / in archive filename:'); + writeln('*'+Unzipper.Entries[0].ArchiveFileName+'*'); + exit; + end; + {$endif} + finally + Unzipper.Free; + end; + + {$IFNDEF KEEPTESTFILES} + try + DeleteFile(DestFile); + except + // ignore mess + end; + {$ENDIF} +end; + + function TestLargeZip64: boolean; // Tests single zip file with large uncompressed content // which forces it to zip64 format var ArchiveFile: string; - Buffer: PChar; DestFile: string; ContentStream: TNullStream; //empty contents UnZipper: TUnZipper; Zipper: TZipper; - i: int64; begin result:=true; DestFile:=SysUtils.GetTempFileName('', 'LZ'); @@ -638,27 +747,98 @@ begin end; writeln('CompareCompressDecompress started'); - if not(CompareCompressDecompress) then code:=code+2; //1 already taken by callback handler + try + if not(CompareCompressDecompress) then code:=code+2; //1 already taken by callback handler + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+2; + end; + end; writeln('CompareCompressDecompress finished'); writeln(''); + writeln('CompressSmallStreams started'); - if not(CompressSmallStreams) then code:=code+4; + try + if not(CompressSmallStreams) then code:=code+4; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+4; + end; + end; writeln('CompressSmallStreams finished'); writeln(''); + writeln('TestZipEntries(2) started'); - if not(TestZipEntries(2)) then code:=code+8; + try + if not(TestZipEntries(2)) then code:=code+8; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+8; + end; + end; writeln('TestZipEntries(2) finished'); writeln(''); + writeln('TestLargeFileName started'); - if not(TestLargeFileName) then code:=code+16; + try + if not(TestLargeFileName) then code:=code+16; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+16; + end; + end; writeln('TestLargeFileName finished'); writeln(''); + + writeln('TestWindowsPath started'); + try + if not(TestWindowsPath) then code:=code+32; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+32; + end; + end; + writeln('TestWindowsPath finished'); + writeln(''); + writeln('TestEmptyZipEntries(10) started'); // Run testemptyzipentries with a small number to test the test itself... as // well as zip structure generated with empty files. - if not(TestEmptyZipEntries(10)) then code:=code+32; + try + if not(TestEmptyZipEntries(10)) then code:=code+64; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+64; + end; + end; writeln('TestEmptyZipEntries(10) finished'); writeln(''); + + writeln('SaveToFileTest started'); + try + if not(SaveToFileTest) then code:=code+128; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+128; + end; + end; + writeln('SaveToFileTest finished'); + writeln(''); + writeln('TestEmptyZipEntries(65537) started'); writeln('(note: this will take a long time)'); {Note: tested tools with this file: @@ -666,9 +846,18 @@ begin - Ionic's DotNetZip library unzip.exe utility verison 1.9.1.8 works - 7zip's 7za 9.22 beta works. } - if not(TestEmptyZipEntries(65537)) then code:=code+32; + try + if not(TestEmptyZipEntries(65537)) then code:=code+256; + except + On E: Exception do + begin + writeln('Exception: '+E.Message); + code:=code+256; + end; + end; writeln('TestEmptyZipEntries(65537) finished'); writeln(''); + { This test will take a very long time as it tries to zip a 4Gb memory block. It is therefore commented out by default } { @@ -684,6 +873,7 @@ begin writeln('Exception: '); writeln(E.Message); writeln(''); + if code=0 then code:=maxint; //more or less random error code end; end;