diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 35a7b5e18b..6a0f831c11 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -765,8 +765,8 @@ rememberTreeishLocked treeish graftpoint jl = do -} overBranchFileContents :: (RawFilePath -> Maybe v) - -> (Annex (Maybe (v, RawFilePath, Maybe L.ByteString)) -> Annex ()) - -> Annex () + -> (Annex (Maybe (v, RawFilePath, Maybe L.ByteString)) -> Annex a) + -> Annex a overBranchFileContents select go = do st <- update g <- Annex.gitRepo @@ -796,7 +796,7 @@ overBranchFileContents select go = do Nothing -> drain buf =<< getJournalledFilesStale Just fs -> drain buf fs catObjectStreamLsTree l (select' . getTopFilePath . Git.LsTree.file) g go' - liftIO $ void cleanup + `finally` liftIO (void cleanup) where getnext [] = Nothing getnext (f:fs) = case select f of diff --git a/Logs/Web.hs b/Logs/Web.hs index 426b0f6396..749586352e 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -30,9 +30,6 @@ import Logs import Logs.Presence import Logs.Location import qualified Annex.Branch -import qualified Git.LsTree -import Git.CatFile (catObjectStreamLsTree) -import Git.FilePath import Utility.Url import Annex.UUID import qualified Types.Remote as Remote @@ -90,26 +87,14 @@ setUrlMissing key url = do {- Finds all known urls. -} withKnownUrls :: (Annex (Maybe (Key, [URLString])) -> Annex a) -> Annex a -withKnownUrls a = do - {- Ensure any journalled changes are committed to the git-annex - - branch, since we're going to look at its tree. -} - _ <- Annex.Branch.update - Annex.Branch.commit =<< Annex.Branch.commitMessage - (l, cleanup) <- inRepo $ Git.LsTree.lsTree - Git.LsTree.LsTreeRecursive - (Git.LsTree.LsTreeLong False) - Annex.Branch.fullname - g <- Annex.gitRepo - let want = urlLogFileKey . getTopFilePath . Git.LsTree.file - catObjectStreamLsTree l want g (\reader -> a (go reader)) - `finally` void (liftIO cleanup) +withKnownUrls a = Annex.Branch.overBranchFileContents urlLogFileKey (a . go) where - go reader = liftIO reader >>= \case - Just (k, Just content) -> + go reader = reader >>= \case + Just (k, _, Just content) -> case geturls content of [] -> go reader us -> return (Just (k, us)) - Just (_, Nothing) -> go reader + Just (_, _, Nothing) -> go reader Nothing -> return Nothing geturls = map (decodeBS . fromLogInfo) . getLog diff --git a/doc/todo/hiding_a_repository.mdwn b/doc/todo/hiding_a_repository.mdwn index 41d18ad895..25563338bc 100644 --- a/doc/todo/hiding_a_repository.mdwn +++ b/doc/todo/hiding_a_repository.mdwn @@ -156,7 +156,7 @@ later write. > * Any other similar direct accesses of the branch, not going through > Annex.Branch, also need to be fixed (and may be missing journal files > already?) Command.ImportFeed.knownItems is one. Command.Log behavior -> needs to be investigated, may be ok. And Logs.Web.withKnownUrls is another. +> needs to be investigated, may be ok. > > * Need to implement regardingPrivateUUID and privateUUIDsKnown, > which need to look at the git config to find the private uuids.