From 5f62e03e618b20a32e3a927be2bdf71dd525d5ae Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 18 Apr 2015 14:13:07 -0400 Subject: fsck --from remote: When bad content is found in the remote, and the local repo does not have a copy of the content, preserve the bad content in .git/annex/bad/ to avoid further data loss. --- Command/Fsck.hs | 40 ++++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) (limited to 'Command/Fsck.hs') diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 08753b612..74cff7491 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -31,6 +31,7 @@ import Config import Types.Key import Types.CleanupActions import Utility.HumanTime +import Utility.CopyFile import Git.FilePath import Utility.PID import qualified Database.Fsck as FsckDb @@ -273,7 +274,7 @@ checkKeySize key = ifM isDirect checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool checkKeySizeRemote _ _ Nothing = return True checkKeySizeRemote key remote (Just file) = - checkKeySizeOr (badContentRemote remote) key file + checkKeySizeOr (badContentRemote remote file) key file checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> Annex Bool checkKeySizeOr bad key file = case Types.Key.keySize key of @@ -318,7 +319,7 @@ checkBackend backend key mfile = go =<< isDirect checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool checkBackendRemote backend key remote = maybe (return True) go where - go = checkBackendOr (badContentRemote remote) backend key + go file = checkBackendOr (badContentRemote remote file) backend key file checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool checkBackendOr bad backend key file = @@ -380,13 +381,36 @@ badContentDirect file key = do logStatus key InfoMissing return "left in place for you to examine" -badContentRemote :: Remote -> Key -> Annex String -badContentRemote remote key = do - ok <- Remote.removeKey remote key - when ok $ +{- Bad content is dropped from the remote. We have downloaded a copy + - from the remote to a temp file already (in some cases, it's just a + - symlink to a file in the remote). To avoid any further data loss, + - that temp file is moved to the bad content directory unless + - the local annex has a copy of the content. -} +badContentRemote :: Remote -> FilePath -> Key -> Annex String +badContentRemote remote localcopy key = do + bad <- fromRepo gitAnnexBadDir + let destbad = bad key2file key + movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad)) + ( return False + , do + createAnnexDirectory (parentDir destbad) + liftIO $ catchDefaultIO False $ + ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy) + ( copyFileExternal CopyTimeStamps localcopy destbad + , do + moveFile localcopy destbad + return True + ) + ) + + dropped <- Remote.removeKey remote key + when dropped $ Remote.logStatus remote key InfoMissing - return $ (if ok then "dropped from " else "failed to drop from ") - ++ Remote.name remote + return $ case (movedbad, dropped) of + (True, True) -> "moved from " ++ Remote.name remote ++ + " to " ++ destbad + (False, True) -> "dropped from " ++ Remote.name remote + (_, False) -> "failed to drop from" ++ Remote.name remote runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart runFsck inc file key a = ifM (needFsck inc key) -- cgit v1.2.3 From 2781e270c7f388d4d0e252240b84b4a299d040fd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 18 Apr 2015 14:23:34 -0400 Subject: fsck --from remote: Avoid downloading a key if it would go over the annex.diskreserve limit. --- Command/Fsck.hs | 6 ++++-- debian/changelog | 2 ++ 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'Command/Fsck.hs') diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 74cff7491..39dba08dd 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -135,14 +135,16 @@ performRemote key file backend numcopies remote = let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) cleanup cleanup `after` a tmp - getfile tmp = - ifM (Remote.retrieveKeyFileCheap remote key tmp) + getfile tmp = ifM (checkDiskSpace (Just tmp) key 0) + ( ifM (Remote.retrieveKeyFileCheap remote key tmp) ( return True , ifM (Annex.getState Annex.fast) ( return False , Remote.retrieveKeyFile remote key Nothing tmp dummymeter ) ) + , return False + ) dummymeter _ = noop startKey :: Incremental -> Key -> NumCopies -> CommandStart diff --git a/debian/changelog b/debian/changelog index 00aed03a0..2acdfac96 100644 --- a/debian/changelog +++ b/debian/changelog @@ -20,6 +20,8 @@ git-annex (5.20150410) UNRELEASED; urgency=medium * fsck --from remote: When bad content is found in the remote, and the local repo does not have a copy of the content, preserve the bad content in .git/annex/bad/ to avoid further data loss. + * fsck --from remote: Avoid downloading a key if it would go over + the annex.diskreserve limit. -- Joey Hess Thu, 09 Apr 2015 20:59:43 -0400 -- cgit v1.2.3 From 454b6c96dee4b854decdcda78c6c2b11fd43c21b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 27 Apr 2015 17:40:21 -0400 Subject: Fix bogus failure of fsck --fast. --- Command/Fsck.hs | 20 +++++++++++--------- Remote/Helper/Special.hs | 2 +- debian/changelog | 1 + doc/todo/enable_fsck_--fast_for_S3_remotes.mdwn | 3 +++ 4 files changed, 16 insertions(+), 10 deletions(-) (limited to 'Command/Fsck.hs') diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 39dba08dd..eea0ebc11 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -112,14 +112,15 @@ performRemote key file backend numcopies remote = dispatch (Left err) = do showNote err return False - dispatch (Right True) = withtmp $ \tmpfile -> - ifM (getfile tmpfile) - ( go True (Just tmpfile) - , do + dispatch (Right True) = withtmp $ \tmpfile -> do + r <- getfile tmpfile + case r of + Nothing -> go True Nothing + Just True -> go True (Just tmpfile) + Just False -> do warning "failed to download file from remote" void $ go True Nothing return False - ) dispatch (Right False) = go False Nothing go present localcopy = check [ verifyLocationLogRemote key file remote present @@ -137,13 +138,14 @@ performRemote key file backend numcopies remote = cleanup `after` a tmp getfile tmp = ifM (checkDiskSpace (Just tmp) key 0) ( ifM (Remote.retrieveKeyFileCheap remote key tmp) - ( return True + ( return (Just True) , ifM (Annex.getState Annex.fast) - ( return False - , Remote.retrieveKeyFile remote key Nothing tmp dummymeter + ( return Nothing + , Just <$> + Remote.retrieveKeyFile remote key Nothing tmp dummymeter ) ) - , return False + , return (Just False) ) dummymeter _ = noop diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 696a43a7a..7dd861a4e 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -199,7 +199,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp readBytes $ \encb -> storer (enck k) (ByteContent encb) p - -- call retrieve-r to get chunks; decrypt them; stream to dest file + -- call retriever to get chunks; decrypt them; stream to dest file retrieveKeyFileGen k dest p enc = safely $ prepareretriever k $ safely . go where diff --git a/debian/changelog b/debian/changelog index fa707a0af..24acb8144 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,7 @@ git-annex (5.20150421) UNRELEASED; urgency=medium (endpoint, port, storage class) * S3: git annex enableremote will not create a bucket name, which failed since the bucket already exists. + * Fix bogus failure of fsck --fast. -- Joey Hess Tue, 21 Apr 2015 15:54:10 -0400 diff --git a/doc/todo/enable_fsck_--fast_for_S3_remotes.mdwn b/doc/todo/enable_fsck_--fast_for_S3_remotes.mdwn index 2d269e61c..77392b36d 100644 --- a/doc/todo/enable_fsck_--fast_for_S3_remotes.mdwn +++ b/doc/todo/enable_fsck_--fast_for_S3_remotes.mdwn @@ -25,3 +25,6 @@ failed while ``git annex fsck -f S3remote`` works fine. But, to check for the presence of a file (which is my understanding of what ``--fast`` is for here), it shouldn't be necessary to download the file. + +> [[fixed|done]]; it was not supposed to fail at all in this case, and +> won't anymore. --[[Joey]] -- cgit v1.2.3 From 42ae5fec8ebbb5921f91d2052bc18d595ead2cfa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Apr 2015 14:02:56 -0400 Subject: refactor --- Annex/Drop.hs | 2 +- Annex/NumCopies.hs | 146 ++++++++++++++++++++++++++++++++++++++++++++++++++ Command/Copy.hs | 2 +- Command/Drop.hs | 64 ++++++---------------- Command/DropUnused.hs | 2 +- Command/Fsck.hs | 2 +- Command/Get.hs | 2 +- Command/Info.hs | 2 +- Command/Mirror.hs | 2 +- Command/NumCopies.hs | 2 +- Config/NumCopies.hs | 85 ----------------------------- Limit.hs | 2 +- 12 files changed, 172 insertions(+), 141 deletions(-) create mode 100644 Annex/NumCopies.hs delete mode 100644 Config/NumCopies.hs (limited to 'Command/Fsck.hs') 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/Annex/NumCopies.hs b/Annex/NumCopies.hs new file mode 100644 index 000000000..62cd93883 --- /dev/null +++ b/Annex/NumCopies.hs @@ -0,0 +1,146 @@ +{- git-annex numcopies configuration and checking + - + - Copyright 2014-2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.NumCopies ( + module Types.NumCopies, + module Logs.NumCopies, + getFileNumCopies, + getGlobalFileNumCopies, + getNumCopies, + deprecatedNumCopies, + defaultNumCopies, + numCopiesCheck, + numCopiesCheck', + verifyEnoughCopies, + knownCopies, +) where + +import Common.Annex +import qualified Annex +import Types.NumCopies +import Logs.NumCopies +import Logs.Trust +import Annex.CheckAttr +import qualified Remote +import Annex.UUID +import Annex.Content + +defaultNumCopies :: NumCopies +defaultNumCopies = NumCopies 1 + +fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies +fromSources = fromMaybe defaultNumCopies <$$> getM id + +{- The git config annex.numcopies is deprecated. -} +deprecatedNumCopies :: Annex (Maybe NumCopies) +deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig + +{- Value forced on the command line by --numcopies. -} +getForcedNumCopies :: Annex (Maybe NumCopies) +getForcedNumCopies = Annex.getState Annex.forcenumcopies + +{- Numcopies value from any of the non-.gitattributes configuration + - sources. -} +getNumCopies :: Annex NumCopies +getNumCopies = fromSources + [ getForcedNumCopies + , getGlobalNumCopies + , deprecatedNumCopies + ] + +{- Numcopies value for a file, from any configuration source, including the + - deprecated git config. -} +getFileNumCopies :: FilePath -> Annex NumCopies +getFileNumCopies f = fromSources + [ getForcedNumCopies + , getFileNumCopies' f + , deprecatedNumCopies + ] + +{- This is the globally visible numcopies value for a file. So it does + - not include local configuration in the git config or command line + - options. -} +getGlobalFileNumCopies :: FilePath -> Annex NumCopies +getGlobalFileNumCopies f = fromSources + [ getFileNumCopies' f + ] + +getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies) +getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr + where + getattr = (NumCopies <$$> readish) + <$> checkAttr "annex.numcopies" file + +{- Checks if numcopies are satisfied for a file by running a comparison + - between the number of (not untrusted) copies that are + - belived to exist, and the configured value. -} +numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v +numCopiesCheck file key vs = do + have <- trustExclude UnTrusted =<< Remote.keyLocations key + numCopiesCheck' file vs have + +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 = helper [] [] + 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 (nub (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 f6a9cce4c..a1362ca84 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 @@ -91,14 +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 - u <- getUUID - trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u) - ( pure (nub (u:trusteduuids)) - , 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) @@ -128,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/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] diff --git a/Config/NumCopies.hs b/Config/NumCopies.hs deleted file mode 100644 index 50dcdf684..000000000 --- a/Config/NumCopies.hs +++ /dev/null @@ -1,85 +0,0 @@ -{- git-annex numcopies configuration - - - - Copyright 2014 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Config.NumCopies ( - module Types.NumCopies, - module Logs.NumCopies, - getFileNumCopies, - getGlobalFileNumCopies, - getNumCopies, - deprecatedNumCopies, - defaultNumCopies, - numCopiesCheck, - numCopiesCheck', -) where - -import Common.Annex -import qualified Annex -import Types.NumCopies -import Logs.NumCopies -import Logs.Trust -import Annex.CheckAttr -import qualified Remote - -defaultNumCopies :: NumCopies -defaultNumCopies = NumCopies 1 - -fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies -fromSources = fromMaybe defaultNumCopies <$$> getM id - -{- The git config annex.numcopies is deprecated. -} -deprecatedNumCopies :: Annex (Maybe NumCopies) -deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig - -{- Value forced on the command line by --numcopies. -} -getForcedNumCopies :: Annex (Maybe NumCopies) -getForcedNumCopies = Annex.getState Annex.forcenumcopies - -{- Numcopies value from any of the non-.gitattributes configuration - - sources. -} -getNumCopies :: Annex NumCopies -getNumCopies = fromSources - [ getForcedNumCopies - , getGlobalNumCopies - , deprecatedNumCopies - ] - -{- Numcopies value for a file, from any configuration source, including the - - deprecated git config. -} -getFileNumCopies :: FilePath -> Annex NumCopies -getFileNumCopies f = fromSources - [ getForcedNumCopies - , getFileNumCopies' f - , deprecatedNumCopies - ] - -{- This is the globally visible numcopies value for a file. So it does - - not include local configuration in the git config or command line - - options. -} -getGlobalFileNumCopies :: FilePath -> Annex NumCopies -getGlobalFileNumCopies f = fromSources - [ getFileNumCopies' f - ] - -getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies) -getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr - where - getattr = (NumCopies <$$> readish) - <$> checkAttr "annex.numcopies" file - -{- Checks if numcopies are satisfied for a file by running a comparison - - between the number of (not untrusted) copies that are - - belived to exist, and the configured value. -} -numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v -numCopiesCheck file key vs = do - have <- trustExclude UnTrusted =<< Remote.keyLocations key - numCopiesCheck' file vs have - -numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v -numCopiesCheck' file vs have = do - NumCopies needed <- getFileNumCopies file - return $ length have `vs` needed diff --git a/Limit.hs b/Limit.hs index 030ee6a5f..c412637bb 100644 --- a/Limit.hs +++ b/Limit.hs @@ -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 -- cgit v1.2.3 From 137cac6e685732504da466a05590b69ce0eb93a7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 6 May 2015 14:45:20 -0400 Subject: fsck: Ignore error recording the fsck in the activity log, which can happen when running fsck in a read-only repository. Closes: #698559 (fsck can still need to write to the repository if it find problems, but a successful fsck can be done read-only) --- Command/Fsck.hs | 2 +- debian/changelog | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'Command/Fsck.hs') diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 46d7c2e77..be59484d9 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -76,7 +76,7 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start from i) ps withFsckDb i FsckDb.closeDb - recordActivity Fsck u + void $ tryIO $ recordActivity Fsck u start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart start from inc file key = do diff --git a/debian/changelog b/debian/changelog index f9a0aee93..ef1357324 100644 --- a/debian/changelog +++ b/debian/changelog @@ -31,6 +31,11 @@ git-annex (5.20150421) UNRELEASED; urgency=medium symlinks when downloading from ftp. * Support checking ftp urls for file presence. * contentlocation, examinekey, lookupkey: Added --batch mode option. + * fsck: Ignore error recording the fsck in the activity log, + which can happen when running fsck in a read-only repository. + Closes: #698559 + (fsck can still need to write to the repository if it find problems, + but a successful fsck can be done read-only) -- Joey Hess Tue, 21 Apr 2015 15:54:10 -0400 -- cgit v1.2.3 From ea506b28110d0e23210fb788b16ffe3deb92f23b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 May 2015 14:45:55 -0400 Subject: support time-1.5.0 This no longer uses old-locale's defaultTimeLocale, but provides one of its own. Factored out a Logs.TimeStamp. --- Assistant/DaemonStatus.hs | 10 +++------- Command/Fsck.hs | 8 ++------ Command/Log.hs | 6 +++++- Logs/MapLog.hs | 7 ++++--- Logs/Presence/Pure.hs | 5 ++--- Logs/SingleValue.hs | 5 ++--- Logs/Transfer.hs | 7 +------ Logs/Transitions.hs | 8 ++++---- Logs/UUIDBased.hs | 7 +++---- Logs/Unused.hs | 4 ++-- 10 files changed, 28 insertions(+), 39 deletions(-) (limited to 'Command/Fsck.hs') diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 1ed40595e..4c42ffdbe 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -16,6 +16,7 @@ import Assistant.Types.NetMessager import Utility.NotificationBroadcaster import Logs.Transfer import Logs.Trust +import Logs.TimeStamp import qualified Remote import qualified Types.Remote as Remote import qualified Git @@ -23,8 +24,6 @@ import qualified Git import Control.Concurrent.STM import System.Posix.Types import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T @@ -125,21 +124,18 @@ readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file where parse status = foldr parseline status . lines parseline line status - | key == "lastRunning" = parseval readtime $ \v -> + | key == "lastRunning" = parseval parsePOSIXTime $ \v -> status { lastRunning = Just v } | key == "scanComplete" = parseval readish $ \v -> status { scanComplete = v } | key == "sanityCheckRunning" = parseval readish $ \v -> status { sanityCheckRunning = v } - | key == "lastSanityCheck" = parseval readtime $ \v -> + | key == "lastSanityCheck" = parseval parsePOSIXTime $ \v -> status { lastSanityCheck = Just v } | otherwise = status -- unparsable line where (key, value) = separate (== ':') line parseval parser a = maybe status a (parser value) - readtime s = do - d <- parseTime defaultTimeLocale "%s%Qs" s - Just $ utcTimeToPOSIXSeconds d {- Checks if a time stamp was made after the daemon was lastRunning. - diff --git a/Command/Fsck.hs b/Command/Fsck.hs index be59484d9..479f4521c 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -24,6 +24,7 @@ import Annex.Link import Logs.Location import Logs.Trust import Logs.Activity +import Logs.TimeStamp import Annex.NumCopies import Annex.UUID import Utility.DataUnits @@ -37,9 +38,7 @@ import Utility.PID import qualified Database.Fsck as FsckDb import Data.Time.Clock.POSIX -import Data.Time import System.Posix.Types (EpochTime) -import System.Locale cmd :: [Command] cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek @@ -476,14 +475,11 @@ getStartTime u = do liftIO $ catchDefaultIO Nothing $ do timestamp <- modificationTime <$> getFileStatus f let fromstatus = Just (realToFrac timestamp) - fromfile <- readishTime <$> readFile f + fromfile <- parsePOSIXTime <$> readFile f return $ if matchingtimestamp fromfile fromstatus then Just timestamp else Nothing where - readishTime :: String -> Maybe POSIXTime - readishTime s = utcTimeToPOSIXSeconds <$> - parseTime defaultTimeLocale "%s%Qs" s matchingtimestamp fromfile fromstatus = #ifndef mingw32_HOST_OS fromfile == fromstatus diff --git a/Command/Log.hs b/Command/Log.hs index 4bc7bb89a..e1438ba15 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -5,15 +5,19 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Command.Log where import qualified Data.Set as S import qualified Data.Map as M import qualified Data.ByteString.Lazy.Char8 as L +import Data.Char import Data.Time.Clock.POSIX import Data.Time +#if ! MIN_VERSION_time(1,5,0) import System.Locale -import Data.Char +#endif import Common.Annex import Command diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs index 3c7eef26b..d5bb67f68 100644 --- a/Logs/MapLog.hs +++ b/Logs/MapLog.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {- git-annex Map log - - This is used to store a Map, in a way that can be union merged. @@ -13,10 +15,9 @@ module Logs.MapLog where import qualified Data.Map as M import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import Common +import Logs.TimeStamp data TimeStamp = Unknown | Date POSIXTime deriving (Eq, Ord, Show) @@ -42,7 +43,7 @@ parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . lin parse line = do let (ts, rest) = splitword line (sf, sv) = splitword rest - date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts + date <- Date <$> parsePOSIXTime ts f <- fieldparser sf v <- valueparser sv Just (f, LogEntry date v) diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs index 88f18435f..ec4415aad 100644 --- a/Logs/Presence/Pure.hs +++ b/Logs/Presence/Pure.hs @@ -8,11 +8,10 @@ module Logs.Presence.Pure where import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import qualified Data.Map as M import Common.Annex +import Logs.TimeStamp import Utility.QuickCheck data LogLine = LogLine { @@ -29,7 +28,7 @@ parseLog :: String -> [LogLine] parseLog = mapMaybe parseline . lines where parseline l = LogLine - <$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d) + <$> parsePOSIXTime d <*> parseStatus s <*> pure rest where diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs index dbbe996f3..213bcd217 100644 --- a/Logs/SingleValue.hs +++ b/Logs/SingleValue.hs @@ -15,11 +15,10 @@ module Logs.SingleValue where import Common.Annex import qualified Annex.Branch +import Logs.TimeStamp import qualified Data.Set as S import Data.Time.Clock.POSIX -import Data.Time -import System.Locale class SingleValueSerializable v where serialize :: v -> String @@ -42,7 +41,7 @@ parseLog = S.fromList . mapMaybe parse . lines where parse line = do let (ts, s) = splitword line - date <- utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts + date <- parsePOSIXTime ts v <- deserialize s Just (LogEntry date v) splitword = separate (== ' ') diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 5b5b8f8cb..078157208 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -18,11 +18,10 @@ import Utility.Percentage import Utility.QuickCheck import Utility.PID import Utility.LockFile +import Logs.TimeStamp import Data.Time.Clock import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import Control.Concurrent {- Enough information to uniquely identify a transfer, used as the filename @@ -276,10 +275,6 @@ readTransferInfo mpid s = TransferInfo then Just <$> readish =<< headMaybe (drop 1 bits) else pure Nothing -- not failure -parsePOSIXTime :: String -> Maybe POSIXTime -parsePOSIXTime s = utcTimeToPOSIXSeconds - <$> parseTime defaultTimeLocale "%s%Qs" s - {- The directory holding transfer information files for a given Direction. -} transferDir :: Direction -> Git.Repo -> FilePath transferDir direction r = gitAnnexTransferDir r showLcDirection direction diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index d782455a6..5ccfd7e8c 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -15,11 +15,10 @@ module Logs.Transitions where import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import qualified Data.Set as S import Common.Annex +import Logs.TimeStamp transitionsLog :: FilePath transitionsLog = "transitions.log" @@ -66,12 +65,13 @@ showTransitionLine :: TransitionLine -> String showTransitionLine (TransitionLine ts t) = unwords [show t, show ts] parseTransitionLine :: String -> Maybe TransitionLine -parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts +parseTransitionLine s = TransitionLine + <$> parsePOSIXTime ds + <*> readish ts where ws = words s ts = Prelude.head ws ds = unwords $ Prelude.tail ws - pdate = utcTimeToPOSIXSeconds <$$> parseTime defaultTimeLocale "%s%Qs" combineTransitions :: [Transitions] -> Transitions combineTransitions = S.unions diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index ac876e65f..5613c6fb4 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -30,12 +30,11 @@ module Logs.UUIDBased ( import qualified Data.Map as M import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import Common import Types.UUID import Logs.MapLog +import Logs.TimeStamp type Log v = MapLog UUID v @@ -73,9 +72,9 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines info | ts == Unknown = drop 1 ws | otherwise = drop 1 $ beginning ws - pdate s = case parseTime defaultTimeLocale "%s%Qs" s of + pdate s = case parsePOSIXTime s of Nothing -> Unknown - Just d -> Date $ utcTimeToPOSIXSeconds d + Just d -> Date d showLogNew :: (v -> String) -> Log v -> String showLogNew = showMapLog fromUUID diff --git a/Logs/Unused.hs b/Logs/Unused.hs index 883ab8c5b..7a12f186c 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -32,12 +32,12 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Time.Clock.POSIX import Data.Time -import System.Locale import Common.Annex import qualified Annex import Types.Key import Utility.Tmp +import Logs.TimeStamp -- everything that is stored in the unused log type UnusedLog = M.Map Key (Int, Maybe POSIXTime) @@ -81,7 +81,7 @@ readUnusedLog prefix = do , return M.empty ) where - parse line = case (readish sint, file2key skey, utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts) of + parse line = case (readish sint, file2key skey, parsePOSIXTime ts) of (Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp)) _ -> Nothing where -- cgit v1.2.3