fix: serialise BuildInplaceOnly tarball extraction to prevent TOCTOU race

cabal-install/src/Distribution/Client/CmdBuild.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-
 -- | cabal-install CLI command: build
 module Distribution.Client.CmdBuild
   ( -- * The @build@ CLI and action

cabal-install/src/Distribution/Client/InstallPlan.hs

@@ -80,6 +80,7 @@ module Distribution.Client.InstallPlan
 
 import Distribution.Client.Compat.Prelude hiding (lookup, toList)
 import Distribution.Compat.Stack (WithCallStack)
+import Data.Either (fromRight)
 import Prelude ()
 
 import Distribution.Client.Types hiding (BuildOutcomes)
@@ -324,7 +325,7 @@ instance
 
   get = do
     graph <- mkInstallPlan <$> get
-    return $! either (const (error "Deserialised invalid GenericInstallPlan")) id graph
+    return $! fromRight (error "Deserialised invalid GenericInstallPlan") graph
 
 data ShowPlanNode = ShowPlanNode
   { showPlanHerald :: Doc

cabal-install/src/Distribution/Client/ProjectBuilding.hs

@@ -359,6 +359,7 @@ rebuildTargets
     | otherwise = do
         registerLock <- newLock -- serialise registration
         cacheLock <- newLock -- serialise access to setup exe cache
+        unpackLock <- newLock -- serialise tarball unpacking (avoid TOCTOU race)
         rebuildTargets' verbosity projectConfig distDirLayout installPlan sharedPackageConfig pkgsBuildStatus buildSettings $
           \downloadMap jobControl pkg pkgBuildStatus ->
             rebuildTarget
@@ -370,6 +371,7 @@ rebuildTargets
               downloadMap
               registerLock
               cacheLock
+              unpackLock
               sharedPackageConfig
               installPlan
               pkg
@@ -509,7 +511,11 @@ rebuildTarget
   -> BuildTimeSettings
   -> AsyncFetchMap
   -> Lock
+  -- ^ registerLock: serialise registration
   -> Lock
+  -- ^ cacheLock: serialise access to setup exe cache
+  -> Lock
+  -- ^ unpackLock: serialise tarball unpacking
   -> ElaboratedSharedConfig
   -> ElaboratedInstallPlan
   -> ElaboratedReadyPackage
@@ -524,6 +530,7 @@ rebuildTarget
   downloadMap
   registerLock
   cacheLock
+  unpackLock
   sharedPackageConfig
   plan
   rpkg@(ReadyPackage pkg)
@@ -570,6 +577,7 @@ rebuildTarget
         withTarballLocalDirectory
           verbosity
           distDirLayout
+          unpackLock
           tarball
           (packageId pkg)
           (elabDistDirParams sharedPackageConfig pkg)
@@ -726,6 +734,7 @@ downloadedSourceLocation pkgloc =
 withTarballLocalDirectory
   :: Verbosity
   -> DistDirLayout
+  -> Lock
   -> FilePath
   -> PackageId
   -> DistDirParams
@@ -739,6 +748,7 @@ withTarballLocalDirectory
 withTarballLocalDirectory
   verbosity
   distDirLayout@DistDirLayout{..}
+  unpackLock
   tarball
   pkgid
   dparams
@@ -778,23 +788,28 @@ withTarballLocalDirectory
                 makeRelative (normalise srcdir) $
                   distBuildDirectory dparams
         -- TODO: [nice to have] ^^ do this relative stuff better
-        exists <- doesDirectoryExist srcdir
-        -- TODO: [nice to have] use a proper file monitor rather
-        -- than this dir exists test
-        unless exists $ do
-          createDirectoryIfMissingVerbose verbosity True srcrootdir
-          unpackPackageTarball
-            verbosity
-            tarball
-            srcrootdir
-            pkgid
-            pkgTextOverride
-          moveTarballShippedDistDirectory
-            verbosity
-            distDirLayout
-            srcrootdir
-            pkgid
-            dparams
+        --
+        -- Use a lock to prevent a TOCTOU race: when two stages of the same
+        -- package (e.g. build: and host: in cross-compilation) are scheduled
+        -- concurrently, both may see the directory as non-existent and race
+        -- to unpack, corrupting the extraction and causing "No cabal file
+        -- found" errors.
+        criticalSection unpackLock $ do
+          exists <- doesDirectoryExist srcdir
+          unless exists $ do
+            createDirectoryIfMissingVerbose verbosity True srcrootdir
+            unpackPackageTarball
+              verbosity
+              tarball
+              srcrootdir
+              pkgid
+              pkgTextOverride
+            moveTarballShippedDistDirectory
+              verbosity
+              distDirLayout
+              srcrootdir
+              pkgid
+              dparams
         buildPkg (makeSymbolicPath srcdir) builddir
 
 unpackPackageTarball

cabal-install/src/Distribution/Client/ProjectOrchestration.hs

@@ -209,7 +209,7 @@ import Distribution.Utils.LogProgress
 import Distribution.Utils.NubList
   ( fromNubList
   )
-import Distribution.Utils.Path (makeSymbolicPath, (</>), (<.>))
+import Distribution.Utils.Path (makeSymbolicPath, (<.>), (</>))
 import Distribution.Verbosity
 #ifdef MIN_VERSION_unix
 import System.Posix.Signals (sigKILL, sigSEGV)
@@ -548,9 +548,9 @@ installExecutables
         , let platform = toolchainPlatform (getStage toolchains (elabStage elab))
         , let exeName = unUnqualComponentName cname
         , let dir = binDirectoryFor distDirLayout elaboratedShared elab exeName
-        , let exe = exeName <.>  exeExtension platform
+        , let exe = exeName <.> exeExtension platform
         ]
-      toolchains =  pkgConfigToolchains elaboratedShared
+      toolchains = pkgConfigToolchains elaboratedShared
 
 -- Note that it is a deliberate design choice that the 'buildTargets' is
 -- not passed to phase 1, and the various bits of input config is not