convert withKnownUrls to use overBranchFileContents

This only partly fixes importfeed to see journalled files, since it
separately cats metadata directly from the branch. Held off on a
changelog for a bug fix until that's dealt with.
This commit is contained in:
Joey Hess 2021-04-23 11:32:25 -04:00
parent da0a696c96
commit 657d55c401
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 8 additions and 23 deletions

View file

@ -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

View file

@ -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

View file

@ -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.