diff options
| -rw-r--r-- | Annex.hs | 51 | ||||
| -rw-r--r-- | Backend.hs | 20 | ||||
| -rw-r--r-- | GitRepo.hs | 10 | ||||
| -rw-r--r-- | LocationLog.hs | 64 | ||||
| -rw-r--r-- | Locations.hs | 25 | ||||
| -rw-r--r-- | Types.hs | 1 |
6 files changed, 93 insertions, 78 deletions
@@ -24,15 +24,6 @@ import UUID import LocationLog import Types -{- An annexed file's content is stored somewhere under .git/annex/, - - based on the key. Since the symlink is user-visible, the filename - - used should be as close to the key as possible, in case the key is a - - filename or url. Just escape "/" in the key name, to keep a flat - - tree of files and avoid issues with files ending with "/" etc. -} -annexLocation :: State -> Key -> FilePath -annexLocation state key = gitDir (repo state) ++ "/annex/" ++ (transform key) - where transform s = replace "/" "%" $ replace "%" "%%" s - {- Checks if a given key is currently present in the annexLocation -} inAnnex :: State -> Key -> IO Bool inAnnex state key = doesFileExist $ annexLocation state key @@ -62,15 +53,18 @@ annexFile state file = do stored <- storeFile state file case (stored) of Nothing -> error $ "no backend could store: " ++ file - Just key -> symlink key + Just (key, backend) -> setup key backend where - symlink key = do + setup key backend = do let dest = annexLocation state key createDirectoryIfMissing True (parentDir dest) renameFile file dest - logChange (repo state) file (getUUID (repo state)) FilePresent createSymbolicLink dest file - gitAdd (repo state) file + gitRun (repo state) ["add", file, bfile] + gitRun (repo state) ["commit", "-m", + ("git-annex annexed " ++ file), file, bfile] + logStatus state key ValuePresent + where bfile = backendFile state backend file checkLegal file = do s <- getSymbolicLinkStatus file if ((isSymbolicLink s) || (not $ isRegularFile s)) @@ -87,11 +81,17 @@ unannexFile state file = do mkey <- dropFile state file case (mkey) of Nothing -> return () - Just key -> do + Just (key, backend) -> do let src = annexLocation state key removeFile file + gitRun (repo state) ["rm", file, bfile] + gitRun (repo state) ["commit", "-m", + ("git-annex unannexed " ++ file), + file, bfile] renameFile src file + logStatus state key ValueMissing return () + where bfile = backendFile state backend file {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () @@ -109,7 +109,9 @@ annexGetFile state file = do createDirectoryIfMissing True (parentDir dest) success <- retrieveFile state file dest if (success) - then return () + then do + logStatus state key ValuePresent + return () else error $ "failed to get " ++ file {- Indicates a file is wanted. -} @@ -132,17 +134,28 @@ annexPullRepo state reponame = do error "not implemented" -- TODO gitPrep :: GitRepo -> IO () gitPrep repo = do -- configure git to use union merge driver on state files - let attrLine = stateLoc ++ "/*.log merge=union" - let attributes = gitAttributes repo exists <- doesFileExist attributes if (not exists) then do writeFile attributes $ attrLine ++ "\n" - gitAdd repo attributes + commit else do content <- readFile attributes if (all (/= attrLine) (lines content)) then do appendFile attributes $ attrLine ++ "\n" - gitAdd repo attributes + commit else return () + where + attrLine = stateLoc ++ "/*.log merge=union" + attributes = gitAttributes repo + commit = do + gitRun repo ["add", attributes] + gitRun repo ["commit", "-m", "git-annex setup", + attributes] + +{- Updates the LocationLog when a key's presence changes. -} +logStatus state key status = do + f <- logChange (repo state) key (getUUID (repo state)) status + gitRun (repo state) ["add", f] + gitRun (repo state) ["commit", "-m", "git-annex log update", f] diff --git a/Backend.hs b/Backend.hs index a16dfab6a..d7bde241a 100644 --- a/Backend.hs +++ b/Backend.hs @@ -31,9 +31,8 @@ import GitRepo import Utility import Types -{- Attempts to store a file in one of the backends, and returns - - its key. -} -storeFile :: State -> FilePath -> IO (Maybe Key) +{- Attempts to store a file in one of the backends. -} +storeFile :: State -> FilePath -> IO (Maybe (Key, Backend)) storeFile state file = storeFile' (backends state) state file storeFile' [] _ _ = return Nothing storeFile' (b:bs) state file = do @@ -46,7 +45,7 @@ storeFile' (b:bs) state file = do then nextbackend else do recordKey state b file key - return $ Just key + return $ Just (key, b) where nextbackend = storeFile' bs state file @@ -62,7 +61,7 @@ retrieveFile state file dest = do (retrieveKeyFile b) state key dest {- Drops the key for a file from the backend that has it. -} -dropFile :: State -> FilePath -> IO (Maybe Key) +dropFile :: State -> FilePath -> IO (Maybe (Key, Backend)) dropFile state file = do result <- lookupBackend state file case (result) of @@ -71,7 +70,7 @@ dropFile state file = do key <- lookupKey state b file (removeKey b) state key removeFile $ backendFile state b file - return $ Just key + return $ Just (key, b) {- Looks up the backend used for an already annexed file. -} lookupBackend :: State -> FilePath -> IO (Maybe Backend) @@ -85,13 +84,6 @@ lookupBackend' (b:bs) state file = do else lookupBackend' bs state file -{- Name of state file that holds the key for an annexed file, - - using a given backend. -} -backendFile :: State -> Backend -> FilePath -> String -backendFile state backend file = - gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ - "." ++ (name backend) - {- Checks if a file is available via a given backend. -} checkBackend :: Backend -> State -> FilePath -> IO (Bool) checkBackend backend state file = doesFileExist $ backendFile state backend file @@ -106,7 +98,7 @@ lookupKey state backend file = do then (reverse . (drop 1) . reverse) s else s -{- Records the key a backend uses for an annexed file. -} +{- Records the key used for an annexed file. -} recordKey :: State -> Backend -> FilePath -> Key -> IO () recordKey state backend file key = do createDirectoryIfMissing True (parentDir record) diff --git a/GitRepo.hs b/GitRepo.hs index 068b2569c..fcaae1253 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -15,8 +15,6 @@ module GitRepo ( gitRelative, gitConfig, gitConfigRead, - gitAdd, - gitRm, gitRun, gitAttributes ) where @@ -128,14 +126,6 @@ gitRelative repo file = drop (length absrepo) absfile Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo -{- Stages a changed/new file in git's index. -} -gitAdd :: GitRepo -> FilePath -> IO () -gitAdd repo file = gitRun repo ["add", file] - -{- Removes a file. -} -gitRm :: GitRepo -> FilePath -> IO () -gitRm repo file = gitRun repo ["rm", file] - {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: GitRepo -> [String] -> [String] gitCommandLine repo params = assertlocal repo $ diff --git a/LocationLog.hs b/LocationLog.hs index da702d650..2eab4815e 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -1,13 +1,13 @@ {- git-annex location log - - - git-annex keeps track of on which repository it last saw a file's content. + - git-annex keeps track of on which repository it last saw a value. - This can be useful when using it for archiving with offline storage. - When you indicate you --want a file, git-annex will tell you which - - repositories have the file's content. + - repositories have the value. - - - Location tracking information is stored in `.git-annex/filename.log`. + - Location tracking information is stored in `.git-annex/key.log`. - Repositories record their UUID and the date when they --get or --drop - - a file's content. + - a value. - - A line of the log will look like: "date N UUID" - Where N=1 when the repo has the file, and 0 otherwise. @@ -31,6 +31,7 @@ import Data.Char import GitRepo import Utility import UUID +import Types import Locations data LogLine = LogLine { @@ -39,17 +40,17 @@ data LogLine = LogLine { uuid :: UUID } deriving (Eq) -data LogStatus = FilePresent | FileMissing | Undefined +data LogStatus = ValuePresent | ValueMissing | Undefined deriving (Eq) instance Show LogStatus where - show FilePresent = "1" - show FileMissing = "0" + show ValuePresent = "1" + show ValueMissing = "0" show Undefined = "undefined" instance Read LogStatus where - readsPrec _ "1" = [(FilePresent, "")] - readsPrec _ "0" = [(FileMissing, "")] + readsPrec _ "1" = [(ValuePresent, "")] + readsPrec _ "0" = [(ValueMissing, "")] readsPrec _ _ = [(Undefined, "")] instance Show LogLine where @@ -61,7 +62,7 @@ instance Read LogLine where -- read without an exception being thrown. -- Such lines have a status of Undefined. readsPrec _ string = - if (length w >= 3) + if (length w == 3) then case (pdate) of Just v -> good v Nothing -> undefined @@ -70,28 +71,23 @@ instance Read LogLine where w = words string date = w !! 0 status = read $ w !! 1 - uuid = w !! 3 + uuid = w !! 2 pdate = (parseTime defaultTimeLocale "%s%Qs" date) :: Maybe UTCTime good v = ret $ LogLine (utcTimeToPOSIXSeconds v) status uuid undefined = ret $ LogLine (0) Undefined "" ret v = [(v, "")] -{- Log a change in the presence of a file in a repository, - - and add the log to git so it will propigate to other repos. -} -logChange :: GitRepo -> FilePath -> UUID -> LogStatus -> IO () -logChange repo file uuid status = do +{- Log a change in the presence of a key's value in a repository, + - and return the log filename. -} +logChange :: GitRepo -> Key -> UUID -> LogStatus -> IO FilePath +logChange repo key uuid status = do log <- logNow status uuid - if (status == FilePresent) - -- file added; just append to log - then appendLog logfile log - -- file removed; compact log - else do - ls <- readLog logfile - writeLog logfile (log:ls) - gitAdd repo logfile + ls <- readLog logfile + writeLog logfile (compactLog $ log:ls) + return logfile where - logfile = logFile repo file + logfile = logFile repo key {- Reads a log file. - Note that the LogLines returned may be in any order. -} @@ -129,22 +125,22 @@ logNow status uuid = do now <- getPOSIXTime return $ LogLine now status uuid -{- Returns the filename of the log file for a given annexed file. -} -logFile :: GitRepo -> FilePath -> String -logFile repo annexedFile = (gitStateDir repo) ++ - (gitRelative repo annexedFile) ++ ".log" +{- Returns the filename of the log file for a given key. -} +logFile :: GitRepo -> Key -> String +logFile repo key = + (gitStateDir repo) ++ (gitRelative repo (keyFile key)) ++ ".log" {- Returns a list of repository UUIDs that, according to the log, have - - the content of a file -} -fileLocations :: GitRepo -> FilePath -> IO [UUID] -fileLocations thisrepo file = do - lines <- readLog $ logFile thisrepo file + - the value of a key. -} +keyLocations :: GitRepo -> Key -> IO [UUID] +keyLocations thisrepo key = do + lines <- readLog $ logFile thisrepo key return $ map uuid (filterPresent lines) -{- Filters the list of LogLines to find ones where the file +{- Filters the list of LogLines to find ones where the value - is (or should still be) present. -} filterPresent :: [LogLine] -> [LogLine] -filterPresent lines = filter (\l -> FilePresent == status l) $ compactLog lines +filterPresent lines = filter (\l -> ValuePresent == status l) $ compactLog lines {- Compacts a set of logs, returning a subset that contains the current - status. -} diff --git a/Locations.hs b/Locations.hs index 300f443f7..59f9df727 100644 --- a/Locations.hs +++ b/Locations.hs @@ -3,9 +3,14 @@ module Locations ( gitStateDir, - stateLoc + stateLoc, + keyFile, + annexLocation, + backendFile ) where +import Data.String.Utils +import Types import GitRepo {- Long-term, cross-repo state is stored in files inside the .git-annex @@ -13,3 +18,21 @@ import GitRepo stateLoc = ".git-annex" gitStateDir :: GitRepo -> FilePath gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" + +{- Generates a filename that can be used to record a key somewhere to disk. + - Just escape "/" in the key name, to keep a flat + - tree of files and avoid issues with files ending with "/" etc. -} +keyFile :: Key -> FilePath +keyFile key = replace "/" "%" $ replace "%" "%%" key + +{- An annexed file's content is stored somewhere under .git/annex/, + - based on the key. -} +annexLocation :: State -> Key -> FilePath +annexLocation state key = gitDir (repo state) ++ "/annex/" ++ (keyFile key) + +{- Name of state file that holds the key for an annexed file, + - using a given backend. -} +backendFile :: State -> Backend -> FilePath -> String +backendFile state backend file = + gitStateDir (repo state) ++ (gitRelative (repo state) file) ++ + "." ++ (name backend) @@ -6,6 +6,7 @@ module Types ( Backend(..) ) where +import Data.String.Utils import GitRepo -- git-annex's runtime state |