diff options
author | Joey Hess <joey@kitenet.net> | 2013-08-29 18:51:22 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-08-29 19:13:00 -0400 |
commit | 7a53fb249f0c02762d8c13f413e24c5c250167dd (patch) | |
tree | b612c5a8b9c630561ae1ff02dd8cd6c076881f19 | |
parent | d3c895b8b328685541cf41e025cff17f94b258b1 (diff) |
refactor git-annex branch log filename code into central location
Having one module that knows about all the filenames used on the branch
allows working back from an arbitrary filename to enough information about
it to implement dropping dead remotes and doing other log file compacting
as part of a forget transition.
-rw-r--r-- | Command/Log.hs | 4 | ||||
-rw-r--r-- | Logs.hs | 110 | ||||
-rw-r--r-- | Logs/Group.hs | 5 | ||||
-rw-r--r-- | Logs/Location.hs | 21 | ||||
-rw-r--r-- | Logs/PreferredContent.hs | 5 | ||||
-rw-r--r-- | Logs/Remote.hs | 5 | ||||
-rw-r--r-- | Logs/Trust.hs | 5 | ||||
-rw-r--r-- | Logs/UUID.hs | 5 | ||||
-rw-r--r-- | Logs/Web.hs | 36 | ||||
-rw-r--r-- | Test.hs | 2 | ||||
-rw-r--r-- | Upgrade/V2.hs | 6 | ||||
-rw-r--r-- | Utility/Misc.hs | 6 |
12 files changed, 136 insertions, 74 deletions
diff --git a/Command/Log.hs b/Command/Log.hs index 2d4819f7f..f3a5becb8 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -17,7 +17,7 @@ import Data.Char import Common.Annex import Command -import qualified Logs.Location +import Logs import qualified Logs.Presence import Annex.CatFile import qualified Annex.Branch @@ -135,7 +135,7 @@ getLog :: Key -> [CommandParam] -> Annex [String] getLog key os = do top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top - let logfile = p </> Logs.Location.logFile key + let logfile = p </> locationLogFile key inRepo $ pipeNullSplitZombie $ [ Params "log -z --pretty=format:%ct --raw --abbrev=40" , Param "--remove-empty" diff --git a/Logs.hs b/Logs.hs new file mode 100644 index 000000000..6339efa13 --- /dev/null +++ b/Logs.hs @@ -0,0 +1,110 @@ +{- git-annex log file names + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs where + +import Common.Annex +import Types.Key + +data LogVariety = UUIDBasedLog | PresenceLog Key + deriving (Show) + +{- Converts a path from the git-annex branch into one of the varieties + - of logs used by git-annex, if it's a known path. -} +getLogVariety :: FilePath -> Maybe LogVariety +getLogVariety f + | f `elem` uuidBasedLogs = Just UUIDBasedLog + | otherwise = PresenceLog <$> firstJust (presenceLogs f) + +{- All the uuid-based logs stored in the git-annex branch. -} +uuidBasedLogs :: [FilePath] +uuidBasedLogs = + [ uuidLog + , remoteLog + , trustLog + , groupLog + , preferredContentLog + ] + +{- All the ways to get a key from a presence log file -} +presenceLogs :: FilePath -> [Maybe Key] +presenceLogs f = + [ urlLogFileKey f + , locationLogFileKey f + ] + +uuidLog :: FilePath +uuidLog = "uuid.log" + +remoteLog :: FilePath +remoteLog = "remote.log" + +trustLog :: FilePath +trustLog = "trust.log" + +groupLog :: FilePath +groupLog = "group.log" + +preferredContentLog :: FilePath +preferredContentLog = "preferred-content.log" + +{- The pathname of the location log file for a given key. -} +locationLogFile :: Key -> String +locationLogFile key = hashDirLower key ++ keyFile key ++ ".log" + +{- Converts a pathname into a key if it's a location log. -} +locationLogFileKey :: FilePath -> Maybe Key +locationLogFileKey path + | ["remote", "web"] `isPrefixOf` splitDirectories dir = Nothing + | ext == ".log" = fileKey base + | otherwise = Nothing + where + (dir, file) = splitFileName path + (base, ext) = splitAt (length file - 4) file + +{- The filename of the url log for a given key. -} +urlLogFile :: Key -> FilePath +urlLogFile key = hashDirLower key </> keyFile key ++ urlLogExt + +{- Old versions stored the urls elsewhere. -} +oldurlLogs :: Key -> [FilePath] +oldurlLogs key = + [ "remote/web" </> hashDirLower key </> key2file key ++ ".log" + , "remote/web" </> hashDirLower key </> keyFile key ++ ".log" + ] + +urlLogExt :: String +urlLogExt = ".log.web" + +{- Converts a url log file into a key. + - (Does not work on oldurlLogs.) -} +urlLogFileKey :: FilePath -> Maybe Key +urlLogFileKey path + | ext == urlLogExt = fileKey base + | otherwise = Nothing + where + file = takeFileName path + (base, ext) = splitAt (length file - extlen) file + extlen = length urlLogExt + +{- Does not work on oldurllogs. -} +isUrlLog :: FilePath -> Bool +isUrlLog file = urlLogExt `isSuffixOf` file + +prop_logs_sane :: Key -> Bool +prop_logs_sane dummykey = all id + [ isNothing (getLogVariety "unknown") + , expect isUUIDBasedLog (getLogVariety uuidLog) + , expect isPresenceLog (getLogVariety $ locationLogFile dummykey) + , expect isPresenceLog (getLogVariety $ urlLogFile dummykey) + ] + where + expect = maybe False + isUUIDBasedLog UUIDBasedLog = True + isUUIDBasedLog _ = False + isPresenceLog (PresenceLog k) = k == dummykey + isPresenceLog _ = False diff --git a/Logs/Group.hs b/Logs/Group.hs index ee3b75b86..3f88b627d 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -21,16 +21,13 @@ import qualified Data.Set as S import Data.Time.Clock.POSIX import Common.Annex +import Logs import qualified Annex.Branch import qualified Annex import Logs.UUIDBased import Types.Group import Types.StandardGroups -{- Filename of group.log. -} -groupLog :: FilePath -groupLog = "group.log" - {- Returns the groups of a given repo UUID. -} lookupGroups :: UUID -> Annex (S.Set Group) lookupGroups u = (fromMaybe S.empty . M.lookup u) . groupsByUUID <$> groupMap diff --git a/Logs/Location.hs b/Logs/Location.hs index 0f57b6663..1289af321 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -20,12 +20,11 @@ module Logs.Location ( loggedLocations, loggedKeys, loggedKeysFor, - logFile, - logFileKey ) where import Common.Annex import qualified Annex.Branch +import Logs import Logs.Presence import Annex.UUID @@ -37,19 +36,19 @@ logStatus key status = do {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () -logChange key (UUID u) s = addLog (logFile key) =<< logNow s u +logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u logChange _ NoUUID _ = noop {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} loggedLocations :: Key -> Annex [UUID] -loggedLocations key = map toUUID <$> (currentLog . logFile) key +loggedLocations key = map toUUID <$> (currentLog . locationLogFile) key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} loggedKeys :: Annex [Key] -loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files +loggedKeys = mapMaybe locationLogFileKey <$> Annex.Branch.files {- Finds all keys that have location log information indicating - they are present for the specified repository. -} @@ -62,15 +61,3 @@ loggedKeysFor u = filterM isthere =<< loggedKeys us <- loggedLocations k let !there = u `elem` us return there - -{- The filename of the log file for a given key. -} -logFile :: Key -> String -logFile key = hashDirLower key ++ keyFile key ++ ".log" - -{- Converts a log filename into a key. -} -logFileKey :: FilePath -> Maybe Key -logFileKey file - | ext == ".log" = fileKey base - | otherwise = Nothing - where - (base, ext) = splitAt (length file - 4) file diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 8005fc0d3..947a31875 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -24,6 +24,7 @@ import Data.Time.Clock.POSIX import Common.Annex import qualified Annex.Branch import qualified Annex +import Logs import Logs.UUIDBased import Limit import qualified Utility.Matcher @@ -35,10 +36,6 @@ import Logs.Group import Logs.Remote import Types.StandardGroups -{- Filename of preferred-content.log. -} -preferredContentLog :: FilePath -preferredContentLog = "preferred-content.log" - {- Changes the preferred content configuration of a remote. -} preferredContentSet :: UUID -> String -> Annex () preferredContentSet uuid@(UUID _) val = do diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 89792b054..48ee9eb60 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -25,12 +25,9 @@ import Data.Char import Common.Annex import qualified Annex.Branch import Types.Remote +import Logs import Logs.UUIDBased -{- Filename of remote.log. -} -remoteLog :: FilePath -remoteLog = "remote.log" - {- Adds or updates a remote's config in the log. -} configSet :: UUID -> RemoteConfig -> Annex () configSet u c = do diff --git a/Logs/Trust.hs b/Logs/Trust.hs index eb6e42ad7..6c6b33f70 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -27,14 +27,11 @@ import Common.Annex import Types.TrustLevel import qualified Annex.Branch import qualified Annex +import Logs import Logs.UUIDBased import Remote.List import qualified Types.Remote -{- Filename of trust.log. -} -trustLog :: FilePath -trustLog = "trust.log" - {- Returns a list of UUIDs that the trustLog indicates have the - specified trust level. - Note that the list can be incomplete for SemiTrusted, since that's diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 2f24a388e..ef1074e78 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -28,13 +28,10 @@ import Types.UUID import Common.Annex import qualified Annex import qualified Annex.Branch +import Logs import Logs.UUIDBased import qualified Annex.UUID -{- Filename of uuid.log. -} -uuidLog :: FilePath -uuidLog = "uuid.log" - {- Records a description for a uuid in the log. -} describeUUID :: UUID -> String -> Annex () describeUUID uuid desc = do diff --git a/Logs/Web.hs b/Logs/Web.hs index 47ab61943..0239f2335 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -11,8 +11,6 @@ module Logs.Web ( getUrls, setUrlPresent, setUrlMissing, - urlLog, - urlLogKey, knownUrls, Downloader(..), getDownloader, @@ -22,9 +20,9 @@ module Logs.Web ( import qualified Data.ByteString.Lazy.Char8 as L import Common.Annex +import Logs import Logs.Presence import Logs.Location -import Types.Key import qualified Annex.Branch import Annex.CatFile import qualified Git @@ -36,35 +34,9 @@ type URLString = String webUUID :: UUID webUUID = UUID "00000000-0000-0000-0000-000000000001" -urlLogExt :: String -urlLogExt = ".log.web" - -urlLog :: Key -> FilePath -urlLog key = hashDirLower key </> keyFile key ++ urlLogExt - -{- Converts a url log file into a key. - - (Does not work on oldurlLogs.) -} -urlLogKey :: FilePath -> Maybe Key -urlLogKey file - | ext == urlLogExt = fileKey base - | otherwise = Nothing - where - (base, ext) = splitAt (length file - extlen) file - extlen = length urlLogExt - -isUrlLog :: FilePath -> Bool -isUrlLog file = urlLogExt `isSuffixOf` file - -{- Used to store the urls elsewhere. -} -oldurlLogs :: Key -> [FilePath] -oldurlLogs key = - [ "remote/web" </> hashDirLower key </> key2file key ++ ".log" - , "remote/web" </> hashDirLower key </> keyFile key ++ ".log" - ] - {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] -getUrls key = go $ urlLog key : oldurlLogs key +getUrls key = go $ urlLogFile key : oldurlLogs key where go [] = return [] go (l:ls) = do @@ -77,13 +49,13 @@ setUrlPresent :: Key -> URLString -> Annex () setUrlPresent key url = do us <- getUrls key unless (url `elem` us) $ do - addLog (urlLog key) =<< logNow InfoPresent url + addLog (urlLogFile key) =<< logNow InfoPresent url -- update location log to indicate that the web has the key logChange key webUUID InfoPresent setUrlMissing :: Key -> URLString -> Annex () setUrlMissing key url = do - addLog (urlLog key) =<< logNow InfoMissing url + addLog (urlLogFile key) =<< logNow InfoMissing url whenM (null <$> getUrls key) $ logChange key webUUID InfoMissing @@ -33,6 +33,7 @@ import qualified Types.KeySource import qualified Types.Backend import qualified Types.TrustLevel import qualified Types +import qualified Logs import qualified Logs.UUIDBased import qualified Logs.Trust import qualified Logs.Remote @@ -115,6 +116,7 @@ quickcheck = , check "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode , check "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape , check "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword + , check "prop_logs_sane" Logs.prop_logs_sane , check "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape , check "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config , check "prop_parentDir_basics" Utility.Path.prop_parentDir_basics diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index b5de6c8c0..42419b8ab 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -12,9 +12,9 @@ import qualified Git import qualified Git.Command import qualified Git.Ref import qualified Annex.Branch -import Logs.Location import Annex.Content import Utility.Tmp +import Logs olddir :: Git.Repo -> FilePath olddir g @@ -47,7 +47,7 @@ upgrade = do e <- liftIO $ doesDirectoryExist old when e $ do - mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs + mapM_ (\(k, f) -> inject f $ locationLogFile k) =<< locationLogs mapM_ (\f -> inject f f) =<< logFiles old saveState False @@ -73,7 +73,7 @@ locationLogs = do where tryDirContents d = catchDefaultIO [] $ dirContents d islogfile f = maybe Nothing (\k -> Just (k, f)) $ - logFileKey $ takeFileName f + locationLogFileKey f inject :: FilePath -> FilePath -> Annex () inject source dest = do diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 804a9e487..48ce4c929 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -91,6 +91,12 @@ massReplace vs = go [] vs go (replacement:acc) vs (drop (length val) s) | otherwise = go acc rest s +{- First item in the list that is not Nothing. -} +firstJust :: Eq a => [Maybe a] -> Maybe a +firstJust ms = case dropWhile (== Nothing) ms of + [] -> Nothing + (md:_) -> md + {- Given two orderings, returns the second if the first is EQ and returns - the first otherwise. - |