update Annex.reposizes when changing location logs

The live update is only needed when Annex.reposizes has already been
populated.
This commit is contained in:
Joey Hess 2024-08-15 13:27:14 -04:00
parent c376b1bd7e
commit 06064f897c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 69 additions and 28 deletions

View file

@ -410,15 +410,21 @@ getRef ref file = withIndex $ catFile ref file
change :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> content) -> Annex ()
change ru file f = lockJournal $ \jl -> f <$> getToChange ru file >>= set jl ru file
{- Applies a function which can modify the content of a file, or not. -}
maybeChange :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> Maybe content) -> Annex ()
{- Applies a function which can modify the content of a file, or not.
-
- Returns True when the file was modified. -}
maybeChange :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> Maybe content) -> Annex Bool
maybeChange ru file f = lockJournal $ \jl -> do
v <- getToChange ru file
case f v of
Just jv ->
let b = journalableByteString jv
in when (v /= b) $ set jl ru file b
_ -> noop
in if v /= b
then do
set jl ru file b
return True
else return False
_ -> return False
data ChangeOrAppend t = Change t | Append t

View file

@ -12,6 +12,7 @@ module Annex.RepoSize (
) where
import Annex.Common
import Annex.RepoSize.LiveUpdate
import qualified Annex
import Annex.Branch (UnmergedBranches(..), getBranch)
import Types.RepoSize
@ -86,17 +87,3 @@ journalledRepoSizes startmap branchsha =
accumsizes k (newlocs, removedlocs) m = return $
let m' = foldl' (flip $ M.alter $ addKeyRepoSize k) m newlocs
in foldl' (flip $ M.alter $ removeKeyRepoSize k) m' removedlocs
addKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
addKeyRepoSize k mrs = case mrs of
Just (RepoSize sz) -> Just $ RepoSize $ sz + ksz
Nothing -> Just $ RepoSize ksz
where
ksz = fromMaybe 0 $ fromKey keySize k
removeKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
removeKeyRepoSize k mrs = case mrs of
Just (RepoSize sz) -> Just $ RepoSize $ sz - ksz
Nothing -> Nothing
where
ksz = fromMaybe 0 $ fromKey keySize k

View file

@ -0,0 +1,46 @@
{- git-annex repo sizes, live updates
-
- Copyright 2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
module Annex.RepoSize.LiveUpdate where
import Annex.Common
import qualified Annex
import Types.RepoSize
import Logs.Presence.Pure
import qualified Data.Map.Strict as M
updateRepoSize :: UUID -> Key -> LogStatus -> Annex ()
updateRepoSize u k s = Annex.getState Annex.reposizes >>= \case
Nothing -> noop
Just sizemap -> do
let !sizemap' = M.adjust
(fromMaybe (RepoSize 0) . f k . Just)
u sizemap
Annex.changeState $ \st -> st
{ Annex.reposizes = Just sizemap' }
where
f = case s of
InfoPresent -> addKeyRepoSize
InfoMissing -> removeKeyRepoSize
InfoDead -> removeKeyRepoSize
addKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
addKeyRepoSize k mrs = case mrs of
Just (RepoSize sz) -> Just $ RepoSize $ sz + ksz
Nothing -> Just $ RepoSize ksz
where
ksz = fromMaybe 0 $ fromKey keySize k
removeKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
removeKeyRepoSize k mrs = case mrs of
Just (RepoSize sz) -> Just $ RepoSize $ sz - ksz
Nothing -> Nothing
where
ksz = fromMaybe 0 $ fromKey keySize k

View file

@ -32,7 +32,7 @@ recordContentIdentifier :: RemoteStateHandle -> ContentIdentifier -> Key -> Anne
recordContentIdentifier (RemoteStateHandle u) cid k = do
c <- currentVectorClock
config <- Annex.getGitConfig
Annex.Branch.maybeChange
void $ Annex.Branch.maybeChange
(Annex.Branch.RegardingUUID [u])
(remoteContentIdentifierLogFile config k)
(addcid c . parseLog)

View file

@ -40,6 +40,7 @@ module Logs.Location (
import Annex.Common
import qualified Annex.Branch
import Annex.Branch (FileContents)
import Annex.RepoSize.LiveUpdate
import Logs
import Logs.Presence
import Types.Cluster
@ -81,11 +82,13 @@ logChange key u@(UUID _) s
| isClusterUUID u = noop
| otherwise = do
config <- Annex.getGitConfig
maybeAddLog
changed <- maybeAddLog
(Annex.Branch.RegardingUUID [u])
(locationLogFile config key)
s
(LogInfo (fromUUID u))
when changed $
updateRepoSize u key s
logChange _ NoUUID _ = noop
{- Returns a list of repository UUIDs that, according to the log, have
@ -162,14 +165,15 @@ setDead key = do
ls <- compactLog <$> readLog logfile
mapM_ (go logfile) (filter (\l -> status l == InfoMissing) ls)
where
go logfile l =
go logfile l = do
let u = toUUID (fromLogInfo (info l))
c = case date l of
VectorClock v -> CandidateVectorClock $
v + realToFrac (picosecondsToDiffTime 1)
Unknown -> CandidateVectorClock 0
in addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead
addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead
(info l) c
updateRepoSize u key InfoDead
data Unchecked a = Unchecked (Annex (Maybe a))

View file

@ -49,8 +49,10 @@ addLog' ru file logstatus loginfo c =
{- When a LogLine already exists with the same status and info, but an
- older timestamp, that LogLine is preserved, rather than updating the log
- with a newer timestamp.
-
- Returns True when the log was changed.
-}
maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()
maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex Bool
maybeAddLog ru file logstatus loginfo = do
c <- currentVectorClock
Annex.Branch.maybeChange ru file $ \b ->

View file

@ -32,11 +32,6 @@ Planned schedule of work:
* Implement [[track_free_space_in_repos_via_git-annex_branch]]:
* Update Annex.reposizes in Logs.Location.logChange,
when it makes a change and when Annex.reposizes has a size
for the UUID. So Annex.reposizes is kept up-to-date
for each transfer and drop.
* When calling journalledRepoSizes make sure that the current
process is prevented from making changes to the journal in another
thread. Probably lock the journal? (No need to worry about changes made

View file

@ -575,6 +575,7 @@ Executable git-annex
Annex.ReplaceFile
Annex.RemoteTrackingBranch
Annex.RepoSize
Annex.RepoSize.LiveUpdate
Annex.SafeDropProof
Annex.SpecialRemote
Annex.SpecialRemote.Config