Permalink
Browse files

GC on meta level. Also removes old tarballs.

  • Loading branch information...
1 parent 706f571 commit 8ee0b10faca7554ded6d33134bb586bdba3318fb @br0ns committed Mar 25, 2012
Showing with 52 additions and 14 deletions.
  1. +43 −10 src/Backup.hs
  2. +9 −4 src/GC.hs
View
@@ -67,6 +67,7 @@ import qualified Data.Conduit.Extra as CE
import Data.Function
import Data.List hiding (group)
+import Data.List as List
import Data.Maybe
import Data.Ord
@@ -139,7 +140,11 @@ recordSnapshot snapCh extCh name dir = do
let snapshot = Snapshot now id
send extCh $ Ext.Put id tarball
send snapCh $ Idx.Modify_
- (\_ m -> Map.insert ((1 :: Int) + (fst $ Map.findMax m)) snapshot m)
+ (\_ m ->
+ if Map.null m
+ then Map.singleton 1 snapshot
+ else Map.insert ((1 :: Int) + (fst $ Map.findMax m)) snapshot m
+ )
key
$ Map.singleton 1 snapshot
where
@@ -662,14 +667,17 @@ bloomStat base name version = do
collectGarbage base = do
- let pri = base </> "pri"
- sec = base </> "sec"
- with (snapP base) $ \snapCh -> do
- snaps <- filter (('_'/=) . B.head . fst) `fmap` sendReply snapCh Idx.ToList
- :: IO [(ByteString, Map.Map Int Snapshot)]
- statP <- stats
- with statP $ \statCh -> do
- send statCh Quiet
+ statP <- stats
+ with statP $ \statCh -> do
+ send statCh Quiet
+ send statCh $ Say "Deleting old hash indexes"
+ -- remove old __pidx and __sidx
+ mapM_ (prune statCh) ["__pidx", "__sidx"]
+ let pri = base </> "pri"
+ sec = base </> "sec"
+ with (snapP base) $ \snapCh -> do
+ snaps <- filter (('_' /=) . B.head . fst) `fmap` sendReply snapCh Idx.ToList
+ :: IO [(ByteString, Map.Map Int Snapshot)]
extP <- backend statCh base Nothing
with extP $ \extCh -> do
let hiPSec = localIndex (sec </> "idx") $
@@ -694,8 +702,15 @@ collectGarbage base = do
GC.sweep hiCh extCh bsCh
flushChannel hiCh
-- gc mark meta
-
+ blobs <- forM (concat $ map (\(name, snaps) -> map (snapRepo $ unpack name) $ Map.elems snaps) snaps) $ \repo ->
+ B.readFile $ sec </> repo </> "_bloom"
+ ex <- doesDirectoryExist $ sec </> "pidx"
+ if ex then do
+ blob <- B.readFile $ sec </> "pidx" </> "_bloom"
+ markBloom hiChSec (blob : blobs)
+ else markBloom hiChSec blobs
-- gc sweep meta
+ GC.sweep hiChSec extCh bsCh
where
setupKidx hsCh (name, snaps) = mapM (setupKidxOne hsCh) $
zip (repeat name) $ Map.elems snaps
@@ -708,3 +723,21 @@ collectGarbage base = do
Just (_, _, hs) -> do
ls <- mapM (sendReply hsCh . HST.Lookup) hs
return $ Just $ B.concat $ map fromJust ls
+ prune statCh name = do
+ extP <- backend statCh base Nothing
+ with (snapP base) $ \snapCh -> with extP $ \extCh -> do
+ x <- sendReply snapCh $ Idx.Lookup key :: IO (Maybe (Map.Map Int Snapshot))
+ case x of
+ Nothing -> return ()
+ Just m | Map.null m -> return ()
+ | otherwise -> do
+ forM_ (List.init $ Map.elems m) $ \snap -> do
+ send statCh $ SetMessage $ snapRepo name snap
+ send extCh $ Ext.Del $ reference snap
+ flushChannel extCh
+ let (_, a) = Map.findMax m
+ send snapCh $ Idx.Insert key $ Map.singleton 1 a
+ flushChannel snapCh
+ where
+ key = pack name
+
View
@@ -11,6 +11,7 @@ import Data.List
import Data.Pickle
import Data.Tuple
+import Data.Ord (comparing)
import Util
import Control.Monad
@@ -28,9 +29,13 @@ sweep hiCh extCh bsCh = do
mapM_ (send hiCh . Idx.Delete) $ concat $ Map.elems dead
-- merge small blobs
- mapM_ merge $ takeWhile ((< minHashPerBlob) . length . fst) $
- sortBy (\(a, _) (b, _) -> length a `compare` length b) $
- map swap $ Map.toList alive
+ let blobs = takeWhile ((< minHashPerBlob) . length . fst) $
+ sortBy (comparing $ length.fst) $
+ map swap $ Map.toList alive
+ unless (length blobs < 2) $ do
+ merge blobs
+ forM_ blobs $ \(_, blobid) -> do
+ send extCh $ Ext.Del $ encode blobid
flushChannel bsCh
where
go (dead, alive) hash (clr, ID (blobid, pos))
@@ -40,7 +45,7 @@ sweep hiCh extCh bsCh = do
where
alive' = Map.insertWith (++) blobid [(hash, pos)] alive
- merge (hs, blobid) = do
+ merge blobs = forM_ blobs $ \(hs, blobid) -> do
chunks <- decode' "GC:sweep" `fmap`
(sendReply extCh $ Ext.Get $ encode blobid)
:: IO [B.ByteString]

0 comments on commit 8ee0b10

Please sign in to comment.