* Patch from Reinier Olislagers to let filenames conform to standard / (bug id 26468)

git-svn-id: trunk@28198 -

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}

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

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;