fix case where keys db was not initialized in time

When the keys db is opened for read, and did not exist yet, it used to
skip creating it, and return mempty values. But that prevents
reconcileStaged from populating associated files information in time for
the read. This fixes the one remaining case I know of where
the fix in a56b151f9009590c97da8dbf66c1b138455657cb didn't work.

Note that, when there is a permissions error, it still avoids creating
the db and returns mempty for all queries. This does mean that
reconcileStaged does not run and so it may want to drop files that it
should not. However, presumably a permissions error on the keys database
also means that the user does not have permission to delete annex
objects, so they won't be able to drop the files anyway.

Sponsored-by: Dartmouth College's Datalad project

diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs
index a1ac7b20c4194d347eb6de29aa138cd987febc25..3ce7fe328fd29d5b01d431a387252002689f38f9 100644 (file)
--- a/Annex/Wanted.hs
+++ b/Annex/Wanted.hs
@@ -44,8 +44,9 @@ wantDrop d from key file others = do
                        others' <- case others of
                                Just afs -> pure (filter (/= file) afs)
                                Nothing -> case key of
-                                       Just k -> mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
-                                               =<< Database.Keys.getAssociatedFiles k
+                                       Just k ->
+                                               mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
+                                                       =<< Database.Keys.getAssociatedFiles k
                                        Nothing -> pure []
                        l <- filterM checkwant others'
                        if null l

diff --git a/Database/Keys.hs b/Database/Keys.hs
index a7ef6c7933b9d200c1b3b690b0df0278f79e43d6..6a3b43cb548eeaf110307ed1b0746d9cc6e58c29 100644 (file)
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -55,10 +55,6 @@ import qualified Data.ByteString.Char8 as S8
 import qualified System.FilePath.ByteString as P
 
 {- Runs an action that reads from the database.
- -
- - If the database doesn't already exist, it's not created; mempty is
- - returned instead. This way, when the keys database is not in use,
- - there's minimal overhead in checking it.
  -
  - If the database is already open, any writes are flushed to it, to ensure
  - consistency.
@@ -76,7 +72,7 @@ runReader a = do
                v <- a (SQL.ReadHandle qh)
                return (v, st)
        go DbClosed = do
-               st' <- openDb False DbClosed
+               st' <- openDb True DbClosed
                v <- case st' of
                        (DbOpen qh) -> a (SQL.ReadHandle qh)
                        _ -> return mempty
@@ -98,7 +94,7 @@ runWriter a = do
                v <- a (SQL.WriteHandle qh)
                return (v, st)
        go st = do
-               st' <- openDb True st
+               st' <- openDb False st
                v <- case st' of
                        DbOpen qh -> a (SQL.WriteHandle qh)
                        _ -> error "internal"
@@ -107,7 +103,7 @@ runWriter a = do
 runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()
 runWriterIO a = runWriter (liftIO . a)
 
-{- Opens the database, perhaps creating it if it doesn't exist yet.
+{- Opens the database, creating it if it doesn't exist yet.
  -
  - Multiple readers and writers can have the database open at the same
  - time. Database.Handle deals with the concurrency issues.
@@ -118,22 +114,21 @@ runWriterIO a = runWriter (liftIO . a)
 openDb :: Bool -> DbState -> Annex DbState
 openDb _ st@(DbOpen _) = return st
 openDb False DbUnavailable = return DbUnavailable
-openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
+openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
        dbdir <- fromRepo gitAnnexKeysDb
        let db = dbdir P.</> "db"
        dbexists <- liftIO $ R.doesPathExist db
-       case (dbexists, createdb) of
-               (True, _) -> open db
-               (False, True) -> do
+       case dbexists of
+               True -> open db
+               False -> do
                        initDb db SQL.createTables
                        open db
-               (False, False) -> return DbUnavailable
   where
-       -- If permissions don't allow opening the database, treat it as if
-       -- it does not exist.
-       permerr e = case createdb of
-               False -> return DbUnavailable
-               True -> throwM e
+       -- If permissions don't allow opening the database, and it's being
+       -- opened for read, treat it as if it does not exist.
+       permerr e
+               | forwrite = throwM e
+               | otherwise = return DbUnavailable
        
        open db = do
                qh <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable