diff --git a/src/Paket.Core/Common/Utils.fs b/src/Paket.Core/Common/Utils.fs index 609f0d1572..3281c5de6c 100644 --- a/src/Paket.Core/Common/Utils.fs +++ b/src/Paket.Core/Common/Utils.fs @@ -402,18 +402,58 @@ let inline normalizePath(path:string) = .Replace(dirSeparator + "." + dirSeparator, dirSeparator) let inline windowsPath (path:string) = path.Replace(Path.DirectorySeparatorChar, '\\') + +/// Symlink resolution for cycle detection in directory walks. Paket.Core compiles +/// for netstandard2.0, so `FileSystemInfo.ResolveLinkTarget` (.NET 6+) is bound at +/// run time; a runtime without it falls back to libc `realpath` on Unix. +module private LinkResolution = + open System.Runtime.InteropServices + + let resolveLinkTarget : Func option = + typeof.GetMethod("ResolveLinkTarget", [| typeof |]) + |> Option.ofObj + |> Option.map (fun m -> Delegate.CreateDelegate(typeof>, m) :?> _) + + [] + extern nativeint realpath(byte[] path, [] byte[] resolved) + + /// POSIX realpath into a 4096-byte buffer (>= PATH_MAX on Linux and macOS). + let tryRealpath (path: string) = + try + let buffer = Array.zeroCreate 4096 + if realpath (Array.append (Text.Encoding.UTF8.GetBytes path) [| 0uy |], buffer) = IntPtr.Zero then None + else + let len = Array.IndexOf(buffer, 0uy) + Some (Text.Encoding.UTF8.GetString(buffer, 0, (if len < 0 then buffer.Length else len))) + with :? DllNotFoundException | :? EntryPointNotFoundException -> None + +/// Canonical (symlink-resolved) path of `dir`; `lexical` is its path if it is not a +/// link: the parent's canonical path plus its name, or its own FullName for a walk's +/// root. Tree walks key a visited set on it so a cyclic symlink is entered once. +let canonicalPath lexical (dir: DirectoryInfo) = + match LinkResolution.resolveLinkTarget with + | Some resolve -> + match resolve.Invoke(dir, true) with + | null -> lexical + | target -> target.FullName + | None when isUnix -> LinkResolution.tryRealpath dir.FullName |> Option.defaultValue lexical + | None -> lexical + /// Gets all files with the given pattern, skipping directories whose name starts with a dot /// (e.g. .git, .vs, .localhistory) since these are not expected to contain relevant project files /// and can be large or contain unrelated backup/history data (see issue #3250). let FindAllFiles(folder, pattern) : FileInfo [] = - let rec allFiles (dir: DirectoryInfo) = + let visited = HashSet(StringComparer.Ordinal) + let rec allFiles canonical (dir: DirectoryInfo) = seq { - yield! dir.GetFiles(pattern, SearchOption.TopDirectoryOnly) - for subDir in dir.GetDirectories() do - if not (subDir.Name.StartsWith ".") then - yield! allFiles subDir + if visited.Add canonical then + yield! dir.GetFiles(pattern, SearchOption.TopDirectoryOnly) + for subDir in dir.GetDirectories() do + if not (subDir.Name.StartsWith ".") then + yield! allFiles (canonicalPath (Path.Combine(canonical, subDir.Name)) subDir) subDir } - allFiles (DirectoryInfo(folder)) |> Seq.toArray + let root = DirectoryInfo folder + allFiles (canonicalPath root.FullName root) root |> Seq.toArray type ResolvedPackagesFolder = /// No "packages" folder for the current package diff --git a/src/Paket.Core/PaketConfigFiles/ProjectFile.fs b/src/Paket.Core/PaketConfigFiles/ProjectFile.fs index c7fac7430c..30f6cc5d87 100644 --- a/src/Paket.Core/PaketConfigFiles/ProjectFile.fs +++ b/src/Paket.Core/PaketConfigFiles/ProjectFile.fs @@ -1915,7 +1915,9 @@ type ProjectFile with let paketPath = Path.Combine(folder,Constants.PaketFilesFolderName) |> normalizePath let findAllFiles folder = - let rec search topLevel (di:DirectoryInfo) = + let visited = HashSet(StringComparer.Ordinal) + let rec search topLevel canonical (di:DirectoryInfo) = + if not (visited.Add canonical) then Array.empty else try if verbose then verbosefn "Searching %s in %s" searchPattern di.FullName @@ -1946,13 +1948,13 @@ type ProjectFile with |> not with | _ -> false) - |> Array.collect (search false) + |> Array.collect (fun sub -> search false (canonicalPath (Path.Combine(canonical, sub.Name)) sub) sub) |> Array.append files with | _ -> Array.empty - - search true (DirectoryInfo folder) + let root = DirectoryInfo folder + search true (canonicalPath root.FullName root) root findAllFiles folder diff --git a/tests/Paket.Tests/Paket.Tests.fsproj b/tests/Paket.Tests/Paket.Tests.fsproj index 832e4e2a91..1c0326989a 100644 --- a/tests/Paket.Tests/Paket.Tests.fsproj +++ b/tests/Paket.Tests/Paket.Tests.fsproj @@ -166,6 +166,7 @@ + diff --git a/tests/Paket.Tests/ProjectFile/SymlinkLoopSpecs.fs b/tests/Paket.Tests/ProjectFile/SymlinkLoopSpecs.fs new file mode 100644 index 0000000000..c63d4b3376 --- /dev/null +++ b/tests/Paket.Tests/ProjectFile/SymlinkLoopSpecs.fs @@ -0,0 +1,51 @@ +module Paket.ProjectFile.SymlinkLoopSpecs + +open System +open System.IO +open Paket +open NUnit.Framework +open FsUnit + +let private withTempRoot f = + if isWindows then Assert.Ignore "directory symlinks need elevation on Windows" + let root = Path.Combine(Path.GetTempPath(), "paket-symlink-" + Guid.NewGuid().ToString("N")) + Directory.CreateDirectory root |> ignore + try f root + finally Directory.Delete(root, true) + +// Regression: a cyclic directory symlink (e.g. inside a Nix `.devenv` profile) +// used to recurse project discovery forever. +[] +[] +let ``FindAllProjectFiles terminates on symlink cycles and finds each project once`` () = + withTempRoot (fun root -> + let loopLink = Path.Combine(root, "sub", "loop") + Directory.CreateDirectory(Path.Combine(root, "sub")) |> ignore + File.WriteAllText(Path.Combine(root, "Real.fsproj"), "") + SymlinkUtils.makeDirectoryLink loopLink ".." // sub/loop -> root + try + ProjectFile.FindAllProjectFiles root + |> Array.filter (fun fi -> fi.Name = "Real.fsproj") + |> Array.length + |> shouldEqual 1 + finally + SymlinkUtils.delete loopLink) // so the recursive delete cannot follow it + +// Positive control: symlinks are still followed, and the project keeps the path it +// was reached by. +[] +let ``FindAllProjectFiles follows a symlink to a directory outside the root`` () = + withTempRoot (fun root -> + let outside = Path.Combine(root, "outside") + let searchRoot = Path.Combine(root, "search") + let link = Path.Combine(searchRoot, "linked") + Directory.CreateDirectory outside |> ignore + Directory.CreateDirectory searchRoot |> ignore + File.WriteAllText(Path.Combine(outside, "Linked.fsproj"), "") + SymlinkUtils.makeDirectoryLink link outside + try + ProjectFile.FindAllProjectFiles searchRoot + |> Array.map (fun fi -> fi.FullName) + |> shouldEqual [| Path.Combine(link, "Linked.fsproj") |] + finally + SymlinkUtils.delete link)