summaryrefslogtreecommitdiff
path: root/Core.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-08 16:47:36 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-08 17:00:34 -0400
commit6395b790ce3d2f97803f0c642af71d1a9eb169c6 (patch)
tree76ac64f2451d138e8cf476b5d66d2e4594686cdf /Core.hs
parentba59ac13b25d5be671e38cb7b4c40257f3fdac4f (diff)
Reorganised the layout of .git/annex/
Diffstat (limited to 'Core.hs')
-rw-r--r--Core.hs77
1 files changed, 54 insertions, 23 deletions
diff --git a/Core.hs b/Core.hs
index 7aadfb5fb..90af62eb6 100644
--- a/Core.hs
+++ b/Core.hs
@@ -25,6 +25,7 @@ import qualified Annex
import qualified Backend
import Utility
import Messages
+import Version
{- Runs a list of Annex actions. Catches IO errors and continues
- (but explicitly thrown errors terminate the whole command).
@@ -54,16 +55,14 @@ startup = do
{- When git-annex is done, it runs this. -}
shutdown :: Annex Bool
shutdown = do
- g <- Annex.gitRepo
-
- -- Runs all queued git commands.
q <- Annex.queueGet
unless (q == GitQueue.empty) $ do
- verbose $ liftIO $ putStrLn "Recording state in git..."
- liftIO $ GitQueue.run g q
+ showSideAction "Recording state in git..."
+ Annex.queueRun
-- clean up any files left in the temp directory, but leave
-- the tmp directory itself
+ g <- Annex.gitRepo
let tmp = annexTmpLocation g
exists <- liftIO $ doesDirectoryExist tmp
when (exists) $ liftIO $ removeDirectoryRecursive tmp
@@ -140,13 +139,12 @@ logStatus key status = do
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp key action = do
g <- Annex.gitRepo
- let dest = annexLocation g key
let tmp = annexTmpLocation g ++ keyFile key
liftIO $ createDirectoryIfMissing True (parentDir tmp)
success <- action tmp
if (success)
then do
- liftIO $ renameFile tmp dest
+ moveToObjectDir key tmp
logStatus key ValuePresent
return True
else do
@@ -154,17 +152,28 @@ getViaTmp key action = do
-- to resume its transfer
return False
+{- Moves a file into .git/annex/objects/ -}
+moveToObjectDir :: Key -> FilePath -> Annex ()
+moveToObjectDir key src = do
+ g <- Annex.gitRepo
+ let dest = annexLocation g key
+ liftIO $ createDirectoryIfMissing True (parentDir dest)
+ liftIO $ renameFile src dest
+ -- TODO directory and file mode tweaks
+
{- List of keys whose content exists in .git/annex/objects/ -}
getKeysPresent :: Annex [Key]
getKeysPresent = do
g <- Annex.gitRepo
- let top = annexObjectDir g
- contents <- liftIO $ getDirectoryContents top
- files <- liftIO $ filterM (isreg top) contents
+ getKeysPresent' $ annexObjectDir g
+getKeysPresent' :: FilePath -> Annex [Key]
+getKeysPresent' dir = do
+ contents <- liftIO $ getDirectoryContents dir
+ files <- liftIO $ filterM isreg contents
return $ map fileKey files
where
- isreg top f = do
- s <- getFileStatus $ top ++ "/" ++ f
+ isreg f = do
+ s <- getFileStatus $ dir ++ "/" ++ f
return $ isRegularFile s
{- List of keys referenced by symlinks in the git repo. -}
@@ -178,17 +187,39 @@ getKeysReferenced = do
{- Uses the annex.version git config setting to automate upgrades. -}
autoUpgrade :: Annex ()
autoUpgrade = do
+ version <- getVersion
+ case version of
+ Just "0" -> upgradeFrom0
+ Nothing -> return () -- repo not initted yet, no version
+ Just v | v == currentVersion -> return ()
+ Just _ -> error "this version of git-annex is too old for this git repository!"
+
+upgradeFrom0 :: Annex ()
+upgradeFrom0 = do
+ showSideAction "Upgrading object directory layout for git-annex 0.04..."
g <- Annex.gitRepo
- case Git.configGet g field "0" of
- "0" -> do -- before there was repo versioning
- upgradeNote "Upgrading object directory layout..."
-
- setVersion
- v | v == currentVersion -> return ()
- _ -> error "this version of git-annex is too old for this git repository!"
+ -- do the reorganisation of the files
+ let olddir = annexDir g
+ keys <- getKeysPresent' olddir
+ _ <- mapM (\k -> moveToObjectDir k $ olddir ++ "/" ++ keyFile k) keys
+
+ -- update the symlinks to the files
+ files <- liftIO $ Git.inRepo g $ Git.workTree g
+ fixlinks files
+ Annex.queueRun
+
+ setVersion
+
where
- currentVersion = "1"
- setVersion = Annex.setConfig field currentVersion
- field = "annex.version"
- upgradeNote s = verbose $ liftIO $ putStrLn $ "("++s++")"
+ fixlinks [] = return ()
+ fixlinks (f:fs) = do
+ r <- Backend.lookupFile f
+ case r of
+ Nothing -> return ()
+ Just (k, _) -> do
+ link <- calcGitLink f k
+ liftIO $ removeFile f
+ liftIO $ createSymbolicLink link f
+ Annex.queue "add" [] f
+ fixlinks fs