Skip to content

[System.IOUtils] Infinity recursion in TDirectory.GetFilesAndDirectories with flag TSearchOption.soAllDirectories

Summary

Current implemetation do not check SearchRec.Name = '..' and SearchRec.Name = '.'

Steps to reproduce

Just call TDirectory.GetFiles(TestDir, TSearchOption.soAllDirectories, TFilterPredicateLocal(nil)); on some existing directory

Example Project

program Project1;

{$mode objfpc}{$H+}

uses
  SysUtils, Types, System.IOUtils;
var
  TestDir: string;
  Files: TStringDynArray;
begin
  TestDir := IncludeTrailingPathDelimiter(TPath.GetTempPath) + TGuid.NewGuid.ToString(True);
  TDirectory.CreateDirectory(TestDir);
  try
    TFile.WriteAllText(TestDir + PathDelim + '1.txt', '1');
    Files := TDirectory.GetFiles(TestDir, TSearchOption.soAllDirectories, TFilterPredicateLocal(nil));
    if Length(Files) <> 1 then
      Halt(1);
    if AnsiCompareFileName(TestDir + PathDelim + '1.txt', Files[0]) <> 0 then
      Halt(2);
  finally
    TDirectory.Delete(TestDir, True);
  end;
end.  

Possible fixes

diff --git a/packages/vcl-compat/src/system.ioutils.pp b/packages/vcl-compat/src/system.ioutils.pp

index b93ea53024..19c46d43b5 100644

--- a/packages/vcl-compat/src/system.ioutils.pp

+++ b/packages/vcl-compat/src/system.ioutils.pp

@@ -2155,7 +2155,8 @@ class function TDirectory.GetFilesAndDirectories(const aPath,

   Result      :=[];

   if (FindFirst(IntPath + aSearchPattern, TFile.FileAttributesToInteger(SearchAttributes), SearchRec) = 0) then

     repeat

-      if (aSearchOption = TSearchOption.soAllDirectories) and ((SearchRec.Attr and {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.faDirectory) <> 0) then

+      if (aSearchOption = TSearchOption.soAllDirectories) and ((SearchRec.Attr and {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.faDirectory) <> 0)

+          and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then

         Result:=Result + GetFilesAndDirectories(IntPath + SearchRec.Name, aSearchPattern, aSearchOption, SearchAttributes, aPredicate)

       else if FilterPredicate(aPath, SearchRec) then

         Result:=Result + [IntPath + SearchRec.Name];
Edited by Евгений Савин
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information