diff options
| -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. - |