diff --git a/Backend/File.hs b/Backend/File.hs index 35cbc01911..68dd4db271 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -77,7 +77,7 @@ copyKeyFile key file = do -- before going on to the next remote.) probablyPresent r = if not $ Git.repoIsUrl r - then liftIO $ doesFileExist $ annexLocation r key + then liftIO $ doesFileExist $ gitAnnexLocation r key else return True docopy r continue = do showNote $ "copying from " ++ Git.repoDescribe r ++ "..." diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index f8dbea4b03..3d868dbd19 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -48,7 +48,7 @@ keyValue file = do checkKeySHA1 :: Key -> Annex Bool checkKeySHA1 key = do g <- Annex.gitRepo - let file = annexLocation g key + let file = gitAnnexLocation g key present <- liftIO $ doesFileExist file if not present then return True diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 56f243396e..20a81d8411 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -57,7 +57,7 @@ keySize key = read $ section !! 1 checkKeySize :: Key -> Annex Bool checkKeySize key = do g <- Annex.gitRepo - let file = annexLocation g key + let file = gitAnnexLocation g key present <- liftIO $ doesFileExist file if not present then return True diff --git a/CmdLine.hs b/CmdLine.hs index 76402a8218..68d1e0dd31 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -111,7 +111,7 @@ shutdown errnum = do -- are left behind to allow resuming on re-run. when (errnum == 0) $ do g <- Annex.gitRepo - let tmp = annexTmpLocation g + let tmp = gitAnnexTmpDir g exists <- liftIO $ doesDirectoryExist tmp when exists $ liftIO $ removeDirectoryRecursive tmp liftIO $ createDirectoryIfMissing True tmp diff --git a/Command.hs b/Command.hs index bedb18cc97..bebbf3f1be 100644 --- a/Command.hs +++ b/Command.hs @@ -187,7 +187,7 @@ filterFiles l = do let regexp = compile (toregex exclude) [] return $ filter (notExcluded regexp) l' where - notState f = not $ isPrefixOf stateLoc f + notState f = not $ isPrefixOf stateDir f notExcluded r f = case match r f [] of Nothing -> True Just _ -> False diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index cfd6fc3d0e..9427f81035 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -40,7 +40,7 @@ start s = do readUnusedLog :: Annex (M.Map String Key) readUnusedLog = do g <- Annex.gitRepo - let f = annexUnusedLog g + let f = gitAnnexUnusedLog g e <- liftIO $ doesFileExist f if e then do diff --git a/Command/Init.hs b/Command/Init.hs index 47ac8e4c08..e780c88634 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -10,6 +10,7 @@ module Command.Init where import Control.Monad.State (liftIO) import Control.Monad (when) import System.Directory +import System.FilePath import Command import qualified Annex @@ -75,7 +76,7 @@ gitAttributesWrite repo = do attributes] attrLine :: String -attrLine = stateLoc ++ "*.log merge=union" +attrLine = stateDir "*.log merge=union" {- set up a git pre-commit hook, if one is not already present -} gitPreCommitHookWrite :: Git.Repo -> Annex () diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 566b508c0c..c0e80c5b47 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -50,7 +50,7 @@ perform file oldkey newbackend = do -- (the file can't be stored as usual, because it's already a symlink). -- The old backend's key is not dropped from it, because there may -- be other files still pointing at that key. - let src = annexLocation g oldkey + let src = gitAnnexLocation g oldkey stored <- Backend.storeFileKey src $ Just newbackend case stored of Nothing -> return Nothing diff --git a/Command/SendKey.hs b/Command/SendKey.hs index aaa0b48369..cb883b53aa 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -32,7 +32,7 @@ start keyname = do let key = genKey (head backends) keyname present <- inAnnex key g <- Annex.gitRepo - let file = annexLocation g key + let file = gitAnnexLocation g key when present $ liftIO $ rsyncServerSend file liftIO exitFailure diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 645fac8a25..bd1021cc3c 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -43,7 +43,7 @@ perform dest key = do error "content not present" g <- Annex.gitRepo - let src = annexLocation g key + let src = gitAnnexLocation g key liftIO $ removeFile dest showNote "copying..." ok <- liftIO $ copyFile src dest diff --git a/Command/Unused.hs b/Command/Unused.hs index 9fdf4cda65..5e5698e38d 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -43,7 +43,7 @@ checkUnused = do unused <- unusedKeys let list = number 1 unused g <- Annex.gitRepo - liftIO $ writeFile (annexUnusedLog g) $ unlines $ + liftIO $ writeFile (gitAnnexUnusedLog g) $ unlines $ map (\(n, k) -> show n ++ " " ++ show k) list if null unused then return True diff --git a/Content.hs b/Content.hs index 0cbd6905cb..d0ed8d861c 100644 --- a/Content.hs +++ b/Content.hs @@ -35,12 +35,12 @@ import qualified GitRepo as Git import qualified Annex import Utility -{- Checks if a given key is currently present in the annexLocation. -} +{- Checks if a given key is currently present in the gitAnnexLocation. -} inAnnex :: Key -> Annex Bool inAnnex key = do g <- Annex.gitRepo when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo" - liftIO $ doesFileExist $ annexLocation g key + liftIO $ doesFileExist $ gitAnnexLocation g key {- Calculates the relative path to use to link a file to a key. -} calcGitLink :: FilePath -> Key -> Annex FilePath @@ -51,7 +51,7 @@ calcGitLink file key = do Just f -> f Nothing -> error $ "unable to normalize " ++ file return $ relPathDirToDir (parentDir absfile) (Git.workTree g) ++ - annexLocationRelative key + annexLocation key {- Updates the LocationLog when a key's presence changes. -} logStatus :: Key -> LogStatus -> Annex () @@ -67,7 +67,7 @@ logStatus key status = do getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmp key action = do g <- Annex.gitRepo - let tmp = annexTmpLocation g ++ keyFile key + let tmp = gitAnnexTmpDir g keyFile key liftIO $ createDirectoryIfMissing True (parentDir tmp) success <- action tmp if success @@ -97,7 +97,7 @@ allowWrite f = do moveAnnex :: Key -> FilePath -> Annex () moveAnnex key src = do g <- Annex.gitRepo - let dest = annexLocation g key + let dest = gitAnnexLocation g key let dir = parentDir dest liftIO $ do createDirectoryIfMissing True dir @@ -110,7 +110,7 @@ moveAnnex key src = do removeAnnex :: Key -> Annex () removeAnnex key = do g <- Annex.gitRepo - let file = annexLocation g key + let file = gitAnnexLocation g key let dir = parentDir file liftIO $ do allowWrite dir @@ -121,7 +121,7 @@ removeAnnex key = do fromAnnex :: Key -> FilePath -> Annex () fromAnnex key dest = do g <- Annex.gitRepo - let file = annexLocation g key + let file = gitAnnexLocation g key let dir = parentDir file liftIO $ do allowWrite dir @@ -134,8 +134,8 @@ fromAnnex key dest = do moveBad :: Key -> Annex FilePath moveBad key = do g <- Annex.gitRepo - let src = annexLocation g key - let dest = annexBadLocation g ++ takeFileName src + let src = gitAnnexLocation g key + let dest = gitAnnexBadDir g takeFileName src liftIO $ createDirectoryIfMissing True (parentDir dest) liftIO $ allowWrite (parentDir src) liftIO $ renameFile src dest @@ -146,7 +146,7 @@ moveBad key = do getKeysPresent :: Annex [Key] getKeysPresent = do g <- Annex.gitRepo - getKeysPresent' $ annexObjectDir g + getKeysPresent' $ gitAnnexObjectDir g getKeysPresent' :: FilePath -> Annex [Key] getKeysPresent' dir = do exists <- liftIO $ doesDirectoryExist dir diff --git a/Locations.hs b/Locations.hs index 327c099e38..b2624754ec 100644 --- a/Locations.hs +++ b/Locations.hs @@ -7,73 +7,93 @@ module Locations ( gitStateDir, - stateLoc, + stateDir, keyFile, fileKey, + gitAnnexLocation, annexLocation, - annexLocationRelative, - annexTmpLocation, - annexBadLocation, - annexUnusedLog, + gitAnnexDir, + gitAnnexObjectDir, + gitAnnexTmpDir, + gitAnnexBadDir, + gitAnnexUnusedLog, isLinkToAnnex, - annexDir, - annexObjectDir, prop_idempotent_fileKey ) where +import System.FilePath import Data.String.Utils import Data.List import Types import qualified GitRepo as Git +{- Conventions: + - + - Functions ending in "Dir" should always return values ending with a + - trailing path separator. Most code does not rely on that, but a few + - things do. + - + - Everything else should not end in a trailing path sepatator. + - + - Only functions (with names starting with "git") that build a path + - based on a git repository should return an absolute path. + - Everything else should use relative paths. + -} + {- Long-term, cross-repo state is stored in files inside the .git-annex - directory, in the git repository's working tree. -} -stateLoc :: String -stateLoc = ".git-annex/" +stateDir :: FilePath +stateDir = addTrailingPathSeparator $ ".git-annex" gitStateDir :: Git.Repo -> FilePath -gitStateDir repo = Git.workTree repo ++ "/" ++ stateLoc +gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo stateDir -{- Annexed file's absolute location. -} -annexLocation :: Git.Repo -> Key -> FilePath -annexLocation r key = - Git.workTree r ++ "/" ++ annexLocationRelative key +{- Annexed content is stored in .git/annex/objects; .git/annex is used + - for other temporary storage also. -} +annexDir :: FilePath +annexDir = addTrailingPathSeparator $ ".git/annex" +objectDir :: FilePath +objectDir = addTrailingPathSeparator $ annexDir "objects" {- Annexed file's location relative to git's working tree. - - Note: Assumes repo is NOT bare.-} -annexLocationRelative :: Key -> FilePath -annexLocationRelative key = ".git/annex/objects/" ++ f ++ "/" ++ f +annexLocation :: Key -> FilePath +annexLocation key = ".git/annex/objects" f f where f = keyFile key +{- Annexed file's absolute location in a repository. -} +gitAnnexLocation :: Git.Repo -> Key -> FilePath +gitAnnexLocation r key = Git.workTree r annexLocation key + {- The annex directory of a repository. - - Note: Assumes repo is NOT bare. -} -annexDir :: Git.Repo -> FilePath -annexDir r = Git.workTree r ++ "/.git/annex" +gitAnnexDir :: Git.Repo -> FilePath +gitAnnexDir r = addTrailingPathSeparator $ Git.workTree r annexDir {- The part of the annex directory where file contents are stored. -} -annexObjectDir :: Git.Repo -> FilePath -annexObjectDir r = annexDir r ++ "/objects" +gitAnnexObjectDir :: Git.Repo -> FilePath +gitAnnexObjectDir r = addTrailingPathSeparator $ Git.workTree r objectDir {- .git-annex/tmp/ is used for temp files -} -annexTmpLocation :: Git.Repo -> FilePath -annexTmpLocation r = annexDir r ++ "/tmp/" +gitAnnexTmpDir :: Git.Repo -> FilePath +gitAnnexTmpDir r = addTrailingPathSeparator $ gitAnnexDir r "tmp" {- .git-annex/bad/ is used for bad files found during fsck -} -annexBadLocation :: Git.Repo -> FilePath -annexBadLocation r = annexDir r ++ "/bad/" +gitAnnexBadDir :: Git.Repo -> FilePath +gitAnnexBadDir r = addTrailingPathSeparator $ gitAnnexDir r "bad" {- .git/annex/unused is used to number possibly unused keys -} -annexUnusedLog :: Git.Repo -> FilePath -annexUnusedLog r = annexDir r ++ "/unused" +gitAnnexUnusedLog :: Git.Repo -> FilePath +gitAnnexUnusedLog r = gitAnnexDir r "unused" {- Checks a symlink target to see if it appears to point to annexed content. -} isLinkToAnnex :: FilePath -> Bool -isLinkToAnnex s = isInfixOf "/.git/annex/objects/" s +isLinkToAnnex s = isInfixOf ("/" ++ objectDir) s {- Converts a key into a filename fragment. - diff --git a/Remotes.hs b/Remotes.hs index be4c1383af..616db225ef 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -225,7 +225,7 @@ byName name = do {- Tries to copy a key's content from a remote's annex to a file. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool copyFromRemote r key file - | not $ Git.repoIsUrl r = liftIO $ copyFile (annexLocation r key) file + | not $ Git.repoIsUrl r = liftIO $ copyFile (gitAnnexLocation r key) file | Git.repoIsSsh r = rsynchelper r True key file | otherwise = error "copying from non-ssh repo not supported" @@ -234,7 +234,7 @@ copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote r key | not $ Git.repoIsUrl r = do g <- Annex.gitRepo - let keysrc = annexLocation g key + let keysrc = gitAnnexLocation g key -- run copy from perspective of remote liftIO $ do a <- Annex.new r [] @@ -245,7 +245,7 @@ copyToRemote r key return ok | Git.repoIsSsh r = do g <- Annex.gitRepo - let keysrc = annexLocation g key + let keysrc = gitAnnexLocation g key rsynchelper r False key keysrc | otherwise = error "copying to non-ssh repo not supported" diff --git a/Upgrade.hs b/Upgrade.hs index 596d525db2..1e70e68d56 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -39,9 +39,9 @@ upgradeFrom0 = do g <- Annex.gitRepo -- do the reorganisation of the files - let olddir = annexDir g + let olddir = gitAnnexDir g keys <- getKeysPresent0' olddir - _ <- mapM (\k -> moveAnnex k $ olddir ++ "/" ++ keyFile k) keys + _ <- mapM (\k -> moveAnnex k $ olddir keyFile k) keys -- update the symlinks to the files files <- liftIO $ Git.inRepo g [Git.workTree g] diff --git a/Version.hs b/Version.hs index fc1ce3d7ec..9e31d3c9eb 100644 --- a/Version.hs +++ b/Version.hs @@ -29,10 +29,10 @@ getVersion = do then return $ Just v else do -- version 0 was not recorded in .git/config; - -- such a repo should have an annexDir but no - -- annexObjectDir - d <- liftIO $ doesDirectoryExist $ annexDir g - o <- liftIO $ doesDirectoryExist $ annexObjectDir g + -- such a repo should have an gitAnnexDir but no + -- gitAnnexObjectDir + d <- liftIO $ doesDirectoryExist $ gitAnnexDir g + o <- liftIO $ doesDirectoryExist $ gitAnnexObjectDir g if d && not o then return $ Just "0" else return Nothing -- no version yet