diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-07-18 13:30:12 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-07-18 13:30:12 -0400 |
| commit | fe0dbbabc3208c79eab8390e2789ea2fc2e02981 (patch) | |
| tree | 22e5a6239ff90670b5faa3d3c8f61f218a897374 | |
| parent | 328e54d9cc3daec662ad6129bf90ef298887b10d (diff) | |
fix uninit to delete content from annex when it ended up hard linked back to the work tree
| -rw-r--r-- | Annex/Content.hs | 9 | ||||
| -rw-r--r-- | Command/Uninit.hs | 22 |
2 files changed, 27 insertions, 4 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index b0e0643d7..96f9d78fc 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -1,6 +1,6 @@ {- git-annex file content managing - - - Copyright 2010,2012 Joey Hess <joey@kitenet.net> + - Copyright 2010-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,6 +10,7 @@ module Annex.Content ( inAnnex, inAnnexSafe, + inAnnexCheck, lockContent, getViaTmp, getViaTmpChecked, @@ -56,7 +57,11 @@ import Annex.ReplaceFile {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool -inAnnex = inAnnex' id False $ liftIO . doesFileExist +inAnnex key = inAnnexCheck key $ liftIO . doesFileExist + +{- Runs an arbitrary check on a key's content. -} +inAnnexCheck :: Key -> (FilePath -> Annex Bool) -> Annex Bool +inAnnexCheck key check = inAnnex' id False check key {- Generic inAnnex, handling both indirect and direct mode. - diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 066440449..5e50c0b3a 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -63,8 +63,8 @@ start :: CommandStart start = next $ next $ do annexdir <- fromRepo gitAnnexDir annexobjectdir <- fromRepo gitAnnexObjectDir - present <- getKeysPresent - if null present + leftovers <- removeUnannexed =<< getKeysPresent + if null leftovers then liftIO $ removeDirectoryRecursive annexdir else error $ unlines [ "Not fully uninitialized" @@ -89,3 +89,21 @@ start = next $ next $ do inRepo $ Git.Command.run [Param "branch", Param "-D", Param $ show Annex.Branch.name] liftIO exitSuccess + +{- Keys that were moved out of the annex have a hard link still in the + - annex, with > 1 link count, and those can be removed. + - + - Returns keys that cannot be removed. -} +removeUnannexed :: [Key] -> Annex [Key] +removeUnannexed = go [] + where + go c [] = return c + go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks) + ( do + removeAnnex k + go c ks + , go (k:c) ks + ) + enoughlinks f = do + s <- getFileStatus f + return $ linkCount s > 1 |