2010-11-02 23:04:24 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
2021-01-06 18:11:08 +00:00
|
|
|
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
|
2010-11-02 23:04:24 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2010-11-02 23:04:24 +00:00
|
|
|
-}
|
|
|
|
|
2021-04-05 17:40:31 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2010-11-02 23:04:24 +00:00
|
|
|
module Command.Drop where
|
|
|
|
|
|
|
|
import Command
|
2011-07-05 22:31:46 +00:00
|
|
|
import qualified Remote
|
|
|
|
import qualified Annex
|
2011-10-28 21:26:38 +00:00
|
|
|
import Annex.UUID
|
2011-10-15 20:21:08 +00:00
|
|
|
import Logs.Location
|
|
|
|
import Logs.Trust
|
2014-03-29 19:20:55 +00:00
|
|
|
import Logs.PreferredContent
|
2015-04-30 18:02:56 +00:00
|
|
|
import Annex.NumCopies
|
2011-10-04 04:40:47 +00:00
|
|
|
import Annex.Content
|
2012-10-08 20:06:56 +00:00
|
|
|
import Annex.Wanted
|
2014-03-22 19:01:48 +00:00
|
|
|
import Annex.Notification
|
2010-11-02 23:04:24 +00:00
|
|
|
|
2015-07-08 16:33:27 +00:00
|
|
|
cmd :: Command
|
2022-06-29 17:28:08 +00:00
|
|
|
cmd = withAnnexOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
|
2015-07-10 17:18:46 +00:00
|
|
|
command "drop" SectionCommon
|
|
|
|
"remove content of files from repository"
|
|
|
|
paramPaths (seek <$$> optParser)
|
2015-07-08 21:59:06 +00:00
|
|
|
|
|
|
|
data DropOptions = DropOptions
|
|
|
|
{ dropFiles :: CmdParams
|
2015-07-09 19:23:14 +00:00
|
|
|
, dropFrom :: Maybe (DeferredParse Remote)
|
2015-07-08 21:59:06 +00:00
|
|
|
, autoMode :: Bool
|
2015-07-09 19:23:14 +00:00
|
|
|
, keyOptions :: Maybe KeyOptions
|
2016-07-06 15:54:46 +00:00
|
|
|
, batchOption :: BatchMode
|
2015-07-08 21:59:06 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
optParser :: CmdParamsDesc -> Parser DropOptions
|
|
|
|
optParser desc = DropOptions
|
|
|
|
<$> cmdParams desc
|
2015-07-09 19:23:14 +00:00
|
|
|
<*> optional parseDropFromOption
|
2015-07-08 21:59:06 +00:00
|
|
|
<*> parseAutoOption
|
2016-08-03 16:37:12 +00:00
|
|
|
<*> optional parseKeyOptions
|
2021-08-25 18:20:33 +00:00
|
|
|
<*> parseBatchOption True
|
2015-07-08 21:59:06 +00:00
|
|
|
|
2015-07-09 19:23:14 +00:00
|
|
|
parseDropFromOption :: Parser (DeferredParse Remote)
|
2023-04-05 19:46:51 +00:00
|
|
|
parseDropFromOption = mkParseRemoteOption <$> strOption
|
2015-07-09 14:41:17 +00:00
|
|
|
( long "from" <> short 'f' <> metavar paramRemote
|
|
|
|
<> help "drop content from a remote"
|
2015-09-14 17:19:04 +00:00
|
|
|
<> completeRemotes
|
2015-07-08 21:59:06 +00:00
|
|
|
)
|
|
|
|
|
|
|
|
seek :: DropOptions -> CommandSeek
|
2020-07-24 17:27:30 +00:00
|
|
|
seek o = startConcurrency commandStages $ do
|
|
|
|
from <- case dropFrom o of
|
|
|
|
Nothing -> pure Nothing
|
|
|
|
Just f -> getParsed f >>= \remote -> do
|
|
|
|
u <- getUUID
|
|
|
|
if Remote.uuid remote == u
|
|
|
|
then pure Nothing
|
|
|
|
else pure (Just remote)
|
|
|
|
let seeker = AnnexedFileSeeker
|
2023-12-06 17:04:32 +00:00
|
|
|
{ startAction = const $ start o from
|
2020-07-24 17:27:30 +00:00
|
|
|
, checkContentPresent = case from of
|
|
|
|
Nothing -> Just True
|
|
|
|
Just _ -> Nothing
|
|
|
|
, usesLocationLog = True
|
|
|
|
}
|
2016-07-06 15:54:46 +00:00
|
|
|
case batchOption o of
|
2020-07-24 16:05:28 +00:00
|
|
|
NoBatch -> withKeyOptions (keyOptions o) (autoMode o) seeker
|
2020-07-24 17:27:30 +00:00
|
|
|
(commandAction . startKeys o from)
|
2020-07-13 21:04:02 +00:00
|
|
|
(withFilesInGitAnnex ww seeker)
|
2020-05-28 19:55:17 +00:00
|
|
|
=<< workTreeItems ww (dropFiles o)
|
2022-01-26 16:59:55 +00:00
|
|
|
Batch fmt -> batchOnly (keyOptions o) (dropFiles o) $
|
|
|
|
batchAnnexed fmt seeker (startKeys o from)
|
2016-07-06 15:54:46 +00:00
|
|
|
where
|
2023-04-25 23:26:20 +00:00
|
|
|
ww = WarnUnmatchLsFiles "drop"
|
2015-07-08 21:59:06 +00:00
|
|
|
|
2020-09-14 20:49:33 +00:00
|
|
|
start :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
|
|
|
|
start o from si file key = start' o from key afile ai si
|
2016-07-20 19:22:55 +00:00
|
|
|
where
|
2017-03-10 17:12:24 +00:00
|
|
|
afile = AssociatedFile (Just file)
|
2019-06-06 16:53:24 +00:00
|
|
|
ai = mkActionItem (key, afile)
|
2015-07-08 21:59:06 +00:00
|
|
|
|
2020-09-14 20:49:33 +00:00
|
|
|
start' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
|
|
|
|
start' o from key afile ai si =
|
2021-01-06 18:11:08 +00:00
|
|
|
checkDropAuto (autoMode o) from afile key $ \numcopies mincopies ->
|
fix longstanding indeterminite preferred content for duplicated file problem
* drop: When two files have the same content, and a preferred content
expression matches one but not the other, do not drop the file.
* sync --content, assistant: Fix an edge case where a file that is not
preferred content did not get dropped.
The sync --content edge case is that handleDropsFrom loaded associated files
and used them without verifying that the information from the database was
not stale.
It seemed best to avoid changing --want-drop's behavior, this way when
debugging a preferred content expression with it, the files matched will
still reflect the expression. So added a note to the --want-drop documentation,
to make clear it may not behave identically to git-annex drop --auto.
While it would be possible to introspect the preferred content
expression to see if it matches on filenames, and only look up the
associated files when it does, it's generally fairly rare for 2 files to
have the same content, and the database lookup is already avoided when
there's only 1 file, so I did not implement that further optimisation.
Note that there are still some situations where the associated files
database does not get locked files recorded in it, which will prevent
this fix from working.
Sponsored-by: Dartmouth College's Datalad project
2021-05-24 18:02:50 +00:00
|
|
|
stopUnless wantdrop $
|
2015-07-08 21:59:06 +00:00
|
|
|
case from of
|
2021-06-25 19:22:05 +00:00
|
|
|
Nothing -> startLocal pcc afile ai si numcopies mincopies key [] ud
|
|
|
|
Just remote -> startRemote pcc afile ai si numcopies mincopies key ud remote
|
2020-07-24 17:27:30 +00:00
|
|
|
where
|
fix longstanding indeterminite preferred content for duplicated file problem
* drop: When two files have the same content, and a preferred content
expression matches one but not the other, do not drop the file.
* sync --content, assistant: Fix an edge case where a file that is not
preferred content did not get dropped.
The sync --content edge case is that handleDropsFrom loaded associated files
and used them without verifying that the information from the database was
not stale.
It seemed best to avoid changing --want-drop's behavior, this way when
debugging a preferred content expression with it, the files matched will
still reflect the expression. So added a note to the --want-drop documentation,
to make clear it may not behave identically to git-annex drop --auto.
While it would be possible to introspect the preferred content
expression to see if it matches on filenames, and only look up the
associated files when it does, it's generally fairly rare for 2 files to
have the same content, and the database lookup is already avoided when
there's only 1 file, so I did not implement that further optimisation.
Note that there are still some situations where the associated files
database does not get locked files recorded in it, which will prevent
this fix from working.
Sponsored-by: Dartmouth College's Datalad project
2021-05-24 18:02:50 +00:00
|
|
|
wantdrop
|
|
|
|
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile Nothing
|
2020-07-24 17:27:30 +00:00
|
|
|
| otherwise = return True
|
2021-05-25 14:57:06 +00:00
|
|
|
pcc = PreferredContentChecked (autoMode o)
|
2021-06-25 19:22:05 +00:00
|
|
|
ud = case (batchOption o, keyOptions o) of
|
|
|
|
(NoBatch, Just WantUnusedKeys) -> DroppingUnused True
|
|
|
|
_ -> DroppingUnused False
|
2015-07-08 21:59:06 +00:00
|
|
|
|
2020-09-14 20:49:33 +00:00
|
|
|
startKeys :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
|
|
|
|
startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si
|
2015-05-12 17:00:06 +00:00
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
startLocal :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> DroppingUnused -> CommandStart
|
|
|
|
startLocal pcc afile ai si numcopies mincopies key preverified ud =
|
2020-09-14 20:49:33 +00:00
|
|
|
starting "drop" (OnlyActionOn key ai) si $
|
2021-06-25 19:22:05 +00:00
|
|
|
performLocal pcc key afile numcopies mincopies preverified ud
|
2010-11-02 23:04:24 +00:00
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
startRemote :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart
|
|
|
|
startRemote pcc afile ai si numcopies mincopies key ud remote =
|
2023-06-27 23:01:33 +00:00
|
|
|
starting "drop" (OnlyActionOn key ai) si $ do
|
|
|
|
showAction $ UnquotedString $ "from " ++ Remote.name remote
|
2021-06-25 19:22:05 +00:00
|
|
|
performRemote pcc key afile numcopies mincopies remote ud
|
2011-10-28 21:26:38 +00:00
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
performLocal :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> DroppingUnused -> CommandPerform
|
|
|
|
performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRemoval key fallback $ \contentlock -> do
|
2014-03-29 19:20:55 +00:00
|
|
|
u <- getUUID
|
2015-10-09 18:57:32 +00:00
|
|
|
(tocheck, verified) <- verifiableCopies key [u]
|
2021-05-25 14:57:06 +00:00
|
|
|
doDrop pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
|
2015-10-09 17:47:19 +00:00
|
|
|
( \proof -> do
|
2021-04-06 19:41:24 +00:00
|
|
|
fastDebug "Command.Drop" $ unwords
|
2015-10-09 17:47:19 +00:00
|
|
|
[ "Dropping from here"
|
2015-10-09 19:59:42 +00:00
|
|
|
, "proof:"
|
2015-10-09 17:47:19 +00:00
|
|
|
, show proof
|
|
|
|
]
|
2014-08-21 00:08:45 +00:00
|
|
|
removeAnnex contentlock
|
2014-03-22 19:01:48 +00:00
|
|
|
notifyDrop afile True
|
2021-06-25 19:22:05 +00:00
|
|
|
next $ cleanupLocal key ud
|
2015-10-09 15:09:46 +00:00
|
|
|
, do
|
2014-03-22 19:01:48 +00:00
|
|
|
notifyDrop afile False
|
|
|
|
stop
|
|
|
|
)
|
2020-07-25 15:54:34 +00:00
|
|
|
where
|
|
|
|
-- This occurs when, for example, two files are being dropped
|
|
|
|
-- and have the same content. The seek stage checks if the content
|
|
|
|
-- is present, but due to buffering, may find it present for the
|
|
|
|
-- second file before the first is dropped. If so, nothing remains
|
|
|
|
-- to be done except for cleaning up.
|
2021-06-25 19:22:05 +00:00
|
|
|
fallback = next $ cleanupLocal key ud
|
2010-11-02 23:04:24 +00:00
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
performRemote :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> DroppingUnused -> CommandPerform
|
|
|
|
performRemote pcc key afile numcopies mincopies remote ud = do
|
2019-10-21 17:51:38 +00:00
|
|
|
-- Filter the uuid it's being dropped from out of the lists of
|
2011-10-28 21:26:38 +00:00
|
|
|
-- places assumed to have the key, and places to check.
|
2015-10-09 18:57:32 +00:00
|
|
|
(tocheck, verified) <- verifiableCopies key [uuid]
|
2021-05-25 14:57:06 +00:00
|
|
|
doDrop pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
|
2015-10-09 17:47:19 +00:00
|
|
|
( \proof -> do
|
2021-04-06 19:41:24 +00:00
|
|
|
fastDebug "Command.Drop" $ unwords
|
2015-10-09 17:47:19 +00:00
|
|
|
[ "Dropping from remote"
|
|
|
|
, show remote
|
2015-10-09 20:16:03 +00:00
|
|
|
, "proof:"
|
2015-10-09 17:47:19 +00:00
|
|
|
, show proof
|
|
|
|
]
|
2020-05-14 18:19:28 +00:00
|
|
|
ok <- Remote.action (Remote.removeKey remote key)
|
2021-06-25 19:22:05 +00:00
|
|
|
next $ cleanupRemote key remote ud ok
|
2015-10-09 15:09:46 +00:00
|
|
|
, stop
|
|
|
|
)
|
2012-12-13 04:45:27 +00:00
|
|
|
where
|
2012-11-12 05:05:04 +00:00
|
|
|
uuid = Remote.uuid remote
|
2011-10-28 21:26:38 +00:00
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
cleanupLocal :: Key -> DroppingUnused -> CommandCleanup
|
|
|
|
cleanupLocal key ud = do
|
|
|
|
logStatus key (dropStatus ud)
|
2010-11-08 23:26:37 +00:00
|
|
|
return True
|
2011-07-05 22:31:46 +00:00
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
cleanupRemote :: Key -> Remote -> DroppingUnused -> Bool -> CommandCleanup
|
|
|
|
cleanupRemote key remote ud ok = do
|
bugfix: drop --from an unavailable remote no longer updates the location log, incorrectly, to say the remote does not have the key.
The comments correctly noted that the remote could drop the key and
yet False be returned due to some problem that occurred afterwards.
For example, if it's a network remote, it could drop the key just
as the network goes down, and so things timeout and a nonzero exit
from ssh is propigated through and False returned.
However... Most of the time, this scenario will not have happened.
False will mean the remote was not available or could not drop the key
at all.
So, instead of assuming the worst, just trust the status we have.
If we get it wrong, and the scenario above happened, our location
log will think the remote has the key. But the remote's location
log (assuming it has one) will know it dropped it, and the next sync
will regain consistency.
For a special remote, with no location log, our location log will be wrong,
but this is no different than the situation where someone else dropped
the key from the remote and we've not synced with them. The standard
paranoia about not trusting the location log to be the last word about
whether a remote has a key will save us from these situations. Ie,
if we try to drop the file, we'll actively check the remote,
and determine the inconsistency then.
2013-03-10 23:15:53 +00:00
|
|
|
when ok $
|
2021-06-25 19:22:05 +00:00
|
|
|
Remote.logStatus remote key (dropStatus ud)
|
2011-10-28 21:26:38 +00:00
|
|
|
return ok
|
|
|
|
|
2021-06-25 19:22:05 +00:00
|
|
|
{- Set when the user explicitly chose to operate on unused content.
|
|
|
|
- Presumably the user still expects the last git-annex unused to be
|
|
|
|
- correct at this point. -}
|
|
|
|
newtype DroppingUnused = DroppingUnused Bool
|
|
|
|
|
|
|
|
{- When explicitly dropping unused content, mark the key as dead, at least
|
|
|
|
- in the repository it was dropped from. It may still be in other
|
|
|
|
- repositories, and will not be treated as dead until dropped from all of
|
|
|
|
- them. -}
|
|
|
|
dropStatus :: DroppingUnused -> LogStatus
|
|
|
|
dropStatus (DroppingUnused False) = InfoMissing
|
|
|
|
dropStatus (DroppingUnused True) = InfoDead
|
|
|
|
|
2015-10-09 15:09:46 +00:00
|
|
|
{- Before running the dropaction, checks specified remotes to
|
|
|
|
- verify that enough copies of a key exist to allow it to be
|
|
|
|
- safely removed (with no data loss).
|
2014-03-29 19:20:55 +00:00
|
|
|
-
|
|
|
|
- --force overrides and always allows dropping.
|
|
|
|
-}
|
2015-10-09 18:57:32 +00:00
|
|
|
doDrop
|
2021-05-25 14:57:06 +00:00
|
|
|
:: PreferredContentChecked
|
|
|
|
-> UUID
|
2015-10-09 19:48:02 +00:00
|
|
|
-> Maybe ContentRemovalLock
|
2015-10-09 18:57:32 +00:00
|
|
|
-> Key
|
|
|
|
-> AssociatedFile
|
|
|
|
-> NumCopies
|
2021-01-06 18:11:08 +00:00
|
|
|
-> MinCopies
|
2015-10-09 18:57:32 +00:00
|
|
|
-> [UUID]
|
|
|
|
-> [VerifiedCopy]
|
|
|
|
-> [UnVerifiedCopy]
|
|
|
|
-> (Maybe SafeDropProof -> CommandPerform, CommandPerform)
|
|
|
|
-> CommandPerform
|
2021-05-25 14:57:06 +00:00
|
|
|
doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
|
2022-06-28 19:28:14 +00:00
|
|
|
ifM (Annex.getRead Annex.force)
|
2015-10-09 17:47:19 +00:00
|
|
|
( dropaction Nothing
|
2021-05-25 14:57:06 +00:00
|
|
|
, ifM (checkRequiredContent pcc dropfrom key afile)
|
2024-06-23 13:28:18 +00:00
|
|
|
( verifyEnoughCopiesToDrop nolocmsg key (Just dropfrom)
|
2021-01-06 18:11:08 +00:00
|
|
|
contentlock numcopies mincopies
|
2015-10-09 17:47:19 +00:00
|
|
|
skip preverified check
|
|
|
|
(dropaction . Just)
|
|
|
|
(forcehint nodropaction)
|
2015-10-09 15:09:46 +00:00
|
|
|
, stop
|
|
|
|
)
|
2015-04-30 18:02:56 +00:00
|
|
|
)
|
2012-11-12 05:05:04 +00:00
|
|
|
where
|
2015-04-30 18:02:56 +00:00
|
|
|
nolocmsg = "Rather than dropping this file, try using: git annex move"
|
2015-10-09 15:09:46 +00:00
|
|
|
forcehint a = do
|
|
|
|
showLongNote "(Use --force to override this check, or adjust numcopies.)"
|
|
|
|
a
|
2013-04-01 19:20:42 +00:00
|
|
|
|
2021-05-25 14:57:06 +00:00
|
|
|
{- Checking preferred content also checks required content, so when
|
|
|
|
- auto mode causes preferred content to be checked, it's redundant
|
|
|
|
- for checkRequiredContent to separately check required content, and
|
|
|
|
- providing this avoids that extra work. -}
|
|
|
|
newtype PreferredContentChecked = PreferredContentChecked Bool
|
|
|
|
|
|
|
|
checkRequiredContent :: PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool
|
|
|
|
checkRequiredContent (PreferredContentChecked True) _ _ _ = return True
|
|
|
|
checkRequiredContent (PreferredContentChecked False) u k afile =
|
|
|
|
checkDrop isRequiredContent False (Just u) (Just k) afile Nothing >>= \case
|
|
|
|
Nothing -> return True
|
|
|
|
Just afile' -> do
|
|
|
|
if afile == afile'
|
|
|
|
then showLongNote "That file is required content. It cannot be dropped!"
|
|
|
|
else showLongNote $ "That file has the same content as another file"
|
2023-04-10 21:03:41 +00:00
|
|
|
<> case afile' of
|
|
|
|
AssociatedFile (Just f) -> " (" <> QuotedPath f <> "),"
|
2021-05-25 14:57:06 +00:00
|
|
|
AssociatedFile Nothing -> ""
|
2023-04-10 21:03:41 +00:00
|
|
|
<> " which is required content. It cannot be dropped!"
|
2021-05-25 14:57:06 +00:00
|
|
|
showLongNote "(Use --force to override this check, or adjust required content configuration.)"
|
|
|
|
return False
|
2014-03-29 19:20:55 +00:00
|
|
|
|
2013-10-28 18:50:17 +00:00
|
|
|
{- In auto mode, only runs the action if there are enough
|
2014-01-21 21:08:49 +00:00
|
|
|
- copies on other semitrusted repositories. -}
|
2021-01-06 18:11:08 +00:00
|
|
|
checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> MinCopies -> CommandStart) -> CommandStart
|
2018-04-09 20:09:00 +00:00
|
|
|
checkDropAuto automode mremote afile key a =
|
2021-06-15 15:38:44 +00:00
|
|
|
go =<< getSafestNumMinCopies afile key
|
2013-04-01 19:20:42 +00:00
|
|
|
where
|
2021-01-06 18:11:08 +00:00
|
|
|
go (numcopies, mincopies)
|
2015-07-08 21:59:06 +00:00
|
|
|
| automode = do
|
2015-03-25 21:06:14 +00:00
|
|
|
locs <- Remote.keyLocations key
|
|
|
|
uuid <- getUUID
|
|
|
|
let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
|
|
|
|
locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs
|
2024-06-16 19:07:48 +00:00
|
|
|
if numCopiesCheck'' locs' (>=) numcopies
|
2021-01-06 18:11:08 +00:00
|
|
|
then a numcopies mincopies
|
2015-03-25 21:06:14 +00:00
|
|
|
else stop
|
2021-01-06 18:11:08 +00:00
|
|
|
| otherwise = a numcopies mincopies
|