[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 Евгений Савин