temporarily remove cached keys database connection

The problem is that shutdown is not always called, particularly in the test
suite. So, a database connection would be opened, possibly some changes
queued, and then not shut down.

One way this can happen is when using Annex.eval or Annex.run with a new
state. A better fix might be to make both of them call Keys.shutdown
(and be sure to do it even if the annex action threw an error).

Complication: Sometimes they're run reusing an existing state, so shutting
down a database connection could cause problems for other users of that
same state. I think this would need a MVar holding the database handle,
so it could be emptied once shut down, and another user of the database
connection could then start up a new one if it got shut down. But, what if
2 threads were concurrently using the same database handle and one shut it
down while the other was writing to it? Urgh.

Might have to go that route eventually to get the database access to run
fast enough. For now, a quick fix to get the test suite happier, at the
expense of speed.
This commit is contained in:
Joey Hess 2015-12-16 14:05:26 -04:00
parent 622da992f8
commit 38a23928e9
Failed to extract signature
3 changed files with 1 additions and 24 deletions

View file

@ -14,7 +14,6 @@ module Database.Keys (
DbHandle,
openDb,
closeDb,
shutdown,
addAssociatedFile,
getAssociatedFiles,
getAssociatedKey,
@ -84,24 +83,7 @@ closeDb :: DbHandle -> IO ()
closeDb (DbHandle h) = H.closeDb h
withDbHandle :: (H.DbHandle -> IO a) -> Annex a
withDbHandle a = do
(DbHandle h) <- dbHandle
liftIO $ a h
dbHandle :: Annex DbHandle
dbHandle = maybe startup return =<< Annex.getState Annex.keysdbhandle
where
startup = do
h <- openDb
Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
return h
shutdown :: Annex ()
shutdown = maybe noop go =<< Annex.getState Annex.keysdbhandle
where
go h = do
Annex.changeState $ \s -> s { Annex.keysdbhandle = Nothing }
liftIO $ closeDb h
withDbHandle a = bracket openDb (liftIO . closeDb) (\(DbHandle h) -> liftIO (a h))
addAssociatedFile :: Key -> FilePath -> Annex ()
addAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do