git-annex/Command/Uninit.hs
Joey Hess 3a05d53761
add SeekInput (not yet used)
No behavior changes (hopefully), just adding SeekInput and plumbing it
through to the JSON display code for later use.

Over the course of 2 grueling days.

withFilesNotInGit reimplemented in terms of seekHelper
should be the only possible behavior change. It seems to test as
behaving the same.

Note that seekHelper dummies up the SeekInput in the case where
segmentPaths' gives up on sorting the expanded paths because there are
too many input paths. When SeekInput later gets exposed as a json field,
that will result in it being a little bit wrong in the case where
100 or more paths are passed to a git-annex command. I think this is a
subtle enough problem to not matter. If it does turn out to be a
problem, fixing it would require splitting up the input
parameters into groups of < 100, which would make git ls-files run
perhaps more than is necessary. May want to revisit this, because that
fix seems fairly low-impact.
2020-09-15 15:41:13 -04:00

124 lines
4 KiB
Haskell

{- git-annex command
-
- Copyright 2010 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.Uninit where
import Command
import qualified Annex
import qualified Git
import qualified Git.Command
import qualified Command.Unannex
import qualified Annex.Branch
import qualified Database.Keys
import Annex.Content
import Annex.Init
import Utility.FileMode
import qualified Utility.RawFilePath as R
cmd :: Command
cmd = addCheck check $
command "uninit" SectionUtility
"de-initialize git-annex and clean out repository"
paramPaths (withParams seek)
check :: Annex ()
check = do
b <- current_branch
when (b == Annex.Branch.name) $ giveup $
"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
top <- fromRawFilePath <$> fromRepo Git.repoPath
currdir <- liftIO getCurrentDirectory
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
giveup "can only run uninit from the top of the git repository"
where
current_branch = Git.Ref . encodeBS' . Prelude.head . lines . decodeBS' <$> revhead
revhead = inRepo $ Git.Command.pipeReadStrict
[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
seek :: CmdParams -> CommandSeek
seek ps = do
l <- workTreeItems ww ps
withFilesNotInGit WarnUnmatchWorkTreeItems (\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f) l
Annex.changeState $ \s -> s { Annex.fast = True }
withFilesInGitAnnex ww Command.Unannex.seeker l
finish
where
ww = WarnUnmatchLsFiles
{- git annex symlinks that are not checked into git could be left by an
- interrupted add. -}
startCheckIncomplete :: FilePath -> Key -> CommandStart
startCheckIncomplete file _ = giveup $ unlines
[ file ++ " points to annexed content, but is not checked into git."
, "Perhaps this was left behind by an interrupted git annex add?"
, "Not continuing with uninit; either delete or git annex add the file and retry."
]
finish :: Annex ()
finish = do
annexdir <- fromRawFilePath <$> fromRepo gitAnnexDir
annexobjectdir <- fromRepo gitAnnexObjectDir
leftovers <- removeUnannexed =<< listKeys InAnnex
prepareRemoveAnnexDir annexdir
if null leftovers
then liftIO $ removeDirectoryRecursive annexdir
else giveup $ unlines
[ "Not fully uninitialized"
, "Some annexed data is still left in " ++ annexobjectdir
, "This may include deleted files, or old versions of modified files."
, ""
, "If you don't care about preserving the data, just delete the"
, "directory."
, ""
, "Or, you can move it to another location, in case it turns out"
, "something in there is important."
, ""
, "Or, you can run `git annex unused` followed by `git annex dropunused`"
, "to remove data that is not used by any tag or branch, which might"
, "take care of all the data."
, ""
, "Then run `git annex uninit` again to finish."
]
uninitialize
-- avoid normal shutdown
saveState False
inRepo $ Git.Command.run
[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.
-
- Also closes sqlite databases that might be in the directory,
- to avoid later failure to write any cached changes to them. -}
prepareRemoveAnnexDir :: FilePath -> Annex ()
prepareRemoveAnnexDir annexdir = do
Database.Keys.closeDb
liftIO $ prepareRemoveAnnexDir' annexdir
prepareRemoveAnnexDir' :: FilePath -> IO ()
prepareRemoveAnnexDir' annexdir =
dirTreeRecursiveSkipping (const False) 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.
-
- 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
lockContentForRemoval k noop removeAnnex
go c ks
, go (k:c) ks
)
enoughlinks f = catchBoolIO $ do
s <- R.getFileStatus f
return $ linkCount s > 1