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.

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