diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs index 31eedd59ce..a7266edc20 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs @@ -452,6 +452,11 @@ storeLedgerStateAt slotNo ledgerAppMode env = do when (blockSlot blk > slotNo) $ issueWarning blk when ((unBlockNo $ blockNo blk) `mod` 1000 == 0) $ reportProgress blk LedgerDB.tryFlush initLedgerDB + LedgerDB.garbageCollect initLedgerDB + . fromWithOrigin 0 + . pointSlot + . getTip + =<< IOLike.atomically (LedgerDB.getImmutableTip initLedgerDB) return (continue blk, ()) Left err -> do traceWith tracer $ LedgerErrorEvent (blockPoint blk) err diff --git a/ouroboros-consensus/changelog.d/20251008_135933_javier.sagredo_fix_double_alloc.md b/ouroboros-consensus/changelog.d/20251008_135933_javier.sagredo_fix_double_alloc.md new file mode 100644 index 0000000000..456db36250 --- /dev/null +++ b/ouroboros-consensus/changelog.d/20251008_135933_javier.sagredo_fix_double_alloc.md @@ -0,0 +1,24 @@ + + +### Patch + +- Ensure the initial handle allocated by opening a forker is deallocated in all + situations. + + + diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs index b6c6f6b087..ea67e3fde1 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs @@ -781,6 +781,7 @@ newForker h ldbEnv rr (st, rk) = do , foeSwitchVar = ldbSeq ldbEnv , foeTracer = tr , foeResourcesToRelease = (ldbOpenHandlesLock ldbEnv, k, toRelease) + , foeInitialHandleKey = rk } atomically $ modifyTVar (ldbForkers ldbEnv) $ Map.insert forkerKey forkerEnv pure $ diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Forker.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Forker.hs index 53a7fb8142..b4945d1680 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Forker.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Forker.hs @@ -19,6 +19,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.Forker , module Ouroboros.Consensus.Storage.LedgerDB.Forker ) where +import qualified Control.Monad as Monad import Control.RAWLock hiding (read) import Control.ResourceRegistry import Control.Tracer @@ -52,6 +53,9 @@ data ForkerEnv m l blk = ForkerEnv -- ^ Config , foeResourcesToRelease :: !(RAWLock m (), ResourceKey m, StrictTVar m (m ())) -- ^ Release the resources + , foeInitialHandleKey :: !(ResourceKey m) + -- ^ Resource key for the initial handle to ensure it is released. See + -- comments in 'implForkerCommit'. } deriving Generic @@ -160,19 +164,12 @@ implForkerCommit env = do AS.Empty _ -> pure () _ AS.:< closeOld' -> closeLedgerSeq (LedgerSeq closeOld') -- Finally, close the anchor of @lseq@ (which is a duplicate of - -- the head of @olddb'@). - -- - -- Note if the resource registry used to create the Forker is - -- ephemeral as the one created on each Chain selection or each - -- Forging loop iteration, this first duplicated state will be - -- closed by the resource registry closing down, so this will be - -- a double release, which is fine. We prefer keeping this - -- action just in case some client passes a registry that - -- outlives the forker. - -- - -- The rest of the states in the forker will be closed via - -- @foeResourcesToRelease@ instead of via the registry. - close $ tables $ AS.anchor lseq + -- the head of @olddb'@). To close this handle, we have to + -- release the 'foeInitialHandleKey' as that one is registered + -- on the registry used to open the forker. Releasing it will + -- call 'close' on the handle which will call 'release' on the key + -- for the handle. + Monad.void $ release foeInitialHandleKey pure (closeDiscarded, LedgerSeq newdb) ) @@ -186,6 +183,7 @@ implForkerCommit env = do { foeLedgerSeq , foeSwitchVar , foeResourcesToRelease + , foeInitialHandleKey } = env theImpossible =