diff --git a/CHANGELOG b/CHANGELOG index 09df02f01d..02c5e316c5 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -41,7 +41,7 @@ git-annex (10.20230408) UNRELEASED; urgency=medium (addunused, configremote, dead, describe, dropunused, enableremote, expire, fix, importfeed, init, initremote, log, merge, migrate, reinit, reinject, rekey, renameremote, rmurl, semitrust, setpresentkey, trust, - unannex, undo, untrust, unused, upgrade) + unannex, undo, uninit, untrust, unused, upgrade) * log: When --raw-date is used, display only seconds from the epoch, as documented, omitting a trailing "s" that was included in the output before. diff --git a/CmdLine/GitAnnexShell/Checks.hs b/CmdLine/GitAnnexShell/Checks.hs index 448a172e78..9de66eec6f 100644 --- a/CmdLine/GitAnnexShell/Checks.hs +++ b/CmdLine/GitAnnexShell/Checks.hs @@ -78,7 +78,7 @@ checkDirectory mdir = do {- Modifies a Command to check that it is run in either a git-annex - repository, or a repository with a gcrypt-id set. -} gitAnnexShellCheck :: Command -> Command -gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists +gitAnnexShellCheck = addCheck GitAnnexShellOk okforshell . dontCheck repoExists where okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $ giveup "Not a git-annex or gcrypt repository." diff --git a/Command.hs b/Command.hs index 3af63d284f..7c4caeffa7 100644 --- a/Command.hs +++ b/Command.hs @@ -125,17 +125,17 @@ commonChecks :: [CommandCheck] commonChecks = [repoExists] repoExists :: CommandCheck -repoExists = CommandCheck 0 (ensureInitialized remoteList) +repoExists = CommandCheck RepoExists (ensureInitialized remoteList) notBareRepo :: Command -> Command -notBareRepo = addCheck checkNotBareRepo +notBareRepo = addCheck CheckNotBareRepo checkNotBareRepo checkNotBareRepo :: Annex () checkNotBareRepo = whenM (fromRepo Git.repoIsLocalBare) $ giveup "You cannot run this command in a bare repository." noDaemonRunning :: Command -> Command -noDaemonRunning = addCheck $ whenM (isJust <$> daemonpid) $ +noDaemonRunning = addCheck NoDaemonRunning $ whenM (isJust <$> daemonpid) $ giveup "You cannot run this command while git-annex watch or git-annex assistant is running." where daemonpid = liftIO . checkDaemon . fromRawFilePath @@ -144,9 +144,9 @@ noDaemonRunning = addCheck $ whenM (isJust <$> daemonpid) $ dontCheck :: CommandCheck -> Command -> Command dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c -addCheck :: Annex () -> Command -> Command -addCheck check cmd = mutateCheck cmd $ \c -> - CommandCheck (length c + 100) check : c +addCheck :: CommandCheckId -> Annex () -> Command -> Command +addCheck cid check cmd = mutateCheck cmd $ \c -> + CommandCheck cid check : c mutateCheck :: Command -> ([CommandCheck] -> [CommandCheck]) -> Command mutateCheck cmd@(Command { cmdcheck = c }) a = cmd { cmdcheck = a c } diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 809140473f..59b8f2845b 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2021 Joey Hess + - Copyright 2010-2023 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -11,6 +11,7 @@ import Command import qualified Git import qualified Git.Command import qualified Git.Ref +import qualified Git.Branch import qualified Command.Unannex import qualified Annex.Branch import qualified Annex.Queue @@ -23,23 +24,60 @@ import Utility.FileMode import qualified Utility.RawFilePath as R import System.PosixCompat.Files (linkCount) +import Control.Concurrent.STM cmd :: Command -cmd = addCheck check $ +cmd = withAnnexOptions [jsonOptions] $ command "uninit" SectionUtility "de-initialize git-annex and clean out repository" paramNothing (withParams seek) -check :: Annex () -check = do - b <- current_branch - when (b == Just Annex.Branch.name) $ giveup $ - "cannot uninit when the " ++ Git.fromRef Annex.Branch.name ++ " branch is checked out" - top <- fromRepo Git.repoPath - currdir <- liftIO R.getCurrentDirectory - whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ - giveup "can only run uninit from the top of the git repository" +seek :: CmdParams -> CommandSeek +seek = withNothing $ do + ok <- liftIO $ newTVarIO False + let checkok v a = do + liftIO $ atomically $ writeTVar ok v + () <- a + liftIO $ atomically $ readTVar ok + let recordok = do + liftIO $ atomically $ writeTVar ok True + return True + let recordnotok = liftIO $ atomically $ writeTVar ok False + + whenM (checkok False $ commandAction $ checkCanUninit recordok) $ do + let symlinksok = checkok True $ withFilesNotInGit + (CheckGitIgnore False) + (WarnUnmatchWorkTreeItems "uninit") + (checksymlinks recordnotok) + =<< workTreeItems ww [] + whenM symlinksok $ do + withFilesInGitAnnex ww (Command.Unannex.seeker True) + =<< workTreeItems ww [] + whenM (checkok False $ commandAction $ removeAnnexDir recordok) $ + whenM (checkok False $ commandAction $ completeUnitialize recordok) $ + liftIO exitSuccess where + ww = WarnUnmatchLsFiles "uninit" + checksymlinks recordnotok (_, f) = + commandAction $ lookupKey f >>= \case + Nothing -> stop + Just k -> startCheckIncomplete recordnotok f k + +checkCanUninit :: CommandCleanup -> CommandStart +checkCanUninit recordok = + starting "uninit check" (ActionItemOther Nothing) (SeekInput []) $ do + runchecks + next recordok + where + runchecks = do + b <- current_branch + when (b == Just Annex.Branch.name) $ giveup $ + "cannot uninit when the " ++ Git.fromRef Annex.Branch.name ++ " branch is checked out" + top <- fromRepo Git.repoPath + currdir <- liftIO R.getCurrentDirectory + whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ + giveup "can only run uninit from the top of the git repository" + current_branch = ifM (inRepo Git.Ref.headExists) ( Just . Git.Ref . encodeBS . Prelude.head . lines . decodeBS <$> revhead @@ -48,65 +86,49 @@ check = do revhead = inRepo $ Git.Command.pipeReadStrict [Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] -seek :: CmdParams -> CommandSeek -seek = withNothing $ do - withFilesNotInGit - (CheckGitIgnore False) - (WarnUnmatchWorkTreeItems "uninit") - checksymlinks - =<< workTreeItems ww [] - withFilesInGitAnnex ww (Command.Unannex.seeker True) - =<< workTreeItems ww [] - finish - where - ww = WarnUnmatchLsFiles "uninit" - checksymlinks (_, f) = - commandAction $ lookupKey f >>= \case - Nothing -> stop - Just k -> startCheckIncomplete (fromRawFilePath f) k - {- 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." - ] +startCheckIncomplete :: Annex () -> RawFilePath -> Key -> CommandStart +startCheckIncomplete recordnotok file key = + starting "uninit check" (mkActionItem (file, key)) (SeekInput []) $ do + recordnotok + giveup $ unlines err + where + err = + [ fromRawFilePath 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 +removeAnnexDir :: CommandCleanup -> CommandStart +removeAnnexDir recordok = do Annex.Queue.flush 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 " ++ fromRawFilePath 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 - whenM (inRepo $ Git.Ref.exists Annex.Branch.fullname) $ - inRepo $ Git.Command.run - [Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name] - liftIO exitSuccess + starting ("uninit objects") (ActionItemOther (Just (QuotedPath annexobjectdir))) (SeekInput []) $ do + leftovers <- removeUnannexed =<< listKeys InAnnex + prepareRemoveAnnexDir annexdir + if null leftovers + then do + liftIO $ removeDirectoryRecursive annexdir + next recordok + else giveup $ unlines + [ "Not fully uninitialized" + , "Some annexed data is still left in " ++ fromRawFilePath 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." + ] {- Turn on write bits in all remaining files in the annex directory, in - preparation for removal. @@ -140,3 +162,17 @@ removeUnannexed = go [] enoughlinks f = catchBoolIO $ do s <- R.getFileStatus f return $ linkCount s > 1 + +completeUnitialize :: CommandCleanup -> CommandStart +completeUnitialize recordok = + starting ("uninit finish") (ActionItemOther Nothing) (SeekInput []) $ do + uninitialize + removeAnnexBranch + next recordok + +removeAnnexBranch :: Annex () +removeAnnexBranch = do + -- avoid normal shutdown commit to the branch + saveState False + whenM (inRepo $ Git.Ref.exists Annex.Branch.fullname) $ + inRepo $ Git.Branch.delete Annex.Branch.name diff --git a/Types/Command.hs b/Types/Command.hs index 4f3a2b8632..e58b220a87 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -24,7 +24,7 @@ import Types.ActionItem type CommandParser = Parser CommandSeek {- b. The check stage runs checks, that error out if - anything prevents the command from running. -} -data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () } +data CommandCheck = CommandCheck { idCheck :: CommandCheckId, runCheck :: Annex () } {- c. The seek stage is passed input from the parser, looks through - the repo to find things to act on (ie, new files to add), and - runs commandAction to handle all necessary actions. -} @@ -136,3 +136,10 @@ descSection SectionAddOn = "Addon commands" newtype DryRun = DryRun Bool deriving (Show) + +data CommandCheckId + = CheckNotBareRepo + | RepoExists + | NoDaemonRunning + | GitAnnexShellOk + deriving (Show, Ord, Eq) diff --git a/doc/git-annex-uninit.mdwn b/doc/git-annex-uninit.mdwn index bef080c546..2f8c218ae7 100644 --- a/doc/git-annex-uninit.mdwn +++ b/doc/git-annex-uninit.mdwn @@ -14,7 +14,17 @@ git repository plus the previously annexed files. # OPTIONS -* The [[git-annex-common-options]](1) can be used. +* `--json` + + Enable JSON output. This is intended to be parsed by programs that use + git-annex. Each line of output is a JSON object. + +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the JSON instead. + +* Also the [[git-annex-common-options]](1) can be used. # SEE ALSO diff --git a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn index 6900198592..8ad0fe41a1 100644 --- a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn +++ b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn @@ -42,12 +42,10 @@ These commands have been updated to support --json: * git-annex-initremote * git-annex-enableremote * git-annex-configremote +* git-annex-uninit These commands could support json, but I punted: -* git-annex-uninit (hard to support --json-error-messages because it does - pre-check and post-unannex things that are not usual actions and so would - not show as json objects without more work) * git-annex-version (--raw already exists, and the output is fairly machine parseable already. It would be possible to jsonize the output to make it possibly more machine parseable. But I'm doubtful that would be useful.