Revert "avoid double work in git-annex init"

This reverts commit 0f10f208a7c76061b7d48aaa7ea0fa8e641cace3.

The implementation of this turns out to be unsafe; it can lead to a keys
db deadlock. scanAnnexedFiles injects a call to inAnnex into
reconcileStaged, but inAnnex sometimes needs to read from the keys db,
which will try to re-open it when it's in the process of being opened.
The exclusive lock of gitAnnexKeysDbLock will then deadlock.

This needs to be done in some other way...

diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs
index 8d09adf7a88f79cd7ad4ad70a7745987bf718c5d..b9d45b483da96b6e41cf339fa4a2152342d380da 100644 (file)
--- a/Annex/WorkTree.hs
+++ b/Annex/WorkTree.hs
@@ -70,29 +70,27 @@ ifAnnexed file yes no = maybe no yes =<< lookupKey file
 
 {- Find all annexed files and update the keys database for them.
  - 
+ - This is expensive, and so normally the associated files are updated
+ - incrementally when changes are noticed. So, this only needs to be done
+ - when initializing/upgrading a repository.
+ -
  - Also, the content for an unlocked file may already be present as
  - an annex object. If so, populate the pointer file with it.
  - But if worktree file does not have a pointer file's content, it is left
  - as-is.
- -
- - Normally the keys database is updated incrementally when changes are
- - noticed. For an initial scan, this is faster than that incremental
- - update.
  -}
 scanAnnexedFiles :: Annex ()
-scanAnnexedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $
-       Database.Keys.runWriter' (Just reconciler) (const noop)
+scanAnnexedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $ do
+       g <- Annex.gitRepo
+       Database.Keys.runWriter $
+               liftIO . Database.Keys.SQL.dropAllAssociatedFiles
+       (l, cleanup) <- inRepo $ Git.LsTree.lsTree
+               Git.LsTree.LsTreeRecursive
+               (Git.LsTree.LsTreeLong True)
+               Git.Ref.headRef
+       catObjectStreamLsTree l want g go
+       liftIO $ void cleanup
   where
-       reconciler dbh = do
-               g <- Annex.gitRepo
-               liftIO $ Database.Keys.SQL.dropAllAssociatedFiles dbh
-               (l, cleanup) <- inRepo $ Git.LsTree.lsTree
-                       Git.LsTree.LsTreeRecursive
-                       (Git.LsTree.LsTreeLong True)
-                       Git.Ref.headRef
-               catObjectStreamLsTree l want g (go dbh)
-               liftIO $ void cleanup
-       
        -- Want to process symlinks, and regular files.
        want i = case Git.Types.toTreeItemType (Git.LsTree.mode i) of
                Just Git.Types.TreeSymlink -> Just (i, False)
@@ -105,16 +103,17 @@ scanAnnexedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $
                Just n | n < maxPointerSz -> Just (i, True)
                _ -> Nothing
        
-       go dbh getnext = liftIO getnext >>= \case
+       go getnext = liftIO getnext >>= \case
                Just ((i, isregfile), Just c) -> do
-                       maybe noop (add i isregfile dbh)
+                       maybe noop (add i isregfile)
                                (parseLinkTargetOrPointer (L.toStrict c))
-                       go dbh getnext
+                       go getnext
                _ -> return ()
        
-       add i isregfile dbh k = do
+       add i isregfile k = do
                let tf = Git.LsTree.file i
-               liftIO $ Database.Keys.SQL.addAssociatedFileFast k tf dbh
+               Database.Keys.runWriter $
+                       liftIO . Database.Keys.SQL.addAssociatedFileFast k tf
                whenM (pure isregfile <&&> inAnnex k) $ do
                        f <- fromRepo $ fromTopFilePath tf
                        liftIO (isPointerFile f) >>= \case

diff --git a/Database/Keys.hs b/Database/Keys.hs
index 778a0af1ac18b6f1ec09de15ddaf9f7aad3b2565..8b6edd80fe8fa81b9332b932714e46e9ff25af1b 100644 (file)
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -23,7 +23,6 @@ module Database.Keys (
        removeInodeCache,
        isInodeKnown,
        runWriter,
-       runWriter',
 ) where
 
 import qualified Database.Keys.SQL as SQL
@@ -74,7 +73,7 @@ runReader a = do
                v <- a (SQL.ReadHandle qh)
                return (v, st)
        go DbClosed = do
-               st' <- openDb True Nothing DbClosed
+               st' <- openDb True DbClosed
                v <- case st' of
                        (DbOpen qh) -> a (SQL.ReadHandle qh)
                        _ -> return mempty
@@ -88,15 +87,7 @@ runReaderIO a = runReader (liftIO . a)
  -
  - The database is created if it doesn't exist yet. -}
 runWriter :: (SQL.WriteHandle -> Annex ()) -> Annex ()
-runWriter = runWriter' Nothing
-
-runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()
-runWriterIO a = runWriter (liftIO . a)
-
-{- When a reconcile action is passed, it is run by reconcileStaged instead
- - of its usual scan, and must update the database in the same way. -}
-runWriter' :: Maybe (SQL.WriteHandle -> Annex ()) -> (SQL.WriteHandle -> Annex ()) -> Annex ()
-runWriter' reconciler a = do
+runWriter a = do
        h <- Annex.getRead Annex.keysdbhandle
        withDbState h go
   where
@@ -104,12 +95,15 @@ runWriter' reconciler a = do
                v <- a (SQL.WriteHandle qh)
                return (v, st)
        go st = do
-               st' <- openDb False reconciler st
+               st' <- openDb False st
                v <- case st' of
                        DbOpen qh -> a (SQL.WriteHandle qh)
                        _ -> error "internal"
                return (v, st')
 
+runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()
+runWriterIO a = runWriter (liftIO . a)
+
 {- Opens the database, creating it if it doesn't exist yet.
  -
  - Multiple readers and writers can have the database open at the same
@@ -118,10 +112,10 @@ runWriter' reconciler a = do
  - the database doesn't exist yet, one caller wins the lock and
  - can create it undisturbed.
  -}
-openDb :: Bool -> (Maybe (SQL.WriteHandle -> Annex ())) -> DbState -> Annex DbState
-openDb _ _ st@(DbOpen _) = return st
-openDb False _ DbUnavailable = return DbUnavailable
-openDb forwrite reconciler _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
+openDb :: Bool -> DbState -> Annex DbState
+openDb _ st@(DbOpen _) = return st
+openDb False DbUnavailable = return DbUnavailable
+openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
        dbdir <- fromRepo gitAnnexKeysDb
        let db = dbdir P.</> "db"
        dbexists <- liftIO $ R.doesPathExist db
@@ -139,7 +133,7 @@ openDb forwrite reconciler _ = catchPermissionDenied permerr $ withExclusiveLock
        
        open db = do
                qh <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable
-               reconcileStaged qh reconciler
+               reconcileStaged qh
                return $ DbOpen qh
 
 {- Closes the database if it was open. Any writes will be flushed to it.
@@ -229,8 +223,8 @@ isInodeKnown i s = or <$> runReaderIO ((:[]) <$$> SQL.isInodeKnown i s)
  - So when using getAssociatedFiles, have to make sure the file still
  - is an associated file.
  -}
-reconcileStaged :: H.DbQueue -> Maybe (SQL.WriteHandle -> Annex ()) -> Annex ()
-reconcileStaged qh mreconciler = do
+reconcileStaged :: H.DbQueue -> Annex ()
+reconcileStaged qh = do
        gitindex <- inRepo currentIndexFile
        indexcache <- fromRawFilePath <$> fromRepo gitAnnexKeysDbIndexCache
        withTSDelta (liftIO . genInodeCache gitindex) >>= \case
@@ -252,21 +246,12 @@ reconcileStaged qh mreconciler = do
        go cur indexcache (Just newtree) = do
                oldtree <- getoldtree
                when (oldtree /= newtree) $ do
-                       case mreconciler of
-                               Just reconciler ->
-                                       reconciler (SQL.WriteHandle qh)
-                               Nothing -> noop
                        g <- Annex.gitRepo
-                       void $ catstream $ \mdfeeder -> do
-                               case mreconciler of
-                                       Nothing -> void $ updatetodiff g
-                                               (Just (fromRef oldtree)) 
-                                               (fromRef newtree)
-                                               (procdiff mdfeeder)
-                                       Just _ -> void $ updatetodiff g
-                                               Nothing "--staged"
-                                               (procdiff mdfeeder)
-
+                       void $ catstream $ \mdfeeder -> 
+                               void $ updatetodiff g
+                                       (Just (fromRef oldtree)) 
+                                       (fromRef newtree)
+                                       (procdiff mdfeeder)
                        liftIO $ writeFile indexcache $ showInodeCache cur
                        -- Storing the tree in a ref makes sure it does not
                        -- get garbage collected, and is available to diff