diff options
-rw-r--r-- | Annex/Drop.hs | 2 | ||||
-rw-r--r-- | Annex/NumCopies.hs (renamed from Config/NumCopies.hs) | 68 | ||||
-rw-r--r-- | Command/Copy.hs | 2 | ||||
-rw-r--r-- | Command/Drop.hs | 69 | ||||
-rw-r--r-- | Command/DropUnused.hs | 2 | ||||
-rw-r--r-- | Command/Fsck.hs | 2 | ||||
-rw-r--r-- | Command/Get.hs | 2 | ||||
-rw-r--r-- | Command/Import.hs | 24 | ||||
-rw-r--r-- | Command/Info.hs | 2 | ||||
-rw-r--r-- | Command/Mirror.hs | 2 | ||||
-rw-r--r-- | Command/NumCopies.hs | 2 | ||||
-rw-r--r-- | Limit.hs | 2 | ||||
-rw-r--r-- | Remote.hs | 4 | ||||
-rw-r--r-- | debian/changelog | 3 | ||||
-rw-r--r-- | doc/bugs/clean-duplicates_causes_data_loss.mdwn | 3 | ||||
-rw-r--r-- | doc/install/Debian.mdwn | 4 |
16 files changed, 127 insertions, 66 deletions
diff --git a/Annex/Drop.hs b/Annex/Drop.hs index 6f3b95615..a99a1edff 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -9,7 +9,7 @@ module Annex.Drop where import Common.Annex import Logs.Trust -import Config.NumCopies +import Annex.NumCopies import Types.Remote (uuid) import Types.Key (key2file) import qualified Remote diff --git a/Config/NumCopies.hs b/Annex/NumCopies.hs index 50dcdf684..879513927 100644 --- a/Config/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -1,11 +1,11 @@ -{- git-annex numcopies configuration +{- git-annex numcopies configuration and checking - - - Copyright 2014 Joey Hess <id@joeyh.name> + - Copyright 2014-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} -module Config.NumCopies ( +module Annex.NumCopies ( module Types.NumCopies, module Logs.NumCopies, getFileNumCopies, @@ -15,6 +15,8 @@ module Config.NumCopies ( defaultNumCopies, numCopiesCheck, numCopiesCheck', + verifyEnoughCopies, + knownCopies, ) where import Common.Annex @@ -24,6 +26,8 @@ import Logs.NumCopies import Logs.Trust import Annex.CheckAttr import qualified Remote +import Annex.UUID +import Annex.Content defaultNumCopies :: NumCopies defaultNumCopies = NumCopies 1 @@ -83,3 +87,61 @@ numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v numCopiesCheck' file vs have = do NumCopies needed <- getFileNumCopies file return $ length have `vs` needed + +{- Verifies that enough copies of a key exist amoung the listed remotes, + - priting an informative message if not. + -} +verifyEnoughCopies + :: String -- message to print when there are no known locations + -> Key + -> NumCopies + -> [UUID] -- repos to skip (generally untrusted remotes) + -> [UUID] -- repos that are trusted or already verified to have it + -> [Remote] -- remotes to check to see if they have it + -> Annex Bool +verifyEnoughCopies nolocmsg key need skip trusted tocheck = + helper [] [] (nub trusted) (nub tocheck) + where + helper bad missing have [] + | NumCopies (length have) >= need = return True + | otherwise = do + notEnoughCopies key need have (skip++missing) bad nolocmsg + return False + helper bad missing have (r:rs) + | NumCopies (length have) >= need = return True + | otherwise = do + let u = Remote.uuid r + let duplicate = u `elem` have + haskey <- Remote.hasKey r key + case (duplicate, haskey) of + (False, Right True) -> helper bad missing (u:have) rs + (False, Left _) -> helper (r:bad) missing have rs + (False, Right False) -> helper bad (u:missing) have rs + _ -> helper bad missing have rs + +notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> String -> Annex () +notEnoughCopies key need have skip bad nolocmsg = do + showNote "unsafe" + showLongNote $ + "Could only verify the existence of " ++ + show (length have) ++ " out of " ++ show (fromNumCopies need) ++ + " necessary copies" + Remote.showTriedRemotes bad + Remote.showLocations True key (have++skip) nolocmsg + +{- Cost ordered lists of remotes that the location log indicates + - may have a key. + - + - Also returns a list of UUIDs that are trusted to have the key + - (some may not have configured remotes). If the current repository + - currently has the key, and is not untrusted, it is included in this list. + -} +knownCopies :: Key -> Annex ([Remote], [UUID]) +knownCopies key = do + (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key + u <- getUUID + trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u) + ( pure (u:trusteduuids) + , pure trusteduuids + ) + return (remotes, trusteduuids') diff --git a/Command/Copy.hs b/Command/Copy.hs index 1b9b2aac8..5cfdabb4e 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -12,7 +12,7 @@ import Command import qualified Command.Move import qualified Remote import Annex.Wanted -import Config.NumCopies +import Annex.NumCopies cmd :: [Command] cmd = [withOptions copyOptions $ command "copy" paramPaths seek diff --git a/Command/Drop.hs b/Command/Drop.hs index 63b9ccb7f..a3ac87633 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -15,7 +15,7 @@ import Annex.UUID import Logs.Location import Logs.Trust import Logs.PreferredContent -import Config.NumCopies +import Annex.NumCopies import Annex.Content import Annex.Wanted import Annex.Notification @@ -72,7 +72,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ \content (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key let trusteduuids' = case knownpresentremote of Nothing -> trusteduuids - Just r -> nub (Remote.uuid r:trusteduuids) + Just r -> Remote.uuid r:trusteduuids untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids) u <- getUUID @@ -91,17 +91,9 @@ performRemote key afile numcopies remote = do -- Filter the remote it's being dropped from out of the lists of -- places assumed to have the key, and places to check. -- When the local repo has the key, that's one additional copy, - -- as long asthe local repo is not untrusted. - (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key - present <- inAnnex key - u <- getUUID - trusteduuids' <- if present - then ifM ((<= SemiTrusted) <$> lookupTrust u) - ( pure (u:trusteduuids) - , pure trusteduuids - ) - else pure trusteduuids - let have = filter (/= uuid) trusteduuids' + -- as long as the local repo is not untrusted. + (remotes, trusteduuids) <- knownCopies key + let have = filter (/= uuid) trusteduuids untrusteduuids <- trustGet UnTrusted let tocheck = filter (/= remote) $ Remote.remotesWithoutUUID remotes (have++untrusteduuids) @@ -131,45 +123,20 @@ cleanupRemote key remote ok = do - --force overrides and always allows dropping. -} canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool -canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force) - ( return True - , checkRequiredContent dropfrom key afile - <&&> - findCopies key numcopies skip have check - ) - -findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool -findCopies key need skip = helper [] [] - where - helper bad missing have [] - | NumCopies (length have) >= need = return True - | otherwise = notEnoughCopies key need have (skip++missing) bad - helper bad missing have (r:rs) - | NumCopies (length have) >= need = return True - | otherwise = do - let u = Remote.uuid r - let duplicate = u `elem` have - haskey <- Remote.hasKey r key - case (duplicate, haskey) of - (False, Right True) -> helper bad missing (u:have) rs - (False, Left _) -> helper (r:bad) missing have rs - (False, Right False) -> helper bad (u:missing) have rs - _ -> helper bad missing have rs - -notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool -notEnoughCopies key need have skip bad = do - unsafe - showLongNote $ - "Could only verify the existence of " ++ - show (length have) ++ " out of " ++ show (fromNumCopies need) ++ - " necessary copies" - Remote.showTriedRemotes bad - Remote.showLocations True key (have++skip) - "Rather than dropping this file, try using: git annex move" - hint - return False +canDrop dropfrom key afile numcopies have check skip = + ifM (Annex.getState Annex.force) + ( return True + , ifM (checkRequiredContent dropfrom key afile + <&&> verifyEnoughCopies nolocmsg key numcopies skip have check + ) + ( return True + , do + hint + return False + ) + ) where - unsafe = showNote "unsafe" + nolocmsg = "Rather than dropping this file, try using: git annex move" hint = showLongNote "(Use --force to override this check, or adjust numcopies.)" checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 36ff49720..d441a4bd2 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -14,7 +14,7 @@ import qualified Command.Drop import qualified Remote import qualified Git import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) -import Config.NumCopies +import Annex.NumCopies cmd :: [Command] cmd = [withOptions [Command.Drop.dropFromOption] $ diff --git a/Command/Fsck.hs b/Command/Fsck.hs index eea0ebc11..46d7c2e77 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -24,7 +24,7 @@ import Annex.Link import Logs.Location import Logs.Trust import Logs.Activity -import Config.NumCopies +import Annex.NumCopies import Annex.UUID import Utility.DataUnits import Config diff --git a/Command/Get.hs b/Command/Get.hs index 922aee06a..7e95493eb 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -12,7 +12,7 @@ import Command import qualified Remote import Annex.Content import Annex.Transfer -import Config.NumCopies +import Annex.NumCopies import Annex.Wanted import qualified Command.Move diff --git a/Command/Import.hs b/Command/Import.hs index 261bd7b8e..eb21faea2 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -17,6 +17,9 @@ import Remote import Types.KeySource import Types.Key import Annex.CheckIgnore +import Annex.NumCopies +import Types.TrustLevel +import Logs.Trust cmd :: [Command] cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek @@ -76,8 +79,14 @@ start mode (srcfile, destfile) = where deletedup k = do showNote $ "duplicate of " ++ key2file k - liftIO $ removeFile srcfile - next $ return True + ifM (verifiedExisting k destfile) + ( do + liftIO $ removeFile srcfile + next $ return True + , do + warning "Could not verify that the content is still present in the annex; not removing from the import location." + stop + ) importfile = do ignored <- not <$> Annex.getState Annex.force <&&> checkIgnored destfile if ignored @@ -120,3 +129,14 @@ start mode (srcfile, destfile) = CleanDuplicates -> checkdup (Just deletedup) Nothing SkipDuplicates -> checkdup Nothing (Just importfile) _ -> return (Just importfile) + +verifiedExisting :: Key -> FilePath -> Annex Bool +verifiedExisting key destfile = do + -- Look up the numcopies setting for the file that it would be + -- imported to, if it were imported. + need <- getFileNumCopies destfile + + (remotes, trusteduuids) <- knownCopies key + untrusteduuids <- trustGet UnTrusted + let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids) + verifyEnoughCopies [] key need trusteduuids [] tocheck diff --git a/Command/Info.hs b/Command/Info.hs index b7cb3232f..1c2dd2fb2 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -30,7 +30,7 @@ import Types.Key import Logs.UUID import Logs.Trust import Logs.Location -import Config.NumCopies +import Annex.NumCopies import Remote import Config import Utility.Percentage diff --git a/Command/Mirror.hs b/Command/Mirror.hs index a04efb89b..14f70d3b6 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -14,7 +14,7 @@ import qualified Command.Drop import qualified Command.Get import qualified Remote import Annex.Content -import Config.NumCopies +import Annex.NumCopies cmd :: [Command] cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs index 6c69b2166..1e710f561 100644 --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -10,7 +10,7 @@ module Command.NumCopies where import Common.Annex import qualified Annex import Command -import Config.NumCopies +import Annex.NumCopies import Types.Messages cmd :: [Command] @@ -15,7 +15,7 @@ import qualified Backend import Annex.Content import Annex.UUID import Logs.Trust -import Config.NumCopies +import Annex.NumCopies import Types.TrustLevel import Types.Key import Types.Group @@ -282,7 +282,9 @@ showLocations separateuntrusted key exclude nolocmsg = do let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted) ppuuidswanted <- prettyPrintUUIDs "wanted" uuidswanted ppuuidsskipped <- prettyPrintUUIDs "skipped" uuidsskipped - showLongNote $ message ppuuidswanted ppuuidsskipped + let msg = message ppuuidswanted ppuuidsskipped + unless (null msg) $ + showLongNote msg ignored <- filter (remoteAnnexIgnore . gitconfig) <$> remoteList unless (null ignored) $ showLongNote $ "(Note that these git remotes have annex-ignore set: " ++ unwords (map name ignored) ++ ")" diff --git a/debian/changelog b/debian/changelog index 2db52813e..ec53afd4f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -18,6 +18,9 @@ git-annex (5.20150421) UNRELEASED; urgency=medium * Improve integration with KDE's file manager to work with dolphin version 14.12.3 while still being compatable with 4.14.2. Thanks, silvio. + * import: Before removing a duplicate file in --deduplicate or + --clean-duplicates mode, verify that enough copies of its content still + exist. -- Joey Hess <id@joeyh.name> Tue, 21 Apr 2015 15:54:10 -0400 diff --git a/doc/bugs/clean-duplicates_causes_data_loss.mdwn b/doc/bugs/clean-duplicates_causes_data_loss.mdwn index df1f7e131..c5d545420 100644 --- a/doc/bugs/clean-duplicates_causes_data_loss.mdwn +++ b/doc/bugs/clean-duplicates_causes_data_loss.mdwn @@ -25,3 +25,6 @@ g-a import --clean-duplicates ~/tmp/importme (containing a, b and c) into 'impor ### Please provide any additional information below. I can provide the script if it is wanted (coded in Perl, couple of non-core dependencies). + +> Decided to go ahead and make it check remotes like drop does, so [[done]] +> --[[Joey]] diff --git a/doc/install/Debian.mdwn b/doc/install/Debian.mdwn index c71d4d244..3401afded 100644 --- a/doc/install/Debian.mdwn +++ b/doc/install/Debian.mdwn @@ -2,6 +2,10 @@ sudo apt-get install git-annex +## Debian 8.0 "jessie" + + sudo apt-get install git-annex + ## Debian 7.0 "wheezy": sudo apt-get install git-annex |