summaryrefslogtreecommitdiff
path: root/Command/Uninit.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-07-11 14:52:53 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-07-11 14:52:53 -0400
commit4d925d77c2af45ac655f2246890f5f12ecef728e (patch)
tree37ae14c9abb7a62f61fbfcec7b9e204f71d13f99 /Command/Uninit.hs
parent5886bcd2a804dc7b5c3285bfbfe86fe3516a0b6e (diff)
uninit: Avoid failing final removal in some direct mode repositories due to file modes.
Specifically .map files.
Diffstat (limited to 'Command/Uninit.hs')
-rw-r--r--Command/Uninit.hs11
1 files changed, 11 insertions, 0 deletions
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 76022df26..4433de6d0 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -16,6 +16,10 @@ import qualified Command.Unannex
import qualified Annex.Branch
import Annex.Content
import Annex.Init
+import Utility.FileMode
+
+import System.IO.HVFS
+import System.IO.HVFS.Utils
def :: [Command]
def = [addCheck check $ command "uninit" paramPaths seek
@@ -56,6 +60,7 @@ finish = do
annexdir <- fromRepo gitAnnexDir
annexobjectdir <- fromRepo gitAnnexObjectDir
leftovers <- removeUnannexed =<< getKeysPresent InAnnex
+ liftIO $ prepareRemoveAnnexDir annexdir
if null leftovers
then liftIO $ removeDirectoryRecursive annexdir
else error $ unlines
@@ -82,6 +87,12 @@ finish = do
[Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name]
liftIO exitSuccess
+{- Turn on write bits in all remaining files in the annex directory, in
+ - preparation for removal. -}
+prepareRemoveAnnexDir :: FilePath -> IO ()
+prepareRemoveAnnexDir annexdir =
+ recurseDir SystemFS annexdir >>= mapM_ (void . tryIO . allowWrite)
+
{- 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.
-