Wie verhindert man die Verfolgung von Symlinks..

[corpsman]

Servus zusammen,
ich hab hier ein kleines Filesearch Tool dass ich gerne und viel Einsetze.

Die Letzte Suche vörderte folgendes zu tage:

Suchergebnis.png (45.98 KiB) 402 mal betrachtet

gesucht wird bei mir mittels:

Code: Alles auswählen

Procedure TForm1.GetFilesInDirectory(ADirectory: String;
  Const AMask: Tstringlist; ARekursiv: Boolean);
Var
  sr: TSearchRec;
  t: String;
  dummy1, dummy2, i: integer;
  b: Boolean;
Begin
  If panik Then exit;
  Application.ProcessMessages;
  // Include Trailing Backslash
  ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  // Suchen der Dateien im Ordner
  If (FindFirstUTF8(ADirectory + '*', faAnyFile And faDirectory, SR) = 0) Then Begin
    Repeat
      // Dank dieser Variante sind wir case insensitiv, obwohl es das Betriebsystem eventuell ist !
      For i := 0 To amask.count - 1 Do Begin
        If CheckBox3.Checked Then Begin
          t := ADirectory + SR.Name;
          dummy2 := 0;
          b := Rex.MatchString(t, dummy1, dummy2);
        End
        Else Begin
          If (pos('.', amask[i]) <> 0) Then Begin
            t := lowercase(ExtractFileExt(ADirectory + SR.Name));
          End
          Else Begin
            t := lowercase(ADirectory + SR.Name);
          End;
          b := (pos(amask[i], t) <> 0) Or (amask[i] = '*') Or (lowercase(SR.Name) = lowercase(amask[i]));
        End;
        If b Then Begin
          If (SR.Name <> '.') And (SR.Name <> '..') Then Begin
            StatusBar1.Panels[0].Text := copy(ADirectory + SR.Name, length(BasePath), length(ADirectory + SR.Name));
            ProceedFind(ADirectory + SR.Name);
            Application.ProcessMessages;
          End;
        End;
      End;
      (*
       * Rekursiver Abstieg
       *)
      If ARekursiv Then Begin
        If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr And FaDirectory = FaDirectory) Then
          GetFilesInDirectory(ADirectory + SR.Name, AMask, True);
      End;
    Until (FindNextUTF8(SR) <> 0) Or panik;
  End;
  FindCloseUTF8(SR);
End;  

Inspiriert durch https://forum.lazarus.freepascal.org/in ... ic=43901.0 dachte ich an diese Lösung hier:

Code: Alles auswählen

      (*
       * Rekursiver Abstieg
       *)
      If ARekursiv Then Begin
        If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr And FaDirectory = FaDirectory) Then
{$IFDEF LINux}
          If ((SR.Attr And fasymlink) = 0) Then Begin
{$ENDIF}
            GetFilesInDirectory(ADirectory + SR.Name, AMask, True);
{$IFDEF LINux}
          End;
{$ENDIF}
      End;

Aber dann ist mir aufgefallen, dass faAnyFile das bit fasymlink gar nicht gesetzt hat, also eigentlich sollte das doch gar nicht notwendig sein, oder ?

[Mathias]

Ob dies irgendwie direkt mit FindFirst und FindNext geht kann ich dir nicht sagen.
Aber du kannst sie mit "fpLstat" und "fpstat" welches in der Unit BaseUnix ist, der Status der Datei abfragen.
Wie lstat und stat arbeitet, sollte es genügend C-Beispiele geben.

[Zvoni]

Von hier: https://forum.lazarus.freepascal.org/in ... ic=63233.0

Code: Alles auswählen

Found:=FindFirst(Path+'*',faAnyFile Or faSymLink,Search);

https://www.freepascal.org/docs-html/rt ... first.html

It is a common misconception that Attr specifies a set of attributes which must be matched in order for a file to be included in the list. This is not so: The value of Attr specifies additional attributes, this means that the returned files are either normal files or have an attribute which is present in Attr.

Specifically: specifying faDirectory as a value for Attr does not mean that only directories will be returned. Normal files and directories will be returned.

[PascalDragon]

Das Problem ist, dass der FindFirst/FindNext Code während der Suche unter *nix nicht herausfindet, dass ein gefundenes Element ein symbolischer Link ist (das könnte noch verbessert werden, hilft dir aber grad sowieso nichts) und daher faSymLink dementsprechend im Ergebnis nicht gesetzt ist.
Was du machen kannst ist mittels FileGetSymLinkTarget prüfen, ob der Pfad tatsächlich ein Symlink ist und dann entsprechend entscheiden.

[Mathias]

Was du machen kannst ist mittels FileGetSymLinkTarget prüfen, ob der Pfad tatsächlich ein Symlink ist und dann entsprechend entscheiden.

Ich habe es mir angeguckt und funktioniert.

Code: Alles auswählen

var
  s: rawbytestring;
begin
  WriteLn(FileGetSymLinkTarget('/home/tux/Schreibtisch/readdir/mainlink.c', s));
  WriteLn(s);
  WriteLn(FileGetSymLinkTarget('/home/tux/Schreibtisch/readdir/main.c', s));
  WriteLn(s);

Ich habe mir die Source angeguckt, sieht fas aus wie in C.

Code: Alles auswählen

function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
var
  Info : Stat;
  SystemFileName: RawByteString;
begin
  SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
  if (fplstat(SystemFileName,Info)>=0) and fpS_ISLNK(Info.st_mode) then begin
    FillByte(SymLinkRec, SizeOf(SymLinkRec), 0);
    SymLinkRec.TargetName:=fpreadlink(SystemFileName);
    if fpstat(pointer(SystemFileName), Info) < 0 then
      raise EDirectoryNotFoundException.Create(SysErrorMessage(GetLastOSError));
    SymLinkRec.Attr := LinuxToWinAttr(SystemFileName, Info);
    SymLinkRec.Size := Info.st_size;
    SymLinkRec.Mode := Info.st_mode;
    Result:=True;
  end else
    Result:=False;
end; 

Dann bin ich noch tiefer rein, und habe eine C-Bindung erwartet, aber ich fand folgenden Code, bei dem ich nur den relevanten Teil rauskopiere, die unnötigen ifdef habe ich entfernt,:

Code: Alles auswählen

function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_SYSCALL2';
....
Function fpLstat(path:PAnsiChar;Info:pstat):cint;
begin
 fpLStat:=do_syscall(
    syscall_nr_lstat,
    TSysParam(path),TSysParam(info));
end;

Irgendwie sind dies ganz komische Bindungen.
PascalDragon weis sicher was es mit denen auf sich hat.