git-annex/Command/DropKey.hs
Joey Hess 2a45b5ae9a
avoid failure to lock content of removed file causing drop etc to fail
This was already prevented in other ways, but as seen in commit
c30fd24d91, those were a bit fragile.
And I'm not sure races were avoided in every case before. At least a
race between two separate git-annex processes, dropping the same
content, seemed possible.

This way, if locking fails, and the content is not present, it will
always do the right thing. Also, it avoids the overhead of an unncessary
inAnnex check for every file.

This commit was sponsored by Denis Dzyubenko on Patreon.
2020-07-25 11:59:33 -04:00

59 lines
1.4 KiB
Haskell

{- git-annex command
-
- Copyright 2010,2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.DropKey where
import Command
import qualified Annex
import Logs.Location
import Annex.Content
cmd :: Command
cmd = noCommit $ withGlobalOptions [jsonOptions] $
command "dropkey" SectionPlumbing
"drops annexed content for specified keys"
(paramRepeating paramKey)
(seek <$$> optParser)
data DropKeyOptions = DropKeyOptions
{ toDrop :: [String]
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser DropKeyOptions
optParser desc = DropKeyOptions
<$> cmdParams desc
<*> parseBatchOption
seek :: DropKeyOptions -> CommandSeek
seek o = do
unlessM (Annex.getState Annex.force) $
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
withKeys (commandAction . start) (toDrop o)
case batchOption o of
Batch fmt -> batchInput fmt (pure . parsekey) $
batchCommandAction . start
NoBatch -> noop
where
parsekey = maybe (Left "bad key") Right . deserializeKey
start :: Key -> CommandStart
start key = starting "dropkey" (mkActionItem key) $
perform key
perform :: Key -> CommandPerform
perform key = ifM (inAnnex key)
( lockContentForRemoval key (next $ cleanup key) $ \contentlock -> do
removeAnnex contentlock
next $ cleanup key
, next $ return True
)
cleanup :: Key -> CommandCleanup
cleanup key = do
logStatus key InfoMissing
return True