From 9abfef8c147e04ac5842933139814750ba2e9000 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 17 Feb 2015 17:08:11 -0400
Subject: 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.

---
 Database/Fsck.hs | 37 ++++++++++++++++++++-----------------
 1 file changed, 20 insertions(+), 17 deletions(-)

(limited to 'Database/Fsck.hs')

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
-- 
cgit v1.2.3