This commit is contained in:
Joey Hess 2010-10-12 20:04:36 -04:00
parent 476f66abb9
commit b7858ada03
6 changed files with 93 additions and 78 deletions

View file

@ -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]