0bd8b17b59
This will allow distributed migration: Start a migration in one clone of a repo, and then update other clones. commitMigration is a bit of a bear.. There is some inversion of control that needs some TMVars. Also streamLogFile's finalizer does not handle recording the trees, so an interrupt at just the wrong time can cause migration.log to be emptied but the git-annex branch not updated. Sponsored-by: Graham Spencer on Patreon
102 lines
3.3 KiB
Haskell
102 lines
3.3 KiB
Haskell
{- git-annex migration logs
|
|
-
|
|
- To record a migration in the git-annex branch as space efficiently as
|
|
- possible, it is stored as a tree which contains two subtrees 'old' and 'new'.
|
|
- The subtrees each contain the same filenames, which point to the old
|
|
- and new keys respectively.
|
|
-
|
|
- When the user commits the migrated files to their HEAD branch, that will
|
|
- store pointers to the new keys in git. And pointers to the old keys
|
|
- already exist in git. So recording the migration this way avoids
|
|
- injecting any new objects into git, besides the two trees. Note that for
|
|
- this to be the case, care has to be taken to record the migration
|
|
- using the same symlink targets or pointer file contents as are used in
|
|
- the HEAD branch.
|
|
-
|
|
- The filenames used in the trees are not the original filenames, to avoid
|
|
- running migrate in a throwaway branch unexpectedly recording that
|
|
- branch's contents.
|
|
-
|
|
- Copyright 2023 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
|
|
|
|
module Logs.Migrate (
|
|
MigrationRecord(..),
|
|
logMigration,
|
|
commitMigration,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import qualified Git
|
|
import qualified Annex
|
|
import qualified Annex.Branch
|
|
import Git.Types
|
|
import Git.Tree
|
|
import Git.FilePath
|
|
import Logs.File
|
|
import Logs
|
|
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Control.Concurrent.STM
|
|
|
|
-- | What to use to record a migration. This should be the same Sha that is
|
|
-- used to as the content of the annexed file in the HEAD branch.
|
|
newtype MigrationRecord = MigrationRecord { fromMigrationRecord :: Git.Sha }
|
|
|
|
-- | Logs a migration from an old to a new key.
|
|
--
|
|
-- This writes to a log file, which can later be committed. That allows an
|
|
-- interrupted migration to be resumed later.
|
|
logMigration :: MigrationRecord -> MigrationRecord -> Annex ()
|
|
logMigration old new = do
|
|
logf <- fromRepo gitAnnexMigrateLog
|
|
lckf <- fromRepo gitAnnexMigrateLock
|
|
appendLogFile logf lckf $ L.fromStrict $
|
|
Git.fromRef' (fromMigrationRecord old)
|
|
<> " "
|
|
<> Git.fromRef' (fromMigrationRecord new)
|
|
|
|
-- | Commits a migration to the git-annex branch.
|
|
commitMigration :: Annex ()
|
|
commitMigration = do
|
|
logf <- fromRawFilePath <$> fromRepo gitAnnexMigrateLog
|
|
lckf <- fromRepo gitAnnexMigrateLock
|
|
nv <- liftIO $ newTVarIO (0 :: Integer)
|
|
newtv <- liftIO newEmptyTMVarIO
|
|
g <- Annex.gitRepo
|
|
oldt <- withMkTreeHandle g $ \oldh ->
|
|
withMkTreeHandle g $ \newh ->
|
|
mkTree oldh $ \oldsend -> do
|
|
newt <- mkTree newh $ \newsend ->
|
|
streamLogFile logf lckf noop $
|
|
processor nv oldsend newsend
|
|
liftIO $ atomically $ writeTMVar newtv newt
|
|
newt <- liftIO $ atomically $ takeTMVar newtv
|
|
n <- liftIO $ atomically $ readTVar nv
|
|
when (n > 0) $ do
|
|
treesha <- liftIO $ flip recordTree g $ Tree
|
|
[ RecordedSubTree (asTopFilePath "old") oldt []
|
|
, RecordedSubTree (asTopFilePath "new") newt []
|
|
]
|
|
Annex.Branch.rememberTreeish treesha
|
|
(asTopFilePath migrationTreeGraftPoint)
|
|
where
|
|
processor nv oldsend newsend s = case words s of
|
|
(old:new:[]) -> do
|
|
fn <- liftIO $ atomically $ do
|
|
n <- readTVar nv
|
|
let !n' = succ n
|
|
writeTVar nv n'
|
|
return (asTopFilePath (encodeBS (show n')))
|
|
let rec f r = f
|
|
(fromTreeItemType TreeFile)
|
|
BlobObject
|
|
(Git.Ref (encodeBS r))
|
|
fn
|
|
void $ rec oldsend old
|
|
void $ rec newsend new
|
|
_ -> error "migrate.log parse error"
|