Recent

Author Topic: CreateRelativePath doesn't like too many dots.  (Read 1598 times)

heribertB

  • Newbie
  • Posts: 1
CreateRelativePath doesn't like too many dots.
« on: August 17, 2017, 06:17:14 pm »
Hi,

I think I've detected a bug in CreateRelativePath. Simple sample code to illustrate:

Code: Pascal  [Select]
  1. writeln ( CreateRelativePath ( 'D:\D .....  .....\1\2\3\4.txt' , 'D:\D .....  .....\1' ) ) ;
  2.  
  3. writeln ( CreateRelativePath ( 'D:\D aaaaa  aaaaa\1\2\3\4.txt' , 'D:\D aaaaa  aaaaa\1' ) ) ;

results:

Code: Pascal  [Select]
  1. D:\D .....  .....\1\2\3\4.txt
  2. 2\3\4.txt

So, without dots, it works, with dots, it doesn't. I haven't checked the source yet (lack of time), but maybe someone has an idea?

Cheerio

Heribert


Bart

  • Hero Member
  • *****
  • Posts: 3538
    • Bart en Mariska's Webstek
Re: CreateRelativePath doesn't like too many dots.
« Reply #1 on: August 17, 2017, 07:14:07 pm »
There's a similar function in LazFileUtils IIRC.
You can try that.

Bart

Handoko

  • Hero Member
  • *****
  • Posts: 3181
  • My goal: build my own game engine using Lazarus
Re: CreateRelativePath doesn't like too many dots.
« Reply #2 on: October 01, 2019, 05:12:15 am »
Sorry for posting on an old thread.

I can reproduce the issue on Lazarus 2.0.4 FPC 3.0.4 GTK2 Linux 64-bit. Inspecting the source of lazfileutils.inc (function TryCreateRelativePath), I found that line #318 is the cause of the issue:
  if (Pos('..',Dest) > 0) or (Pos('..',Source) > 0) then Exit;

Below is the source code of TryCreateRelativePath, the line #318 is now line #57:

Code: Pascal  [Select]
  1. function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean;
  2.   AlwaysRequireSharedBaseFolder: Boolean; out RelPath: String): Boolean;
  3. Const
  4.   MaxDirs = 129;
  5. Type
  6.   TDirArr =  Array[1..MaxDirs] of String;
  7.  
  8.   function SplitDirs(Dir: String; out Dirs: TDirArr): Integer;
  9.   var
  10.     Start, Stop, Len: Integer;
  11.     S: String;
  12.   begin
  13.     Result := 0;
  14.     Len := Length(Dir);
  15.     if (Len = 0) then Exit;
  16.     Start := 1;
  17.     Stop := 1;
  18.  
  19.     While Start <= Len do
  20.     begin
  21.       if (Dir[Start] in AllowDirectorySeparators) then
  22.       begin
  23.         S := Copy(Dir,Stop,Start-Stop);
  24.         //ignore empty strings, they are caused by double PathDelims, which we just ignore
  25.         if (S <> '') then
  26.         begin
  27.           Inc(Result);
  28.           if Result>High(Dirs) then
  29.             raise Exception.Create('too many sub directories');
  30.           Dirs[Result] := S;
  31.         end;
  32.         Stop := Start + 1;
  33.       end;
  34.       Inc(Start);
  35.     end;
  36.     //If (Len > 0) then
  37.  
  38.     S := Copy(Dir,Stop,Start-Stop);
  39.     if (S <> '') then
  40.     begin
  41.       Inc(Result);
  42.       Dirs[Result] := S;
  43.     end;
  44.   end;
  45.  
  46.  
  47. var
  48.   CompareFunc: function(const Item1, Item2: String): PtrInt;
  49.   SourceRoot, DestRoot, CmpDest, CmpSource: String;
  50.   CmpDestLen, CmpSourceLen, DestCount, SourceCount, i,
  51.   SharedFolders, LevelsBack, LevelsUp: Integer;
  52.   SourceDirs, DestDirs: Array[1..MaxDirs] of String;
  53.   IsAbs: Boolean;
  54. begin
  55.   Result := False;
  56.   if (Dest = '') or (Source = '') then Exit;
  57.   if (Pos('..',Dest) > 0) or (Pos('..',Source) > 0) then Exit;
  58.   SourceRoot := ExtractFileRoot(Source);
  59.   DestRoot := ExtractFileRoot(Dest);
  60.   //debugln('TryCreaterelativePath: DestRoot = "',DestRoot,'"');
  61.   //debugln('TryCreaterelativePath: SourceRoot = "',SourceRoot,'"');
  62.   //Root must be same: either both absolute filenames or both relative (and on same drive in Windows)
  63.   if (CompareFileNames(SourceRoot, DestRoot) <> 0) then Exit;
  64.   IsAbs := (DestRoot <> '');
  65.   {$if defined(windows) and not defined(wince)}
  66.   if not IsAbs then  // relative paths
  67.   begin
  68.     //we cannot handle files like c:foo
  69.     if ((Length(Dest) > 1) and (UpCase(Dest[1]) in ['A'..'Z']) and (Dest[2] = ':')) or
  70.        ((Length(Source) > 1) and (UpCase(Source[1]) in ['A'..'Z']) and (Source[2] = ':')) then Exit;
  71.     //we cannot handle combinations like dest=foo source=\bar or the other way around
  72.     if ((Dest[1] in AllowDirectorySeparators) and not (Source[1] in AllowDirectorySeparators)) or
  73.        (not (Dest[1] in AllowDirectorySeparators) and (Source[1] in AllowDirectorySeparators)) then Exit;
  74.   end;
  75.   {$endif}
  76.  
  77.   {$IFDEF CaseInsensitiveFilenames}
  78.   CompareFunc := @UTF8CompareText;
  79.   {$else CaseInsensitiveFilenames}
  80.   CompareFunc := @Utf8CompareStr;
  81.   {$endif CaseInsensitiveFilenames}
  82.  
  83.   CmpSource := Source;
  84.   CmpDest := Dest;
  85.   {$IFDEF darwin}
  86.   CmpSource := GetDarwinSystemFilename(CmpSource);
  87.   CmpDest := GetDarwinSystemFilename(CmpDest);
  88.   {$ENDIF}
  89.  
  90.  
  91.   CmpDest := ChompPathDelim(Dest);
  92.   CmpSource := ChompPathDelim(Source);
  93.   if IsAbs then
  94.   begin
  95.     System.Delete(CmpSource,1,Length(SourceRoot));
  96.     System.Delete(CmpDest,1,Length(DestRoot));
  97.   end;
  98.  
  99.   //Get rid of excessive trailing PathDelims now after (!) we stripped Root
  100.   while (Length(CmpDest) > 0) and (CmpDest[Length(CmpDest)] in AllowDirectorySeparators) do System.Delete(CmpDest,Length(CmpDest),1);
  101.   while (Length(CmpSource) > 0) and (CmpSource[Length(CmpSource)] in AllowDirectorySeparators) do System.Delete(CmpSource,Length(CmpSource),1);
  102.  
  103.   //debugln('TryCreaterelativePath: CmpDest   = "',cmpdest,'"');
  104.   //debugln('TryCreaterelativePath: CmpSource = "',cmpsource,'"');
  105.   CmpDestLen := Length(CmpDest);
  106.   CmpSourceLen := Length(CmpSource);
  107.  
  108.   DestCount := SplitDirs(CmpDest, DestDirs);
  109.   SourceCount :=  SplitDirs(CmpSource, SourceDirs);
  110.  
  111.   //debugln('TryCreaterelativePath: DestDirs:');
  112.   //for i := 1 to DestCount do debugln(DbgS(i),' "',DestDirs[i],'"'); debugln;
  113.   //debugln('TryCreaterelativePath:');
  114.   //for i := 1 to SourceCount do debugln(DbgS(i),' "',SourceDirs[i],'"'); debugln;
  115.  
  116.  
  117.   i := 1;
  118.   SharedFolders := 0;
  119.   while (i <= DestCount) and (i <= SourceCount) do
  120.   begin
  121.     if (CompareFunc(DestDirs[i], SourceDirs[i]) = 0) then
  122.     begin
  123.       Inc(SharedFolders);
  124.       Inc(i);
  125.     end
  126.     else
  127.     begin
  128.       Break;
  129.     end;
  130.   end;
  131.  
  132.   //debugln('TryCreaterelativePath: SharedFolders = ',DbgS(SharedFolders));
  133.   if (SharedFolders = 0) and ((not IsAbs) or AlwaysRequireSharedBaseFolder) and not ((CmpDestLen = 0) or (CmpSourceLen = 0)) then
  134.   begin
  135.     //debguln('TryCreaterelativePath: FAIL: IsAbs = ',DbgS(IsAs),' AlwaysRequireSharedBaseFolder = ',DbgS(AlwaysRequireSharedBaseFolder),
  136.     //' SharedFolders = 0, CmpDestLen = ',DbgS(cmpdestlen),' CmpSourceLen = ',DbgS(CmpSourceLen));
  137.     Exit;
  138.   end;
  139.   LevelsBack := SourceCount - SharedFolders;
  140.   LevelsUp := DestCount - SharedFolders;
  141.   //debugln('TryCreaterelativePath: LevelsBack = ',DbgS(Levelsback));
  142.   //debugln('TryCreaterelativePath: LevelsUp   = ',DbgS(LevelsUp));
  143.   if (LevelsBack > 0) then
  144.   begin
  145.     RelPath := '';
  146.     for i := 1 to LevelsBack do RelPath := '..' + PathDelim + Relpath;
  147.  
  148.     for i := LevelsUp downto 1 do
  149.     begin
  150.       if (RelPath <> '') and not (RelPath[Length(RelPath)] in AllowDirectorySeparators) then RelPath := RelPath + PathDelim;
  151.       RelPath := RelPath + DestDirs[DestCount + 1 - i];
  152.     end;
  153.     RelPath := ChompPathDelim(RelPath);
  154.   end
  155.   else
  156.   begin
  157.     RelPath := '';
  158.     for i := LevelsUp downto 1 do
  159.     begin
  160.       if (RelPath <> '') then RelPath := RelPath + PathDelim;
  161.       RelPath := RelPath + DestDirs[DestCount + 1 - i];
  162.     end;
  163.   end;
  164.   if UsePointDirectory and (RelPath = '') then
  165.     RelPath := '.'; // Dest = Source
  166.  
  167.   Result := True;
  168. end;

I think the line #318 (or #57 in the copy-pasted code above) should be removed. What do you think? Should I submit a bug report?
« Last Edit: October 01, 2019, 08:28:39 am by Handoko »

cris75

  • New member
  • *
  • Posts: 6
Re: CreateRelativePath doesn't like too many dots.
« Reply #3 on: October 29, 2019, 11:46:29 am »
Hi all,
hi Handoko,
I have a function to produce a zip archive from a directory tree storing only a relative path, it uses paszlib;
It is intended to be used in a Windows application and it's based on the example in the paszlib wiki;
I noticed a couple of times a strange result in the zip archive produced when
a file in the "directory tree to be zipped" does end with a dot followed by a normal extension, in that case that specific file is stored in the zip archive with the full path while the others are (correctly) stored as expected;
after some search I deduced that the problem was in the CreateRelativePath function in LazFileUtils;
so I found this thread while I was searching for documentation for the above function and saw your post;
to me, the line you underlined seems actually to be the problem, if I comment it out it and recompile LazFileUtils the zip result seems to be ok;
I'm (still) on Lazarus 1.8.4 FPC 3.0.4 X86_64 LCL win32



Edit:
of course, the function is TryCreateRelativePath  :)

In my case the problem arise because there are two consecutive dots (as explained);

Example code:

Code: Pascal  [Select]
  1. function ZipWRelPath(const aZFileName: string; aRelativeDirectory: string;
  2.   out anError: string): boolean;
  3. var
  4.   AZipper: TZipper;
  5.   ZEntries : TZipFileEntries;
  6.   szPathEntry: string;
  7.   i:Integer;
  8.   fList: TStringList;
  9. begin
  10.   Result:= False;
  11.   anError:= 'No errors.';
  12.   AZipper:= TZipper.Create;
  13.   try
  14.     try
  15.       AZipper.Filename:= aZFileName;
  16.       AZipper.Clear;
  17.       ZEntries:= TZipFileEntries.Create(TZipFileEntry);
  18.  
  19.       if DirPathExists(aRelativeDirectory) then begin
  20.         i:= RPos(PathDelim, ChompPathDelim(aRelativeDirectory));
  21.         szPathEntry:= LeftStr(aRelativeDirectory, i);
  22.  
  23.         fList:= TstringList.Create;
  24.         try
  25.           FindAllFiles(fList, aRelativeDirectory, '*.*');
  26.           for i:= 0 to fList.Count -1 do
  27.           begin
  28.             ZEntries.AddFileEntry(fList[i], CreateRelativePath(fList[i],
  29.               szPathEntry));
  30.           end;
  31.         finally
  32.           fList.Free;
  33.         end;
  34.       end;
  35.       if (ZEntries.Count > 0) then
  36.         AZipper.ZipFiles(ZEntries);
  37.       except
  38.         On E: EZipError do begin
  39.           anError:= 'Zipfile could not be created, reason: ' + E.Message;
  40.         end;
  41.       end;
  42.     Result:= True;
  43.   finally
  44.     FreeAndNil(ZEntries);
  45.     AZipper.Free;
  46.   end;
  47. end;
« Last Edit: October 29, 2019, 12:05:10 pm by cris75 »