From f46e4c9b7c90267c38d44354bf690ce07f761182 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 24 May 2021 14:46:59 -0400
Subject: [PATCH] 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
---
 Annex/Wanted.hs  |  5 +++--
 Database/Keys.hs | 29 ++++++++++++-----------------
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs
index a1ac7b20c4..3ce7fe328f 100644
--- 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 a7ef6c7933..6a3b43cb54 100644
--- 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