git-annex/Command/DropUnused.hs
Joey Hess cedc28a783
prevent dropping required content of other file using same content
When two files have the same content, and a required content expression
matches one but not the other, dropping the latter file will fail as it
would also remove the content of the required file.

This will slow down drop (w/o --auto), dropunused, mirror, and move, by one
keys db lookup per file. But I did include an optimisation to avoid a
double db lookup in the drop --auto / sync --content case. I suspect that
dropunused could also use PreferredContentChecked True, but haven't
entirely thought it through and it's rarely used with enough files for the
optimisation to matter.

Sponsored-by: Dartmouth College's Datalad project
2021-05-25 11:34:06 -04:00

73 lines
2.3 KiB
Haskell

{- git-annex command
-
- Copyright 2010,2012,2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.DropUnused where
import Command
import qualified Annex
import qualified Command.Drop
import qualified Remote
import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Annex.NumCopies
import Annex.Content
import qualified Utility.RawFilePath as R
cmd :: Command
cmd = command "dropunused" SectionMaintenance
"drop unused file content"
(paramRepeating paramNumRange) (seek <$$> optParser)
data DropUnusedOptions = DropUnusedOptions
{ rangesToDrop :: CmdParams
, dropFrom :: Maybe (DeferredParse Remote)
}
optParser :: CmdParamsDesc -> Parser DropUnusedOptions
optParser desc = DropUnusedOptions
<$> cmdParams desc
<*> optional (Command.Drop.parseDropFromOption)
seek :: DropUnusedOptions -> CommandSeek
seek o = do
numcopies <- getNumCopies
mincopies <- getMinCopies
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
withUnusedMaps (start from numcopies mincopies) (rangesToDrop o)
start :: Maybe Remote -> NumCopies -> MinCopies -> UnusedMaps -> Int -> CommandStart
start from numcopies mincopies = startUnused "dropunused"
(perform from numcopies mincopies)
(performOther gitAnnexBadLocation)
(performOther gitAnnexTmpObjectLocation)
perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
perform from numcopies mincopies key = case from of
Just r -> do
showAction $ "from " ++ Remote.name r
Command.Drop.performRemote pcc key (AssociatedFile Nothing) numcopies mincopies r
Nothing -> ifM (inAnnex key)
( droplocal
, ifM (objectFileExists key)
( ifM (Annex.getState Annex.force)
( droplocal
, do
warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."
next $ return False
)
, next $ return True
)
)
where
droplocal = Command.Drop.performLocal pcc key (AssociatedFile Nothing) numcopies mincopies []
pcc = Command.Drop.PreferredContentChecked False
performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform
performOther filespec key = do
f <- fromRepo $ filespec key
pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink)
next $ return True