summaryrefslogtreecommitdiff
path: root/Command/Fsck.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-03-10 14:46:21 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-03-10 14:46:21 -0400
commit5ab82230f7668897a62f40fa100e51bb53d0c38e (patch)
tree2be6688cf5b1746ea9a0c348233362aca37a765d /Command/Fsck.hs
parent468fecc31561064be2fe05928f9c866395c60aa8 (diff)
fsck: Fix up any broken links and misplaced content caused by the directory hash calculation bug fixed in the last release.
Diffstat (limited to 'Command/Fsck.hs')
-rw-r--r--Command/Fsck.hs30
1 files changed, 29 insertions, 1 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 94b360104..d8d0db23b 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -10,6 +10,7 @@ module Command.Fsck where
import Common.Annex
import Command
import qualified Annex
+import qualified Annex.Queue
import qualified Remote
import qualified Types.Backend
import qualified Types.Key
@@ -51,7 +52,8 @@ start from file (key, backend) = do
perform :: Key -> FilePath -> Backend -> Maybe Int -> CommandPerform
perform key file backend numcopies = check
-- order matters
- [ verifyLocationLog key file
+ [ fixLink key file
+ , verifyLocationLog key file
, checkKeySize key
, checkBackend backend key
, checkKeyNumCopies key file numcopies
@@ -129,6 +131,32 @@ check = sequence >=> dispatch
| all (== True) vs = next $ return True
| otherwise = stop
+
+{- Checks that the file's symlink points correctly to the content. -}
+fixLink :: Key -> FilePath -> Annex Bool
+fixLink key file = do
+ want <- calcGitLink file key
+ have <- liftIO $ readSymbolicLink file
+ when (want /= have) $ do
+ {- Version 3.20120227 had a bug that could cause content
+ - to be stored in the wrong hash directory. Clean up
+ - after the bug by moving the content.
+ -}
+ whenM (liftIO $ doesFileExist file) $
+ unlessM (inAnnex key) $ do
+ showNote $ "fixing content location"
+ dir <- liftIO $ parentDir <$> absPath file
+ let content = absPathFrom dir have
+ liftIO $ allowWrite (parentDir content)
+ moveAnnex key content
+
+ showNote $ "fixing link"
+ liftIO $ createDirectoryIfMissing True (parentDir file)
+ liftIO $ removeFile file
+ liftIO $ createSymbolicLink want file
+ Annex.Queue.add "add" [Param "--force", Param "--"] [file]
+ return True
+
{- Checks that the location log reflects the current status of the key,
in this repository only. -}
verifyLocationLog :: Key -> String -> Annex Bool