summaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-02-18 15:54:24 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-02-18 15:54:24 -0400
commitd8125c9ea6d00b41f994162a0060f39e56107b12 (patch)
tree3f52039b7be3f4a52a124eb31cdbe341fcc4270f /Database
parentd3012ca604d631122f3e304adbb5e60d5d706f82 (diff)
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!!!
Diffstat (limited to 'Database')
-rw-r--r--Database/Fsck.hs29
-rw-r--r--Database/Handle.hs33
2 files changed, 46 insertions, 16 deletions
diff --git a/Database/Fsck.hs b/Database/Fsck.hs
index 5301109bc..92c814cf1 100644
--- a/Database/Fsck.hs
+++ b/Database/Fsck.hs
@@ -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
diff --git a/Database/Handle.hs b/Database/Handle.hs
index 0a426d454..578bea31d 100644
--- a/Database/Handle.hs
+++ b/Database/Handle.hs
@@ -9,6 +9,7 @@
module Database.Handle (
DbHandle,
+ initDb,
openDb,
queryDb,
closeDb,
@@ -22,6 +23,7 @@ import Utility.Exception
import Messages
import Database.Persist.Sqlite
+import qualified Database.Sqlite as Sqlite
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent
@@ -33,6 +35,29 @@ import qualified Data.Text as T
- the database. It has a MVar which Jobs are submitted to. -}
data DbHandle = DbHandle (Async ()) (MVar Job) (MVar DbQueue)
+{- Ensures that the database is initialized. Pass the migration action for
+ - the database.
+ -
+ - The database is put into WAL mode, to prevent readers from blocking
+ - writers, and prevent a writer from blocking readers.
+ -}
+initDb :: FilePath -> SqlPersistM () -> IO DbHandle
+initDb db migration = do
+ enableWAL db
+ h <- openDb db
+ either throwIO (const $ return ()) =<< commitDb h migration
+ return h
+
+enableWAL :: FilePath -> IO ()
+enableWAL db = do
+ conn <- Sqlite.open (T.pack db)
+ stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")
+ void $ Sqlite.step stmt
+ void $ Sqlite.finalize stmt
+ Sqlite.close conn
+
+{- Opens the database, but does not perform any migrations. Only use
+ - if the database is known to exist and have the right tables. -}
openDb :: FilePath -> IO DbHandle
openDb db = do
jobs <- newEmptyMVar
@@ -120,12 +145,8 @@ queueDb h@(DbHandle _ _ qvar) maxsz a = do
then do
r <- commitDb h qa'
case r of
- Left e -> do
- print ("commit deferred", e)
- enqueue 0
- Right _ -> do
- print "commit made"
- putMVar qvar emptyDbQueue
+ Left e -> enqueue 0
+ Right _ -> putMVar qvar emptyDbQueue
else enqueue sz'
{- If flushing the queue fails, this could be because there is another