use WAL mode to ensure read from db always works, even when it's being written to

Also, moved the database to a subdir, as there are multiple files.

This seems to work well with concurrent fscks, although they still do
redundant work due to the commit granularity. Occasionally two writes will
conflict, and one is then deferred and happens later.

Except, with 3 concurrent fscks, I got failures:

git-annex: user error (SQLite3 returned ErrorBusy while attempting to perform prepare "SELECT \"fscked\".\"key\"\nFROM \"fscked\"\nWHERE \"fscked\".\"key\" = ?\n": database is locked)

Argh!!!
This commit is contained in:
Joey Hess 2015-02-18 15:54:24 -04:00
parent 823cc9b800
commit af254615b2
3 changed files with 50 additions and 20 deletions

View file

@ -21,7 +21,8 @@ module Database.Fsck (
import Database.Types
import qualified Database.Handle as H
import Locations
import Utility.Directory
import Utility.PosixFiles
import Utility.Exception
import Annex
import Types.Key
import Types.UUID
@ -34,6 +35,7 @@ import Control.Monad
import Control.Monad.IfElse
import Control.Monad.IO.Class (liftIO)
import System.Directory
import System.FilePath
import Data.Maybe
import Control.Applicative
@ -56,20 +58,27 @@ Fscked
newPass :: UUID -> Annex Bool
newPass u = isJust <$> tryExclusiveLock (gitAnnexFsckDbLock u) go
where
go = liftIO. nukeFile =<< fromRepo (gitAnnexFsckDb u)
go = liftIO . void . tryIO . removeDirectoryRecursive
=<< fromRepo (gitAnnexFsckDbDir u)
{- Opens the database, creating it atomically if it doesn't exist yet. -}
openDb :: UUID -> Annex FsckHandle
openDb u = do
db <- fromRepo (gitAnnexFsckDb u)
dbdir <- fromRepo (gitAnnexFsckDbDir u)
let db = dbdir </> "db"
unlessM (liftIO $ doesFileExist db) $ do
let newdb = db ++ ".new"
h <- liftIO $ H.openDb newdb
void $ liftIO $ H.commitDb h $
void $ runMigrationSilent migrateFsck
liftIO $ H.closeDb h
setAnnexFilePerm newdb
liftIO $ renameFile newdb db
let tmpdbdir = dbdir ++ ".tmp"
let tmpdb = tmpdbdir </> "db"
liftIO $ do
createDirectoryIfMissing True tmpdbdir
h <- H.initDb tmpdb $ void $
runMigrationSilent migrateFsck
H.closeDb h
setAnnexDirPerm tmpdbdir
setAnnexFilePerm tmpdb
liftIO $ do
void $ tryIO $ removeDirectoryRecursive dbdir
rename tmpdbdir dbdir
lockFileShared =<< fromRepo (gitAnnexFsckDbLock u)
h <- liftIO $ H.openDb db
return $ FsckHandle h u