add remote state logs

This allows a remote to store a piece of arbitrary state associated with a
key. This is needed to support Tahoe, where the file-cap is calculated from
the data stored in it, and used to retrieve a key later. Glacier also would
be much improved by using this.

GETSTATE and SETSTATE are added to the external special remote protocol.

Note that the state is left as-is even when a key is removed from a remote.
It's up to the remote to decide when it wants to clear the state.

The remote state log, $KEY.log.rmt, is a UUID-based log. However,
rather than using the old UUID-based log format, I created a new variant
of that format. The new varient is more space efficient (since it lacks the
"timestamp=" hack, and easier to parse (and the parser doesn't mess with
whitespace in the value), and avoids compatability cruft in the old one.

This seemed worth cleaning up for these new files, since there could be a
lot of them, while before UUID-based logs were only used for a few log
files at the top of the git-annex branch. The transition code has also
been updated to handle these new UUID-based logs.

This commit was sponsored by Daniel Hofer.
This commit is contained in:
Joey Hess 2014-01-03 16:35:57 -04:00
parent 3560fb411d
commit 3e68c1c2fd
9 changed files with 119 additions and 11 deletions

25
Logs.hs
View file

@ -10,19 +10,21 @@ module Logs where
import Common.Annex
import Types.Key
data LogVariety = UUIDBasedLog | PresenceLog Key
{- There are several varieties of log file formats. -}
data LogVariety = UUIDBasedLog | NewUUIDBasedLog | 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
| f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog
| isRemoteStateLog f = Just NewUUIDBasedLog
| otherwise = PresenceLog <$> firstJust (presenceLogs f)
{- All the uuid-based logs stored in the git-annex branch. -}
uuidBasedLogs :: [FilePath]
uuidBasedLogs =
{- All the uuid-based logs stored in the top of the git-annex branch. -}
topLevelUUIDBasedLogs :: [FilePath]
topLevelUUIDBasedLogs =
[ uuidLog
, remoteLog
, trustLog
@ -99,16 +101,29 @@ urlLogFileKey path
isUrlLog :: FilePath -> Bool
isUrlLog file = urlLogExt `isSuffixOf` file
{- The filename of the remote state log for a given key. -}
remoteStateLogFile :: Key -> FilePath
remoteStateLogFile key = hashDirLower key </> keyFile key ++ remoteStateLogExt
remoteStateLogExt :: String
remoteStateLogExt = ".log.rmt"
isRemoteStateLog :: FilePath -> Bool
isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path
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)
, expect isNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)
]
where
expect = maybe False
isUUIDBasedLog UUIDBasedLog = True
isUUIDBasedLog _ = False
isNewUUIDBasedLog NewUUIDBasedLog = True
isNewUUIDBasedLog _ = False
isPresenceLog (PresenceLog k) = k == dummykey
isPresenceLog _ = False