git-annex/Logs/Presence.hs
Joey Hess db89e39df6
partially fix concurrency issue in updating the rollingtotal
It's possible for two processes or threads to both be doing the same
operation at the same time. Eg, both dropping the same key. If one
finishes and updates the rollingtotal, then the other one needs to be
prevented from later updating the rollingtotal as well. And they could
finish at the same time, or with some time in between.

Addressed this by making updateRepoSize be called with the journal
locked, and only once it's been determined that there is an actual
location change to record in the log. updateRepoSize waits for the
database to be updated.

When there is a redundant operation, updateRepoSize won't be called,
and the redundant LiveUpdate will be removed from the database on
garbage collection.

But: There will be a window where the redundant LiveUpdate is still
visible in the db, and processes can see it, combine it with the
rollingtotal, and arrive at the wrong size. This is a small window, but
it still ought to be addressed. Unsure if it would always be safe to
remove the redundant LiveUpdate? Consider the case where two drops and a
get are all running concurrently somehow, and the order they finish is
[drop, get, drop]. The second drop seems redundant to the first, but
it would not be safe to remove it. While this seems unlikely, it's hard
to rule out that a get and drop at different stages can both be running
at the same time.
2024-08-26 09:43:32 -04:00

96 lines
3.2 KiB
Haskell

{- git-annex presence log
-
- This is used to store presence information in the git-annex branch in
- a way that can be union merged.
-
- A line of the log will look like: "date N INFO"
- Where N=1 when the INFO is present, 0 otherwise.
-
- Copyright 2010-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Logs.Presence (
module X,
addLog,
addLog',
maybeAddLog,
readLog,
presentLogInfo,
notPresentLogInfo,
historicalLogInfo,
parseLogInfo,
) where
import Logs.Presence.Pure as X
import Annex.Common
import Annex.VectorClock
import qualified Annex.Branch
import Git.Types (RefDate)
import qualified Data.ByteString.Lazy as L
{- Adds to the log, removing any LogLines that are obsoleted. -}
addLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()
addLog ru file logstatus loginfo =
addLog' ru file logstatus loginfo =<< currentVectorClock
addLog' :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> CandidateVectorClock -> Annex ()
addLog' ru file logstatus loginfo c =
Annex.Branch.changeOrAppend ru file $ \b ->
let old = parseLog b
line = genLine logstatus loginfo c old
in if isNewInfo line old
then Annex.Branch.Append $ buildLog [line]
else Annex.Branch.Change $ buildLog $
compactLog (line : old)
{- 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.
-
- When the log was changed, the onchange action is run (with the journal
- still locked to prevent any concurrent changes) and True is returned.
-}
maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex () -> Annex Bool
maybeAddLog ru file logstatus loginfo onchange = do
c <- currentVectorClock
let f = \b ->
let old = parseLog b
line = genLine logstatus loginfo c old
in do
m <- insertNewStatus line $ logMap old
return $ buildLog $ mapLog m
Annex.Branch.maybeChange ru file f onchange
genLine :: LogStatus -> LogInfo -> CandidateVectorClock -> [LogLine] -> LogLine
genLine logstatus loginfo c old = LogLine c' logstatus loginfo
where
oldcs = map date (filter (\l -> info l == loginfo) old)
c' = advanceVectorClock c oldcs
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
readLog :: RawFilePath -> Annex [LogLine]
readLog = parseLog <$$> Annex.Branch.get
{- Reads a log and returns only the info that is still present. -}
presentLogInfo :: RawFilePath -> Annex [LogInfo]
presentLogInfo file = map info . filterPresent <$> readLog file
{- Reads a log and returns only the info that is no longer present. -}
notPresentLogInfo :: RawFilePath -> Annex [LogInfo]
notPresentLogInfo file = map info . filterNotPresent <$> readLog file
{- Reads a historical version of a log and returns the info that was in
- effect at that time.
-
- The date is formatted as shown in gitrevisions man page.
-}
historicalLogInfo :: RefDate -> RawFilePath -> Annex [LogInfo]
historicalLogInfo refdate file = parseLogInfo
<$> Annex.Branch.getHistorical refdate file
parseLogInfo :: L.ByteString -> [LogInfo]
parseLogInfo = map info . filterPresent . parseLog