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) 1135 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.

[corpsman]

Ok wenn ich dein Beispiel richtig verstanden habe, ist dieser "umbau" richtig:

Code: Alles auswählen

      (*
       * Rekursiver Abstieg
       *)
      If ARekursiv Then Begin
        If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr And FaDirectory = FaDirectory) Then Begin
{$IFDEF LiNux}
          s := '';
          FileGetSymLinkTarget(ADirectory + SR.Name, s);
          If s = '' Then Begin // Kein Symlink gefunden -> Ein Echtes Verzeichnis, also absteigen ;)
{$ENDIF}
            GetFilesInDirectory(ADirectory + SR.Name, AMask, True);
{$IFDEF LINux}
          End;
{$ENDIF}
        End;        

Beim Testen ist mir nun aufgefallen, das ich zufällig via sftp auf nem anderen Rechner war, den hat er dennoch versucht zu durchsuchen . Wie verhindert man den sowas, oder ist das ein Feature dass man in dem fall haben will ?

[PascalDragon]

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

Nachdem die POSIX API C ist, wird es zwangsweise sehr C-ähnlich.
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.

Unter Linux wird standardmäßig der Linux Kernel direkt aufgerufen, so dass vor allem für einfache Programme überhaupt keine C-Bibliothek nötig ist. Das geschieht über die do_syscall-Funktionen, welche tatsächlich als FpSysCall Assembly Funktionen in den rtl/linux/<cpu>/syscall.inc Dateien implementiert sind.

Ok wenn ich dein Beispiel richtig verstanden habe, ist dieser "umbau" richtig:

Code: Alles auswählen

      (*
       * Rekursiver Abstieg
       *)
      If ARekursiv Then Begin
        If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr And FaDirectory = FaDirectory) Then Begin
{$IFDEF LiNux}
          s := '';
          FileGetSymLinkTarget(ADirectory + SR.Name, s);
          If s = '' Then Begin // Kein Symlink gefunden -> Ein Echtes Verzeichnis, also absteigen ;)
{$ENDIF}
            GetFilesInDirectory(ADirectory + SR.Name, AMask, True);
{$IFDEF LINux}
          End;
{$ENDIF}
        End;        

FileGetSymLinkTarget gibt auch ein Boolean zurück, ob es erfolgreich war oder nicht.

Beim Testen ist mir nun aufgefallen, das ich zufällig via sftp auf nem anderen Rechner war, den hat er dennoch versucht zu durchsuchen . Wie verhindert man den sowas, oder ist das ein Feature dass man in dem fall haben will ?

Du könntest dir die eingehängten Mounts abfragen (/proc/mounts) und dann schauen, ob das aktuelle Verzeichnis auf einem Dateisystem ist, das du besser nicht durchsuchen möchtest (oder nur mit entsprechendem Parameter).