summaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-02-17 17:08:11 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-02-17 17:08:11 -0400
commit9abfef8c147e04ac5842933139814750ba2e9000 (patch)
tree75c5f16ba2e79c98e41eafaed9c9c54eea3490e1 /Database
parente6b87922f3ddc3e13b9ef7b724bb6b3e39c6875d (diff)
fsck: Multiple incremental fscks of different repos (some remote) can now be in progress at the same time in the same repo without it getting confused about which files have been checked for which remotes.
Diffstat (limited to 'Database')
-rw-r--r--Database/Fsck.hs37
1 files changed, 20 insertions, 17 deletions
diff --git a/Database/Fsck.hs b/Database/Fsck.hs
index e742229a5..ac3d03452 100644
--- a/Database/Fsck.hs
+++ b/Database/Fsck.hs
@@ -9,11 +9,10 @@
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
module Database.Fsck (
+ FsckHandle,
newPass,
openDb,
closeDb,
- H.commitDb,
- H.DbHandle,
addDb,
inDb,
FsckedId,
@@ -25,6 +24,7 @@ import Locations
import Utility.Directory
import Annex
import Types.Key
+import Types.UUID
import Annex.Perms
import Annex.LockFile
@@ -37,6 +37,8 @@ import System.Directory
import Data.Maybe
import Control.Applicative
+data FsckHandle = FsckHandle H.DbHandle UUID
+
{- Each key stored in the database has already been fscked as part
- of the latest incremental fsck pass. -}
share [mkPersist sqlSettings, mkMigrate "migrateFsck"] [persistLowerCase|
@@ -51,15 +53,15 @@ Fscked
- database. Removing the database in that situation would lead to crashes
- or undefined behavior.
-}
-newPass :: Annex Bool
-newPass = isJust <$> tryExclusiveLock gitAnnexFsckDbLock go
+newPass :: UUID -> Annex Bool
+newPass u = isJust <$> tryExclusiveLock (gitAnnexFsckDbLock u) go
where
- go = liftIO. nukeFile =<< fromRepo gitAnnexFsckDb
+ go = liftIO. nukeFile =<< fromRepo (gitAnnexFsckDb u)
{- Opens the database, creating it atomically if it doesn't exist yet. -}
-openDb :: Annex H.DbHandle
-openDb = do
- db <- fromRepo gitAnnexFsckDb
+openDb :: UUID -> Annex FsckHandle
+openDb u = do
+ db <- fromRepo (gitAnnexFsckDb u)
unlessM (liftIO $ doesFileExist db) $ do
let newdb = db ++ ".new"
h <- liftIO $ H.openDb newdb
@@ -68,23 +70,24 @@ openDb = do
liftIO $ H.closeDb h
setAnnexFilePerm newdb
liftIO $ renameFile newdb db
- lockFileShared =<< fromRepo gitAnnexFsckDbLock
- liftIO $ H.openDb db
+ lockFileShared =<< fromRepo (gitAnnexFsckDbLock u)
+ h <- liftIO $ H.openDb db
+ return $ FsckHandle h u
-closeDb :: H.DbHandle -> Annex ()
-closeDb h = do
+closeDb :: FsckHandle -> Annex ()
+closeDb (FsckHandle h u) = do
liftIO $ H.closeDb h
- unlockFile =<< fromRepo gitAnnexFsckDbLock
+ unlockFile =<< fromRepo (gitAnnexFsckDbLock u)
-addDb :: H.DbHandle -> Key -> IO ()
-addDb h k = H.queueDb h 1000 $
+addDb :: FsckHandle -> Key -> IO ()
+addDb (FsckHandle h _) k = H.queueDb h 1000 $
unlessM (inDb' sk) $
insert_ $ Fscked sk
where
sk = toSKey k
-inDb :: H.DbHandle -> Key -> IO Bool
-inDb h = H.runDb h . inDb' . toSKey
+inDb :: FsckHandle -> Key -> IO Bool
+inDb (FsckHandle h _) = H.runDb h . inDb' . toSKey
inDb' :: SKey -> SqlPersistM Bool
inDb' sk = do