Fix infinite recursion in project discovery on symlink cycles

src/Paket.Core/Common/Utils.fs

@@ -298,6 +298,47 @@ let isWindows =
 #endif
 
 
+/// Native interop used to resolve a path to its canonical, symlink-followed form
+/// so that directory tree walks can detect cycles created by self-referential or
+/// looping symbolic links.
+module internal NativePath =
+    open System.Runtime.InteropServices
+
+    // POSIX realpath: on Linux/macOS libc resolves `path`, following every symbolic
+    // link, into the caller-provided `resolved` buffer (which must be at least
+    // PATH_MAX bytes), returning that buffer on success or NULL on failure. We pass
+    // UTF-8 bytes so non-ASCII paths round-trip, and a 4096-byte buffer (>= PATH_MAX
+    // on Linux (4096) and macOS (1024)), so no manual free is required.
+    [<DllImport("libc", EntryPoint = "realpath", SetLastError = true)>]
+    extern nativeint realpath(byte[] path, byte[] resolved)
+
+    /// Resolve `path` via libc realpath; None on any failure (incl. platforms
+    /// without libc), so callers can fall back to a lexical path.
+    let tryResolve (path: string) : string option =
+        try
+            let pathBytes = Array.append (Text.Encoding.UTF8.GetBytes path) [| 0uy |]
+            let buffer = Array.zeroCreate<byte> 4096
+            if realpath (pathBytes, buffer) = IntPtr.Zero then
+                None
+            else
+                let nullIndex = System.Array.IndexOf(buffer, 0uy)
+                let length = if nullIndex < 0 then buffer.Length else nullIndex
+                Some(Text.Encoding.UTF8.GetString(buffer, 0, length))
+        with _ -> None
+
+/// Resolves `path` to a canonical form suitable for detecting cycles while walking
+/// a directory tree. On Unix this follows symbolic links (via `realpath`); on
+/// Windows, or whenever native resolution is unavailable or fails, it falls back to
+/// a lexical full path.
+let realPath (path: string) : string =
+    let lexical () = try Path.GetFullPath path with _ -> path
+    if isWindows then lexical ()
+    else
+        match NativePath.tryResolve path with
+        | Some resolved -> resolved
+        | None -> lexical ()
+
+
 /// Determines if the current system is a mono system
 /// Todo: Detect mono on windows
 [<Obsolete("use either isMonoRuntime or isUnix, this flag is always false when compiled for NETSTANDARD")>]

src/Paket.Core/PaketConfigFiles/ProjectFile.fs

@@ -1915,7 +1915,16 @@ type ProjectFile with
         let paketPath = Path.Combine(folder,Constants.PaketFilesFolderName) |> normalizePath
 
         let findAllFiles folder =
+            // Canonical (symlink-resolved) directory paths already visited, so a
+            // self-referential or cyclic symlink (e.g. the macOS SDK ncurses symlink
+            // loops inside a Nix `.devenv` profile) cannot drive this walk into
+            // infinite recursion. Symlinks are still followed; only repeats are pruned.
+            let visited = HashSet<string>(StringComparer.Ordinal)
+
             let rec search topLevel (di:DirectoryInfo) =
+                if not (visited.Add(realPath di.FullName)) then
+                    Array.empty
+                else
                 try
                     if verbose then
                         verbosefn "Searching %s in %s" searchPattern di.FullName

tests/Paket.Tests/Paket.Tests.fsproj

@@ -166,6 +166,7 @@
     <Compile Include="ProjectFile\LocalizationSpecs.fs" />
     <Compile Include="ProjectFile\UpdateFromNugetSpecs.fs" />
     <Compile Include="ProjectFile\ReadPropertySpecs.fs" />
+    <Compile Include="ProjectFile\SymlinkLoopSpecs.fs" />
     <Compile Include="ProjectFile\InstallForDotnetSDKSpecs.fs" />
     <Compile Include="InstallProcess\FSharpCoreRedirectsWarningSpecs.fs" />
     <Compile Include="InstallModel\FrameworkIdentifierSpecs.fs" />

tests/Paket.Tests/ProjectFile/SymlinkLoopSpecs.fs

@@ -0,0 +1,50 @@
+module Paket.ProjectFile.SymlinkLoopSpecs
+
+open System
+open System.IO
+open Paket
+open NUnit.Framework
+open FsUnit
+
+// Regression test: ProjectFile.FindAllProjectFiles walks a directory tree to find
+// every *proj* file. A self-referential or cyclic directory symlink (e.g. the macOS
+// SDK ncurses symlink loops inside a Nix `.devenv` profile) used to drive that walk
+// into unbounded recursion. The walk now resolves directories to their canonical
+// (symlink-followed) path and prunes ones it has already visited, so it terminates
+// and reports each physical project exactly once.
+[<Test>]
+[<Timeout(120000)>]
+let ``FindAllProjectFiles terminates on symlink cycles and finds each project once`` () =
+    if isWindows then
+        // Directory-symlink loops of this kind arise on Unix; creating directory
+        // symlinks on Windows needs elevation and the scenario does not apply.
+        Assert.Ignore "symlink-loop scenario is Unix-only"
+    else
+        let root =
+            Path.Combine(Path.GetTempPath(), "paket-symlink-loop-" + Guid.NewGuid().ToString("N"))
+
+        Directory.CreateDirectory root |> ignore
+        let loopLink = Path.Combine(root, "sub", "loop")
+
+        try
+            // A real project that must still be discovered — exactly once.
+            File.WriteAllText(Path.Combine(root, "Real.fsproj"), "<Project />")
+
+            let sub = Path.Combine(root, "sub")
+            Directory.CreateDirectory sub |> ignore
+
+            // `sub/loop` -> `..` points back to `root`: a cycle that, without cycle
+            // detection, makes the recursive search descend forever (re-finding the
+            // project on every lap until the path outgrows PATH_MAX).
+            SymlinkUtils.makeDirectoryLink loopLink ".."
+
+            let found = ProjectFile.FindAllProjectFiles root
+
+            found
+            |> Array.filter (fun fi -> fi.Name = "Real.fsproj")
+            |> Array.length
+            |> shouldEqual 1
+        finally
+            // Remove the symlink before the recursive delete so it can't be followed.
+            (try SymlinkUtils.delete loopLink with _ -> ())
+            (try Directory.Delete(root, true) with _ -> ())