diff options
| -rw-r--r-- | Annex.hs | 9 | ||||
| -rw-r--r-- | Annex/Drop.hs | 2 | ||||
| -rw-r--r-- | Annex/NumCopies.hs (renamed from Config/NumCopies.hs) | 68 | ||||
| -rw-r--r-- | CmdLine/Action.hs | 9 | ||||
| -rw-r--r-- | CmdLine/Seek.hs | 5 | ||||
| -rw-r--r-- | Command/Add.hs | 5 | ||||
| -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-- | Messages.hs | 15 | ||||
| -rw-r--r-- | Remote.hs | 4 | ||||
| -rw-r--r-- | debian/changelog | 7 | ||||
| -rw-r--r-- | doc/bugs/clean-duplicates_causes_data_loss.mdwn | 3 | ||||
| -rw-r--r-- | doc/bugs/regression:_behavior_when_files_to_add_do_not_exist/comment_4_42481bb2f6f625a9891e59ec97574164._comment | 9 | ||||
| -rw-r--r-- | doc/devblog/day_280__slow_week.mdwn | 16 | ||||
| -rw-r--r-- | doc/install/Debian.mdwn | 4 |
23 files changed, 181 insertions, 84 deletions
@@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, PackageImports #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, PackageImports, BangPatterns #-} module Annex ( Annex, @@ -32,6 +32,7 @@ module Annex ( getRemoteGitConfig, withCurrentState, changeDirectory, + incError, ) where import Common @@ -309,3 +310,9 @@ changeDirectory d = do liftIO $ setCurrentDirectory d r' <- liftIO $ Git.relPath r changeState $ \s -> s { repo = r' } + +incError :: Annex () +incError = changeState $ \s -> + let ! c = errcounter s + 1 + ! s' = s { errcounter = c } + in s' 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/CmdLine/Action.hs b/CmdLine/Action.hs index 57e1fa60b..b566621bb 100644 --- a/CmdLine/Action.hs +++ b/CmdLine/Action.hs @@ -5,8 +5,6 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} - module CmdLine.Action where import Common.Annex @@ -45,14 +43,11 @@ commandAction a = account =<< tryIO go account (Right True) = return True account (Right False) = incerr account (Left err) = do - showErr err + toplevelWarning True (show err) showEndFail incerr incerr = do - Annex.changeState $ \s -> - let ! c = Annex.errcounter s + 1 - ! s' = s { Annex.errcounter = c } - in s' + Annex.incError return False {- Runs a single command action through the start, perform and cleanup diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 1db075ec3..96076261f 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -218,8 +218,9 @@ seekHelper a params = do ll <- inRepo $ \g -> concat <$> forM (segmentXargsOrdered params) (runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g)) forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p -> - unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ - error $ p ++ " not found" + unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $ do + toplevelWarning False (p ++ " not found") + Annex.incError return $ concat ll notSymlink :: FilePath -> IO Bool diff --git a/Command/Add.hs b/Command/Add.hs index c461c4d56..d53ba91ad 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -116,7 +116,10 @@ start file = ifAnnexed file addpresent add - Lockdown can fail if a file gets deleted, and Nothing will be returned. -} lockDown :: FilePath -> Annex (Maybe KeySource) -lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDown' +lockDown = either + (\e -> warning (show e) >> return Nothing) + (return . Just) + <=< lockDown' lockDown' :: FilePath -> Annex (Either IOException KeySource) lockDown' file = ifM crippledFileSystem 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 diff --git a/Messages.hs b/Messages.hs index 0e83a7243..5dffbd8de 100644 --- a/Messages.hs +++ b/Messages.hs @@ -19,7 +19,7 @@ module Messages ( showEndOk, showEndFail, showEndResult, - showErr, + toplevelWarning, warning, warningIO, indent, @@ -117,15 +117,16 @@ showEndResult ok = handleMessage (JSON.end ok) $ putStrLn msg | ok = "ok" | otherwise = "failed" -showErr :: (Show a) => a -> Annex () -showErr e = warning' $ "git-annex: " ++ show e +toplevelWarning :: Bool -> String -> Annex () +toplevelWarning makeway s = warning' makeway ("git-annex: " ++ s) warning :: String -> Annex () -warning = warning' . indent +warning = warning' True . indent -warning' :: String -> Annex () -warning' w = do - handleMessage q $ putStr "\n" +warning' :: Bool -> String -> Annex () +warning' makeway w = do + when makeway $ + handleMessage q $ putStr "\n" liftIO $ do hFlush stdout hPutStrLn stderr w @@ -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..38db4ee67 100644 --- a/debian/changelog +++ b/debian/changelog @@ -18,6 +18,13 @@ 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. + * Improve behavior when a git-annex command is told to operate + on a file that doesn't exist. It will now continue to other + files specified after that on the command line, and only error out at + the end. -- 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/bugs/regression:_behavior_when_files_to_add_do_not_exist/comment_4_42481bb2f6f625a9891e59ec97574164._comment b/doc/bugs/regression:_behavior_when_files_to_add_do_not_exist/comment_4_42481bb2f6f625a9891e59ec97574164._comment new file mode 100644 index 000000000..4755498c1 --- /dev/null +++ b/doc/bugs/regression:_behavior_when_files_to_add_do_not_exist/comment_4_42481bb2f6f625a9891e59ec97574164._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 4""" + date="2015-04-30T18:56:31Z" + content=""" +Regression or not, it would be useful if git-annex continued past such +not-existing files to process the rest of the specified files, and only +set the error flag. +"""]] diff --git a/doc/devblog/day_280__slow_week.mdwn b/doc/devblog/day_280__slow_week.mdwn new file mode 100644 index 000000000..0c49b33bc --- /dev/null +++ b/doc/devblog/day_280__slow_week.mdwn @@ -0,0 +1,16 @@ +Reduced activity this week (didn't work on the assistant after all), +but several things got done: + +Monday: Fixed `fsck --fast --from remote` to not fail when the remote +didn't support fast copy mode. And dealt with an incompatability in S3 bucket +names; the old hS3 library supported upper-case bucket names but the new +one needs them all in lower case. + +Wednesday: Caught up on most recent backlog, made some improvements +to error handling in `import`, and improved integration with KDE's file +manager to work with newer versions. + +Today: Made `import --deduplicate/--clean-duplicates` actively +verify that enough copies of a file exist before deleting it. And, +thinking about some options for batch mode access to git-annex plumbing, +to speed up things that use it a lot. 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 |