From 167523f09d48777f3a5931fdcbc21b9d363e0e6c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 27 Jan 2011 17:00:32 -0400 Subject: [PATCH] better directory handling Rename Locations functions for better consitency, and make their values more consistent too. Used rather than manually building paths. There are still more places that manually do so, but are tricky, due to the behavior of when the second FilePath is absolute. So I only changed places where it obviously was relative. --- Backend/File.hs | 2 +- Backend/SHA1.hs | 2 +- Backend/WORM.hs | 2 +- CmdLine.hs | 2 +- Command.hs | 2 +- Command/DropUnused.hs | 2 +- Command/Init.hs | 3 +- Command/Migrate.hs | 2 +- Command/SendKey.hs | 2 +- Command/Unlock.hs | 2 +- Command/Unused.hs | 2 +- Content.hs | 20 ++++++------ Locations.hs | 74 +++++++++++++++++++++++++++---------------- Remotes.hs | 6 ++-- Upgrade.hs | 4 +-- Version.hs | 8 ++--- 16 files changed, 78 insertions(+), 57 deletions(-) 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