aboutsummaryrefslogtreecommitdiff
path: root/Core.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-13 14:59:27 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-13 14:59:27 -0400
commit5fa25a812a8a03af9f6a5fdb3d06eb4d89ee06f5 (patch)
tree467341e52d23660eee3dc05c9935c961801374e5 /Core.hs
parentd4d65a3c923de1eece50463145e875326bfe57e9 (diff)
fsck improvements
* fsck: Check if annex.numcopies is satisfied. * fsck: Verify the sha1 of files when the SHA1 backend is used. * fsck: Verify the size of files when the WORM backend is used. * fsck: Allow specifying individual files to fsk if fscking everything is not desired. * fsck: Fix bug, introduced in 0.04, in detection of unused data.
Diffstat (limited to 'Core.hs')
-rw-r--r--Core.hs18
1 files changed, 15 insertions, 3 deletions
diff --git a/Core.hs b/Core.hs
index 8497a7f36..789b369cc 100644
--- a/Core.hs
+++ b/Core.hs
@@ -14,6 +14,7 @@ import System.Path
import Control.Monad (when, unless, filterM)
import System.Posix.Files
import Data.Maybe
+import System.FilePath
import Types
import Locations
@@ -201,6 +202,16 @@ fromAnnex key dest = do
renameFile file dest
removeDirectory dir
+{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and
+ - returns the directory it was moved to. -}
+moveBad :: Key -> Annex FilePath
+moveBad key = do
+ g <- Annex.gitRepo
+ let src = parentDir $ annexLocation g key
+ let dest = annexBadLocation g
+ liftIO $ renameDirectory src dest
+ return dest
+
{- List of keys whose content exists in .git/annex/objects/ -}
getKeysPresent :: Annex [Key]
getKeysPresent = do
@@ -209,11 +220,12 @@ getKeysPresent = do
getKeysPresent' :: FilePath -> Annex [Key]
getKeysPresent' dir = do
contents <- liftIO $ getDirectoryContents dir
- files <- liftIO $ filterM isreg contents
+ files <- liftIO $ filterM present contents
return $ map fileKey files
where
- isreg f = do
- s <- getFileStatus $ dir ++ "/" ++ f
+ present d = do
+ s <- getFileStatus $ dir ++ "/" ++ d ++ "/"
+ ++ (takeFileName d)
return $ isRegularFile s
{- List of keys referenced by symlinks in the git repo. -}