Lock store creation against concurrent processes#12114
Conversation
When several cabal processes share one `--store-dir` and that store is cold, they all race `createPackageDBIfMissing`. Precisely hitting the warning above it, noting that it is not thread-safe. Fix this by using a fd-based lock, prior to attempting to create the index.
|
Thanks a lot for working on this! I was thinking about the issue in the background and came up with a different approach. Namely,
Theoretically this is slightly better in a sense that it works regardless on who else is trying to create package DB (which could be an older Cabal version, Stack, Shake, anyone) and there is no need to agree on the name of the lock file, because there is no locking. But I understand if you prefer your implementation, which is already written :) |
|
Appreciate you taking a look! Nice idea, taking more of a optimistic approach to avoid locking. It's probably benign, but I'm not too big of a fan of the idea of logic depending on reading |
|
|
||
| -- | Hold an exclusive cross-process lock on @lockPath@ for the duration of | ||
| -- @action@, creating the lock file if it does not exist. | ||
| withFileLock :: Verbosity -> FilePath -> String -> IO a -> IO a |
There was a problem hiding this comment.
I think withFileLock should go into Distribution.Simple.Utils or another utility module.
Should not we remove the lock file afterwards?
There was a problem hiding this comment.
I think withFileLock should go into Distribution.Simple.Utils or another utility module.
Will do.
Should not we remove the lock file afterwards?
I think in this case of the store-init, it would be fine. As the check falls back to the existence of the store directory. I haven't taken a good look into withIncomingUnitIdLock to judge if that's safe as well.
I don't think this is safe in the general sense. Deleting the lockfile would disjoint visibility of the lock. Consider the following sequence of events.
- A creates a lockfile and acquires lock 1.
- B sees lockfile and tries to acquire lock 1 and gets blocked.
- A finishes, unlocks lock 1 and deletes the lockfile.
- B proceeds with acquiring lock 1.
- C sees no file, creates a new lockfile and acquires lock 2.
* B and C run concurrently
|
Will this fix #11298 as well? |
Edit: Nevermind, I was only looking at the comments, and not the OP. The issue in this comment looks like the same packagedb creation function this PR fixes. The original message, however, references |
|
Could you please try to reproduce that issue locally and see if that's any difference with the cabal from this patch? |
|
There's also https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15498, which maybe fixes the same issue. Does it? Is this PR a cabal workaround for an underlying GHC problem maybe? |
| (i, r) <- takeMVar mv | ||
| either throwIO (\res -> pure (i, res)) r | ||
|
|
||
| liftIO $ forM_ results $ \(i, r) -> do |
There was a problem hiding this comment.
Is this test deterministic? Do we really need 10 threads to make it reliable? Anyway to make it deterministic with for example 2 threads?
There was a problem hiding this comment.
I don't think it's possible to make this entirely deterministic, after all we're testing for a race condition that depends on the timing of filesystem operations. The best we can do is make the timing as tight as we possibly can, and use a sufficiently large number of concurrent threads to make the race condition very likely to occur.
It's probably worth adding a comment to that extent though.
I can confirm that this PR does not fix that issue. Readjusting the reproducing test case in this PR with the following patch gives the error mentioned in issue #11298. The only difference being using a shared necessary diff to get reproducer for #11298diff --git a/cabal-testsuite/PackageTests/ConcurrentDistInplace/concurrent-inplace-init.test.hs b/cabal-testsuite/PackageTests/ConcurrentStorePackageDb/concurrent-store-init.test.hs
index 0bd5e218b..716ef80da 100644
--- a/cabal-testsuite/PackageTests/ConcurrentDistInplace/concurrent-inplace-init.test.hs
+++ b/cabal-testsuite/PackageTests/ConcurrentStorePackageDb/concurrent-store-init.test.hs
@@ -1,4 +1,11 @@
--- | Regression test for #11298.
+-- | Regression test for #11329
+--
+-- When several cabal processes share one --store-dir and that store is cold,
+-- they all race 'createPackageDBIfMissing'.
+--
+-- This test builds N independent trivial projects concurrently against one
+-- shared store. Each project gets its own build dir so the only shared state
+-- is the store package DB.
import Control.Concurrent
import Control.Exception (SomeException, throwIO, try)
@@ -8,59 +15,44 @@ import System.Directory (createDirectoryIfMissing, removePathForcibly)
import System.Exit (ExitCode (..))
import Test.Cabal.Prelude
-main = cabalTest $ expectBroken 11298 $ do
+main = cabalTest $ do
env <- getTestEnv
cabalPath <- programPath <$> requireProgramM cabalProgram
let n = 10
ids = [1 .. n] :: [Int]
root = testCurrentDir env
store = testWorkDir env </> "shared-store"
- dist = testWorkDir env </> "shared-dist"
projDir i = root </> ("p" ++ show i)
build i =
run
(Just (projDir i))
(testEnvironment env)
cabalPath
- ["--store-dir=" ++ store, "build", "--builddir=" ++ dist]
+ ["--store-dir=" ++ store, "build", "--builddir=" ++ projDir i </> "dist"]
Nothing
- -- Generate N executables that all depend on one shared library 'dep'.
- liftIO $ do
- createDirectoryIfMissing True (root </> "dep")
- writeFile (root </> "dep" </> "dep.cabal") $
+ -- Generate N independent trivial projects.
+ liftIO $ forM_ ids $ \i -> do
+ let p = projDir i
+ createDirectoryIfMissing True p
+ writeFile (p </> ("p" ++ show i ++ ".cabal")) $
unlines
[ "cabal-version: 2.4"
- , "name: dep"
+ , "name: p" ++ show i
, "version: 0.1"
- , "library"
- , " exposed-modules: Dep"
+ , "executable p" ++ show i
+ , " main-is: Main.hs"
, " build-depends: base"
, " default-language: Haskell2010"
]
- writeFile (root </> "dep" </> "Dep.hs") "module Dep where\n"
- forM_ ids $ \i -> do
- let p = projDir i
- createDirectoryIfMissing True p
- writeFile (p </> ("p" ++ show i ++ ".cabal")) $
- unlines
- [ "cabal-version: 2.4"
- , "name: p" ++ show i
- , "version: 0.1"
- , "executable p" ++ show i
- , " main-is: Main.hs"
- , " build-depends: base, dep"
- , " default-language: Haskell2010"
- ]
- writeFile (p </> "Main.hs") "import Dep ()\nmain :: IO ()\nmain = return ()\n"
- writeFile (root </> "cabal.project") $
- "packages: dep " ++ unwords ["p" ++ show i | i <- ids] ++ "\n"
- -- Warm the plan, then wipe the build tree so 'dep' is cold.
- _ <- liftIO $ build 1
- liftIO $ removePathForcibly (dist </> "build")
+ writeFile (p </> "Main.hs") "main :: IO ()\nmain = return ()\n"
+ writeFile (p </> "cabal.project") "packages: .\n"
- -- Build all projects concurrently against the shared --builddir.
+ -- Make sure the shared store package DB is cold right before the burst.
+ liftIO $ removePathForcibly store
+
+ -- Build all projects concurrently against the cold shared store.
results <- liftIO $ do
slots <- forM ids $ \i -> do
mv <- newEmptyMVar
@@ -75,7 +67,7 @@ main = cabalTest $ expectBroken 11298 $ do
liftIO $ forM_ results $ \(i, r) -> do
let out = resultOutput r
assertBool
- ("cabal build for p" ++ show i ++ " hit the package.conf.inplace race:\n" ++ out)
+ ("cabal build for p" ++ show i ++ " hit the store package.db init race:\n" ++ out)
(not ("already exists" `isInfixOf` out))
assertEqual
("cabal build for p" ++ show i ++ " failed:\n" ++ out)
I haven't looked too deeply at the GHC issue, but from a glance I'm not convinced it fixes the issue addressed by this PR. The errors noted in the issue look different enough.
Edit: woops pressed enter too early. It's a race. So by definition, no it's not deterministic. I think you mean to ask, "is this test reliable?". I ran this repeatedly with and without my fix. Without, it fails 15/15. With it succeeded, 15/15. I could reduce the number of threads, but that would reduce the probability of hitting the race. The number 10 is arbitrary. |
| (i, r) <- takeMVar mv | ||
| either throwIO (\res -> pure (i, res)) r | ||
|
|
||
| liftIO $ forM_ results $ \(i, r) -> do |
There was a problem hiding this comment.
I don't think it's possible to make this entirely deterministic, after all we're testing for a race condition that depends on the timing of filesystem operations. The best we can do is make the timing as tight as we possibly can, and use a sufficiently large number of concurrent threads to make the race condition very likely to occur.
It's probably worth adding a comment to that extent though.
| let out = resultOutput r | ||
| assertBool | ||
| ("cabal build for p" ++ show i ++ " hit the store package.db init race:\n" ++ out) | ||
| (not ("already exists" `isInfixOf` out)) |
There was a problem hiding this comment.
I think we could do better here. There are three, not two, possible outcomes of the test:
- We hit the race condition (== test failure)
- No race occurred because no two builds ran
createPackageDBIfMissingconcurrently (== inconclusive, should re-run the test) - No race occurred because the locks worked as intended (== test pass)
There was a problem hiding this comment.
I think we could do better here. There are three, not two, possible outcomes of the test:
I don't quite see what the approach you're referring to is. How do you envision being able to discern (2) from (3)?
6 participants
Fixes #11329.
Used the hypothesis in #12111 (comment) to create a reproducer. Extracted a helper from the code that used fd locks to make concurrent store additions safe, and use that when initializing the store as well.
Template Α: This PR modifies behaviour or interface
Include the following checklist in your PR:
significance: significantin the changelog file.