From 10c579282b4f0acc7f26d8084916f7d538a89bd8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Jan 2016 16:36:33 -0400 Subject: remove 163 lines of code without changing anything except imports --- Annex/Action.hs | 2 +- Annex/AutoMerge.hs | 2 +- Annex/BloomFilter.hs | 2 +- Annex/Branch.hs | 2 +- Annex/BranchState.hs | 2 +- Annex/CatFile.hs | 2 +- Annex/CheckAttr.hs | 2 +- Annex/CheckIgnore.hs | 2 +- Annex/Common.hs | 9 + Annex/Concurrent.hs | 2 +- Annex/Content.hs | 7 +- Annex/Content/Direct.hs | 2 +- Annex/Difference.hs | 2 +- Annex/Direct.hs | 2 +- Annex/Drop.hs | 3 +- Annex/Environment.hs | 2 +- Annex/FileMatcher.hs | 2 +- Annex/Hook.hs | 2 +- Annex/Index.hs | 2 +- Annex/Ingest.hs | 2 +- Annex/Init.hs | 2 +- Annex/InodeSentinal.hs | 2 +- Annex/Journal.hs | 2 +- Annex/Link.hs | 3 +- Annex/Locations.hs | 476 +++++++++++++++++++++++++++++++++++++++++++ Annex/LockFile.hs | 2 +- Annex/LockPool/PosixOrPid.hs | 6 +- Annex/MetaData.hs | 2 +- Annex/Notification.hs | 2 +- Annex/NumCopies.hs | 2 +- Annex/Perms.hs | 2 +- Annex/Queue.hs | 2 +- Annex/Quvi.hs | 2 +- Annex/ReplaceFile.hs | 2 +- Annex/SpecialRemote.hs | 2 +- Annex/Ssh.hs | 2 +- Annex/TaggedPush.hs | 2 +- Annex/Transfer.hs | 2 +- Annex/UUID.hs | 2 +- Annex/Url.hs | 2 +- Annex/VariantFile.hs | 3 +- Annex/Version.hs | 2 +- Annex/View.hs | 2 +- Annex/View/ViewedFile.hs | 2 +- Annex/Wanted.hs | 2 +- Annex/WorkTree.hs | 2 +- 46 files changed, 534 insertions(+), 51 deletions(-) create mode 100644 Annex/Common.hs create mode 100644 Annex/Locations.hs (limited to 'Annex') diff --git a/Annex/Action.hs b/Annex/Action.hs index f59c9c2f4..a18ebaf78 100644 --- a/Annex/Action.hs +++ b/Annex/Action.hs @@ -14,7 +14,7 @@ import qualified Data.Map as M import System.Posix.Signals #endif -import Common.Annex +import Annex.Common import qualified Annex import Annex.Content diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index 938407890..c9f13f5bf 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -11,7 +11,7 @@ module Annex.AutoMerge , commitResolvedMerge ) where -import Common.Annex +import Annex.Common import qualified Annex.Queue import Annex.Direct import Annex.CatFile diff --git a/Annex/BloomFilter.hs b/Annex/BloomFilter.hs index 5773a88ee..040363a55 100644 --- a/Annex/BloomFilter.hs +++ b/Annex/BloomFilter.hs @@ -7,7 +7,7 @@ module Annex.BloomFilter where -import Common.Annex +import Annex.Common import qualified Annex import Utility.Bloom diff --git a/Annex/Branch.hs b/Annex/Branch.hs index ad96a2073..6ef778801 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -32,7 +32,7 @@ import qualified Data.Map as M import Data.Bits.Utils import Control.Concurrent (threadDelay) -import Common.Annex +import Annex.Common import Annex.BranchState import Annex.Journal import Annex.Index diff --git a/Annex/BranchState.hs b/Annex/BranchState.hs index 2885582cd..0550d4224 100644 --- a/Annex/BranchState.hs +++ b/Annex/BranchState.hs @@ -9,7 +9,7 @@ module Annex.BranchState where -import Common.Annex +import Annex.Common import Types.BranchState import qualified Annex diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index c77a208b8..8de0e536c 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -23,7 +23,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import System.PosixCompat.Types -import Common.Annex +import Annex.Common import qualified Git import qualified Git.CatFile import qualified Annex diff --git a/Annex/CheckAttr.hs b/Annex/CheckAttr.hs index bbe979b3e..28c5ffedd 100644 --- a/Annex/CheckAttr.hs +++ b/Annex/CheckAttr.hs @@ -11,7 +11,7 @@ module Annex.CheckAttr ( checkAttrStop, ) where -import Common.Annex +import Annex.Common import qualified Git.CheckAttr as Git import qualified Annex diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index 86b46f7c2..824f5feeb 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -12,7 +12,7 @@ module Annex.CheckIgnore ( checkIgnoreStop ) where -import Common.Annex +import Annex.Common import qualified Git.CheckIgnore as Git import qualified Annex diff --git a/Annex/Common.hs b/Annex/Common.hs new file mode 100644 index 000000000..1f039f135 --- /dev/null +++ b/Annex/Common.hs @@ -0,0 +1,9 @@ +module Annex.Common (module X) where + +import Common as X +import Types as X +import Types.Key as X +import Types.UUID as X +import Annex as X (gitRepo, inRepo, fromRepo, calcRepo) +import Annex.Locations as X +import Messages as X diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs index 787c3e446..d5809df45 100644 --- a/Annex/Concurrent.hs +++ b/Annex/Concurrent.hs @@ -7,7 +7,7 @@ module Annex.Concurrent where -import Common.Annex +import Annex.Common import Annex import Annex.CatFile import Annex.CheckAttr diff --git a/Annex/Content.hs b/Annex/Content.hs index fd0a2742c..103fa264d 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -52,7 +52,7 @@ module Annex.Content ( import System.IO.Unsafe (unsafeInterleaveIO) import qualified Data.Set as S -import Common.Annex +import Annex.Common import Logs.Location import Logs.Transfer import qualified Git @@ -62,7 +62,6 @@ import qualified Annex.Branch import Utility.DiskFree import Utility.FileMode import qualified Annex.Url as Url -import Types.Key import Utility.DataUnits import Utility.CopyFile import Utility.Metered @@ -336,12 +335,12 @@ verifyKeyContent v Types.Remote.UnVerified k f = ifM (shouldVerify v) , return True ) where - verifysize = case Types.Key.keySize k of + verifysize = case keySize k of Nothing -> return True Just size -> do size' <- liftIO $ catchDefaultIO 0 $ getFileSize f return (size' == size) - verifycontent = case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of + verifycontent = case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendName (keyBackendName k) of Nothing -> return True Just verifier -> verifier k f diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 3b9d1aea2..2007360e3 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -29,7 +29,7 @@ module Annex.Content.Direct ( addContentWhenNotPresent, ) where -import Common.Annex +import Annex.Common import Annex.Perms import qualified Git import Utility.Tmp diff --git a/Annex/Difference.hs b/Annex/Difference.hs index e0dc17da7..23448192a 100644 --- a/Annex/Difference.hs +++ b/Annex/Difference.hs @@ -10,7 +10,7 @@ module Annex.Difference ( setDifferences, ) where -import Common.Annex +import Annex.Common import Types.Difference import Logs.Difference import Config diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 8c3d5bb56..e85d8f447 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -10,7 +10,7 @@ module Annex.Direct where -import Common.Annex +import Annex.Common import qualified Annex import qualified Git import qualified Git.LsFiles diff --git a/Annex/Drop.hs b/Annex/Drop.hs index f02f4f386..8a86c0ba8 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -7,11 +7,10 @@ module Annex.Drop where -import Common.Annex +import Annex.Common import Logs.Trust import Annex.NumCopies import Types.Remote (uuid) -import Types.Key (key2file) import qualified Remote import qualified Command.Drop import Command diff --git a/Annex/Environment.hs b/Annex/Environment.hs index 13b52aa75..a066e9ab0 100644 --- a/Annex/Environment.hs +++ b/Annex/Environment.hs @@ -9,7 +9,7 @@ module Annex.Environment where -import Common.Annex +import Annex.Common import Utility.UserInfo import qualified Git.Config import Config diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index a008198f3..f1936bce9 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -9,7 +9,7 @@ module Annex.FileMatcher where import qualified Data.Map as M -import Common.Annex +import Annex.Common import Limit import Utility.Matcher import Types.Group diff --git a/Annex/Hook.hs b/Annex/Hook.hs index 1c17e03b4..a073c2598 100644 --- a/Annex/Hook.hs +++ b/Annex/Hook.hs @@ -11,7 +11,7 @@ module Annex.Hook where -import Common.Annex +import Annex.Common import qualified Git.Hook as Git import Config import qualified Annex diff --git a/Annex/Index.hs b/Annex/Index.hs index 60340c50b..ee27ce5f6 100644 --- a/Annex/Index.hs +++ b/Annex/Index.hs @@ -14,7 +14,7 @@ module Annex.Index ( import qualified Control.Exception as E -import Common.Annex +import Annex.Common import Git.Types import qualified Annex import Utility.Env diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 70ea105bb..0dd8b5967 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -21,7 +21,7 @@ module Annex.Ingest ( forceParams, ) where -import Common.Annex +import Annex.Common import Types.KeySource import Backend import Annex.Content diff --git a/Annex/Init.hs b/Annex/Init.hs index 9cb876284..ece6e3a31 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -16,7 +16,7 @@ module Annex.Init ( probeCrippledFileSystem, ) where -import Common.Annex +import Annex.Common import qualified Annex import qualified Git import qualified Git.LsFiles diff --git a/Annex/InodeSentinal.hs b/Annex/InodeSentinal.hs index 412a7accc..1e763d317 100644 --- a/Annex/InodeSentinal.hs +++ b/Annex/InodeSentinal.hs @@ -9,7 +9,7 @@ module Annex.InodeSentinal where -import Common.Annex +import Annex.Common import qualified Annex import Utility.InodeCache import Annex.Perms diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 148cefbbc..e4faa4865 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -13,7 +13,7 @@ module Annex.Journal where -import Common.Annex +import Annex.Common import qualified Git import Annex.Perms import Annex.LockFile diff --git a/Annex/Link.hs b/Annex/Link.hs index 7f1a1b14d..7fd0098ef 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -14,14 +14,13 @@ module Annex.Link where -import Common.Annex +import Annex.Common import qualified Annex import qualified Git.HashObject import qualified Git.UpdateIndex import qualified Annex.Queue import Git.Types import Git.FilePath -import Types.Key import qualified Data.ByteString.Lazy as L diff --git a/Annex/Locations.hs b/Annex/Locations.hs new file mode 100644 index 000000000..322165aee --- /dev/null +++ b/Annex/Locations.hs @@ -0,0 +1,476 @@ +{- git-annex file locations + - + - Copyright 2010-2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Locations ( + keyFile, + fileKey, + keyPaths, + keyPath, + annexDir, + objectDir, + gitAnnexLocation, + gitAnnexLocationDepth, + gitAnnexLink, + gitAnnexContentLock, + gitAnnexMapping, + gitAnnexInodeCache, + gitAnnexInodeSentinal, + gitAnnexInodeSentinalCache, + annexLocations, + gitAnnexDir, + gitAnnexObjectDir, + gitAnnexTmpMiscDir, + gitAnnexTmpObjectDir, + gitAnnexTmpObjectLocation, + gitAnnexBadDir, + gitAnnexBadLocation, + gitAnnexUnusedLog, + gitAnnexKeysDb, + gitAnnexKeysDbLock, + gitAnnexFsckState, + gitAnnexFsckDbDir, + gitAnnexFsckDbLock, + gitAnnexFsckResultsLog, + gitAnnexScheduleState, + gitAnnexTransferDir, + gitAnnexCredsDir, + gitAnnexWebCertificate, + gitAnnexWebPrivKey, + gitAnnexFeedStateDir, + gitAnnexFeedState, + gitAnnexMergeDir, + gitAnnexJournalDir, + gitAnnexJournalLock, + gitAnnexPreCommitLock, + gitAnnexMergeLock, + gitAnnexIndex, + gitAnnexIndexStatus, + gitAnnexViewIndex, + gitAnnexViewLog, + gitAnnexIgnoredRefs, + gitAnnexPidFile, + gitAnnexPidLockFile, + gitAnnexDaemonStatusFile, + gitAnnexLogFile, + gitAnnexFuzzTestLogFile, + gitAnnexHtmlShim, + gitAnnexUrlFile, + gitAnnexTmpCfgFile, + gitAnnexSshDir, + gitAnnexRemotesDir, + gitAnnexAssistantDefaultDir, + isLinkToAnnex, + HashLevels(..), + hashDirMixed, + hashDirLower, + preSanitizeKeyName, + + prop_isomorphic_fileKey +) where + +import Data.Char +import Data.Default + +import Common +import Types.Key +import Types.UUID +import Types.GitConfig +import Types.Difference +import qualified Git +import Git.FilePath +import Annex.DirHashes +import Annex.Fixup + +{- 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 full path relative to the git + - repository. Everything else returns path segments. + -} + +{- The directory git annex uses for local state, relative to the .git + - directory -} +annexDir :: FilePath +annexDir = addTrailingPathSeparator "annex" + +{- The directory git annex uses for locally available object content, + - relative to the .git directory -} +objectDir :: FilePath +objectDir = addTrailingPathSeparator $ annexDir "objects" + +{- Annexed file's possible locations relative to the .git directory. + - There are two different possibilities, using different hashes. + - + - Also, some repositories have a Difference in hash directory depth. + -} +annexLocations :: GitConfig -> Key -> [FilePath] +annexLocations config key = map (annexLocation config key) dirHashes + +annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> FilePath +annexLocation config key hasher = objectDir keyPath key (hasher $ objectHashLevels config) + +{- Number of subdirectories from the gitAnnexObjectDir + - to the gitAnnexLocation. -} +gitAnnexLocationDepth :: GitConfig -> Int +gitAnnexLocationDepth config = hashlevels + 1 + where + HashLevels hashlevels = objectHashLevels config + +{- Annexed object's location in a repository. + - + - When there are multiple possible locations, returns the one where the + - file is actually present. + - + - When the file is not present, returns the location where the file should + - be stored. + - + - This does not take direct mode into account, so in direct mode it is not + - the actual location of the file's content. + -} +gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) doesFileExist (Git.localGitDir r) +gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> (FilePath -> IO Bool) -> FilePath -> IO FilePath +gitAnnexLocation' key r config crippled checker gitdir + {- Bare repositories default to hashDirLower for new + - content, as it's more portable. + - + - Repositories on filesystems that are crippled also use + - hashDirLower, since they do not use symlinks and it's + - more portable. + -} + | Git.repoIsLocalBare r || crippled = + check $ map inrepo $ annexLocations config key + | hasDifference ObjectHashLower (annexDifferences config) = + return $ inrepo $ annexLocation config key hashDirLower + {- Non-bare repositories only use hashDirMixed, so + - don't need to do any work to check if the file is + - present. -} + | otherwise = return $ inrepo $ annexLocation config key hashDirMixed + where + inrepo d = gitdir d + check locs@(l:_) = fromMaybe l <$> firstM checker locs + check [] = error "internal" + +{- Calculates a symlink target to link a file to an annexed object. -} +gitAnnexLink :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexLink file key r config = do + currdir <- getCurrentDirectory + let absfile = fromMaybe whoops $ absNormPathUnix currdir file + let gitdir = getgitdir currdir + loc <- gitAnnexLocation' key r config False (\_ -> return True) gitdir + toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc + where + getgitdir currdir + {- This special case is for git submodules on filesystems not + - supporting symlinks; generate link target that will + - work portably. -} + | not (coreSymlinks config) && needsSubmoduleFixup r = + fromMaybe whoops $ absNormPathUnix currdir $ + Git.repoPath r ".git" + | otherwise = Git.localGitDir r + whoops = error $ "unable to normalize " ++ file + +{- File used to lock a key's content. -} +gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexContentLock key r config = do + loc <- gitAnnexLocation key r config + return $ loc ++ ".lck" + +{- File that maps from a key to the file(s) in the git repository. + - Used in direct mode. -} +gitAnnexMapping :: Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexMapping key r config = do + loc <- gitAnnexLocation key r config + return $ loc ++ ".map" + +{- File that caches information about a key's content, used to determine + - if a file has changed. + - Used in direct mode. -} +gitAnnexInodeCache :: Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexInodeCache key r config = do + loc <- gitAnnexLocation key r config + return $ loc ++ ".cache" + +gitAnnexInodeSentinal :: Git.Repo -> FilePath +gitAnnexInodeSentinal r = gitAnnexDir r "sentinal" + +gitAnnexInodeSentinalCache :: Git.Repo -> FilePath +gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r ++ ".cache" + +{- The annex directory of a repository. -} +gitAnnexDir :: Git.Repo -> FilePath +gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r annexDir + +{- The part of the annex directory where file contents are stored. -} +gitAnnexObjectDir :: Git.Repo -> FilePath +gitAnnexObjectDir r = addTrailingPathSeparator $ Git.localGitDir r objectDir + +{- .git/annex/misctmp/ is used for random temp files -} +gitAnnexTmpMiscDir :: Git.Repo -> FilePath +gitAnnexTmpMiscDir r = addTrailingPathSeparator $ gitAnnexDir r "misctmp" + +{- .git/annex/tmp/ is used for temp files for key's contents -} +gitAnnexTmpObjectDir :: Git.Repo -> FilePath +gitAnnexTmpObjectDir r = addTrailingPathSeparator $ gitAnnexDir r "tmp" + +{- The temp file to use for a given key's content. -} +gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath +gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r keyFile key + +{- .git/annex/bad/ is used for bad files found during fsck -} +gitAnnexBadDir :: Git.Repo -> FilePath +gitAnnexBadDir r = addTrailingPathSeparator $ gitAnnexDir r "bad" + +{- The bad file to use for a given key. -} +gitAnnexBadLocation :: Key -> Git.Repo -> FilePath +gitAnnexBadLocation key r = gitAnnexBadDir r keyFile key + +{- .git/annex/foounused is used to number possibly unused keys -} +gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath +gitAnnexUnusedLog prefix r = gitAnnexDir r (prefix ++ "unused") + +{- .git/annex/keys/ contains a database of information about keys. -} +gitAnnexKeysDb :: Git.Repo -> FilePath +gitAnnexKeysDb r = gitAnnexDir r "keys" + +{- Lock file for the keys database. -} +gitAnnexKeysDbLock :: Git.Repo -> FilePath +gitAnnexKeysDbLock r = gitAnnexKeysDb r ++ ".lck" + +{- .git/annex/fsck/uuid/ is used to store information about incremental + - fscks. -} +gitAnnexFsckDir :: UUID -> Git.Repo -> FilePath +gitAnnexFsckDir u r = gitAnnexDir r "fsck" fromUUID u + +{- used to store information about incremental fscks. -} +gitAnnexFsckState :: UUID -> Git.Repo -> FilePath +gitAnnexFsckState u r = gitAnnexFsckDir u r "state" + +{- Directory containing database used to record fsck info. -} +gitAnnexFsckDbDir :: UUID -> Git.Repo -> FilePath +gitAnnexFsckDbDir u r = gitAnnexFsckDir u r "db" + +{- Lock file for the fsck database. -} +gitAnnexFsckDbLock :: UUID -> Git.Repo -> FilePath +gitAnnexFsckDbLock u r = gitAnnexFsckDir u r "fsck.lck" + +{- .git/annex/fsckresults/uuid is used to store results of git fscks -} +gitAnnexFsckResultsLog :: UUID -> Git.Repo -> FilePath +gitAnnexFsckResultsLog u r = gitAnnexDir r "fsckresults" fromUUID u + +{- .git/annex/schedulestate is used to store information about when + - scheduled jobs were last run. -} +gitAnnexScheduleState :: Git.Repo -> FilePath +gitAnnexScheduleState r = gitAnnexDir r "schedulestate" + +{- .git/annex/creds/ is used to store credentials to access some special + - remotes. -} +gitAnnexCredsDir :: Git.Repo -> FilePath +gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r "creds" + +{- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp + - when HTTPS is enabled -} +gitAnnexWebCertificate :: Git.Repo -> FilePath +gitAnnexWebCertificate r = gitAnnexDir r "certificate.pem" +gitAnnexWebPrivKey :: Git.Repo -> FilePath +gitAnnexWebPrivKey r = gitAnnexDir r "privkey.pem" + +{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -} +gitAnnexFeedStateDir :: Git.Repo -> FilePath +gitAnnexFeedStateDir r = addTrailingPathSeparator $ gitAnnexDir r "feedstate" + +gitAnnexFeedState :: Key -> Git.Repo -> FilePath +gitAnnexFeedState k r = gitAnnexFeedStateDir r keyFile k + +{- .git/annex/merge/ is used for direct mode merges. -} +gitAnnexMergeDir :: Git.Repo -> FilePath +gitAnnexMergeDir r = addTrailingPathSeparator $ gitAnnexDir r "merge" + +{- .git/annex/transfer/ is used to record keys currently + - being transferred, and other transfer bookkeeping info. -} +gitAnnexTransferDir :: Git.Repo -> FilePath +gitAnnexTransferDir r = addTrailingPathSeparator $ gitAnnexDir r "transfer" + +{- .git/annex/journal/ is used to journal changes made to the git-annex + - branch -} +gitAnnexJournalDir :: Git.Repo -> FilePath +gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r "journal" + +{- Lock file for the journal. -} +gitAnnexJournalLock :: Git.Repo -> FilePath +gitAnnexJournalLock r = gitAnnexDir r "journal.lck" + +{- Lock file for the pre-commit hook. -} +gitAnnexPreCommitLock :: Git.Repo -> FilePath +gitAnnexPreCommitLock r = gitAnnexDir r "precommit.lck" + +{- Lock file for direct mode merge. -} +gitAnnexMergeLock :: Git.Repo -> FilePath +gitAnnexMergeLock r = gitAnnexDir r "merge.lck" + +{- .git/annex/index is used to stage changes to the git-annex branch -} +gitAnnexIndex :: Git.Repo -> FilePath +gitAnnexIndex r = gitAnnexDir r "index" + +{- Holds the ref of the git-annex branch that the index was last updated to. + - + - The .lck in the name is a historical accident; this is not used as a + - lock. -} +gitAnnexIndexStatus :: Git.Repo -> FilePath +gitAnnexIndexStatus r = gitAnnexDir r "index.lck" + +{- The index file used to generate a filtered branch view._-} +gitAnnexViewIndex :: Git.Repo -> FilePath +gitAnnexViewIndex r = gitAnnexDir r "viewindex" + +{- File containing a log of recently accessed views. -} +gitAnnexViewLog :: Git.Repo -> FilePath +gitAnnexViewLog r = gitAnnexDir r "viewlog" + +{- List of refs that should not be merged into the git-annex branch. -} +gitAnnexIgnoredRefs :: Git.Repo -> FilePath +gitAnnexIgnoredRefs r = gitAnnexDir r "ignoredrefs" + +{- Pid file for daemon mode. -} +gitAnnexPidFile :: Git.Repo -> FilePath +gitAnnexPidFile r = gitAnnexDir r "daemon.pid" + +{- Pid lock file for pidlock mode -} +gitAnnexPidLockFile :: Git.Repo -> FilePath +gitAnnexPidLockFile r = gitAnnexDir r "pidlock" + +{- Status file for daemon mode. -} +gitAnnexDaemonStatusFile :: Git.Repo -> FilePath +gitAnnexDaemonStatusFile r = gitAnnexDir r "daemon.status" + +{- Log file for daemon mode. -} +gitAnnexLogFile :: Git.Repo -> FilePath +gitAnnexLogFile r = gitAnnexDir r "daemon.log" + +{- Log file for fuzz test. -} +gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath +gitAnnexFuzzTestLogFile r = gitAnnexDir r "fuzztest.log" + +{- Html shim file used to launch the webapp. -} +gitAnnexHtmlShim :: Git.Repo -> FilePath +gitAnnexHtmlShim r = gitAnnexDir r "webapp.html" + +{- File containing the url to the webapp. -} +gitAnnexUrlFile :: Git.Repo -> FilePath +gitAnnexUrlFile r = gitAnnexDir r "url" + +{- Temporary file used to edit configuriation from the git-annex branch. -} +gitAnnexTmpCfgFile :: Git.Repo -> FilePath +gitAnnexTmpCfgFile r = gitAnnexDir r "config.tmp" + +{- .git/annex/ssh/ is used for ssh connection caching -} +gitAnnexSshDir :: Git.Repo -> FilePath +gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r "ssh" + +{- .git/annex/remotes/ is used for remote-specific state. -} +gitAnnexRemotesDir :: Git.Repo -> FilePath +gitAnnexRemotesDir r = addTrailingPathSeparator $ gitAnnexDir r "remotes" + +{- This is the base directory name used by the assistant when making + - repositories, by default. -} +gitAnnexAssistantDefaultDir :: FilePath +gitAnnexAssistantDefaultDir = "annex" + +{- Checks a symlink target to see if it appears to point to annexed content. + - + - We only look at paths inside the .git directory, and not at the .git + - directory itself, because GIT_DIR may cause a directory name other + - than .git to be used. + -} +isLinkToAnnex :: FilePath -> Bool +isLinkToAnnex s = (pathSeparator:objectDir) `isInfixOf` s + +{- Sanitizes a String that will be used as part of a Key's keyName, + - dealing with characters that cause problems on substandard filesystems. + - + - This is used when a new Key is initially being generated, eg by getKey. + - Unlike keyFile and fileKey, it does not need to be a reversable + - escaping. Also, it's ok to change this to add more problimatic + - characters later. Unlike changing keyFile, which could result in the + - filenames used for existing keys changing and contents getting lost. + - + - It is, however, important that the input and output of this function + - have a 1:1 mapping, to avoid two different inputs from mapping to the + - same key. + -} +preSanitizeKeyName :: String -> String +preSanitizeKeyName = concatMap escape + where + escape c + | isAsciiUpper c || isAsciiLower c || isDigit c = [c] + | c `elem` ".-_ " = [c] -- common, assumed safe + | c `elem` "/%:" = [c] -- handled by keyFile + -- , is safe and uncommon, so will be used to escape + -- other characters. By itself, it is escaped to + -- doubled form. + | c == ',' = ",," + | otherwise = ',' : show (ord c) + +{- Converts a key into a filename fragment without any directory. + - + - Escape "/" in the key name, to keep a flat tree of files and avoid + - issues with keys containing "/../" or ending with "/" etc. + - + - "/" is escaped to "%" because it's short and rarely used, and resembles + - a slash + - "%" is escaped to "&s", and "&" to "&a"; this ensures that the mapping + - is one to one. + - ":" is escaped to "&c", because it seemed like a good idea at the time. + - + - Changing what this function escapes and how is not a good idea, as it + - can cause existing objects to get lost. + -} +keyFile :: Key -> FilePath +keyFile key = replace "/" "%" $ replace ":" "&c" $ + replace "%" "&s" $ replace "&" "&a" $ key2file key + +{- Reverses keyFile, converting a filename fragment (ie, the basename of + - the symlink target) into a key. -} +fileKey :: FilePath -> Maybe Key +fileKey file = file2key $ + replace "&a" "&" $ replace "&s" "%" $ + replace "&c" ":" $ replace "%" "/" file + +{- for quickcheck -} +prop_isomorphic_fileKey :: String -> Bool +prop_isomorphic_fileKey s + | null s = True -- it's not legal for a key to have no keyName + | otherwise= Just k == fileKey (keyFile k) + where + k = stubKey { keyName = s, keyBackendName = "test" } + +{- A location to store a key on a special remote that uses a filesystem. + - A directory hash is used, to protect against filesystems that dislike + - having many items in a single directory. + - + - The file is put in a directory with the same name, this allows + - write-protecting the directory to avoid accidental deletion of the file. + -} +keyPath :: Key -> Hasher -> FilePath +keyPath key hasher = hasher key f f + where + f = keyFile key + +{- All possibile locations to store a key in a special remote + - using different directory hashes. + - + - This is compatible with the annexLocations, for interoperability between + - special remotes and git-annex repos. + -} +keyPaths :: Key -> [FilePath] +keyPaths key = map (\h -> keyPath key (h def)) dirHashes diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index 40f9c6b2a..cb1d232b9 100644 --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -15,7 +15,7 @@ module Annex.LockFile ( tryExclusiveLock, ) where -import Common.Annex +import Annex.Common import Annex import Types.LockCache import qualified Git diff --git a/Annex/LockPool/PosixOrPid.hs b/Annex/LockPool/PosixOrPid.hs index 58e597f0e..ecf96d51f 100644 --- a/Annex/LockPool/PosixOrPid.hs +++ b/Annex/LockPool/PosixOrPid.hs @@ -20,7 +20,9 @@ module Annex.LockPool.PosixOrPid ( checkSaneLock, ) where -import Common.Annex +import Common +import Types +import Annex.Locations import qualified Annex import qualified Utility.LockPool.Posix as Posix import qualified Utility.LockPool.PidLock as Pid @@ -58,7 +60,7 @@ checkSaneLock f h = H.checkSaneLock f h pidLockFile :: Annex (Maybe FilePath) pidLockFile = ifM (annexPidLock <$> Annex.getGitConfig) - ( Just <$> fromRepo gitAnnexPidLockFile + ( Just <$> Annex.fromRepo gitAnnexPidLockFile , pure Nothing ) diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs index 88415ffde..1f6a484ff 100644 --- a/Annex/MetaData.hs +++ b/Annex/MetaData.hs @@ -11,7 +11,7 @@ module Annex.MetaData ( module X ) where -import Common.Annex +import Annex.Common import qualified Annex import Types.MetaData as X import Annex.MetaData.StandardFields as X diff --git a/Annex/Notification.hs b/Annex/Notification.hs index a7b757e50..691b61dd5 100644 --- a/Annex/Notification.hs +++ b/Annex/Notification.hs @@ -9,7 +9,7 @@ module Annex.Notification (NotifyWitness, notifyTransfer, notifyDrop) where -import Common.Annex +import Annex.Common import Logs.Transfer #ifdef WITH_DBUS_NOTIFICATIONS import qualified Annex diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index 64c78fca0..8653e495a 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -22,7 +22,7 @@ module Annex.NumCopies ( UnVerifiedCopy(..), ) where -import Common.Annex +import Annex.Common import qualified Annex import Types.NumCopies import Logs.NumCopies diff --git a/Annex/Perms.hs b/Annex/Perms.hs index 2467c3c77..159cc328a 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -18,7 +18,7 @@ module Annex.Perms ( withShared, ) where -import Common.Annex +import Annex.Common import Utility.FileMode import Git.SharedRepository import qualified Annex diff --git a/Annex/Queue.hs b/Annex/Queue.hs index d4cab48ca..0e1b0f68c 100644 --- a/Annex/Queue.hs +++ b/Annex/Queue.hs @@ -16,7 +16,7 @@ module Annex.Queue ( mergeFrom, ) where -import Common.Annex +import Annex.Common import Annex hiding (new) import qualified Git.Queue import qualified Git.UpdateIndex diff --git a/Annex/Quvi.hs b/Annex/Quvi.hs index 0355ecd9e..efc63ca9f 100644 --- a/Annex/Quvi.hs +++ b/Annex/Quvi.hs @@ -9,7 +9,7 @@ module Annex.Quvi where -import Common.Annex +import Annex.Common import qualified Annex import Utility.Quvi import Utility.Url diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index f8c1d97a9..4b1b2b5db 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -7,7 +7,7 @@ module Annex.ReplaceFile where -import Common.Annex +import Annex.Common import Annex.Perms import Utility.Tmp diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs index 3892eea2f..8a2345830 100644 --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -7,7 +7,7 @@ module Annex.SpecialRemote where -import Common.Annex +import Annex.Common import Remote (remoteTypes, remoteMap) import Types.Remote (RemoteConfig, RemoteConfigKey, typename, setup) import Logs.Remote diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index c9325bb7d..5c6a9dcea 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -24,7 +24,7 @@ import qualified Data.Map as M import Data.Hash.MD5 import System.Exit -import Common.Annex +import Annex.Common import Annex.LockFile import qualified Build.SysConfig as SysConfig import qualified Annex diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index eff8d6e0e..ef1aeeea2 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -7,7 +7,7 @@ module Annex.TaggedPush where -import Common.Annex +import Annex.Common import qualified Remote import qualified Annex.Branch import qualified Git diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index fe428e21a..805446b75 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -18,7 +18,7 @@ module Annex.Transfer ( forwardRetry, ) where -import Common.Annex +import Annex.Common import Logs.Transfer as X import Annex.Notification as X import Annex.Perms diff --git a/Annex/UUID.hs b/Annex/UUID.hs index cdd06c9e6..69d4ab6c4 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -28,7 +28,7 @@ module Annex.UUID ( bitTorrentUUID, ) where -import Common.Annex +import Annex.Common import qualified Git import qualified Git.Config import Config diff --git a/Annex/Url.hs b/Annex/Url.hs index b1a932e62..b787ee78c 100644 --- a/Annex/Url.hs +++ b/Annex/Url.hs @@ -13,7 +13,7 @@ module Annex.Url ( getUserAgent, ) where -import Common.Annex +import Annex.Common import qualified Annex import Utility.Url as U import qualified Build.SysConfig as SysConfig diff --git a/Annex/VariantFile.hs b/Annex/VariantFile.hs index 89cfbc16a..9bf027b5c 100644 --- a/Annex/VariantFile.hs +++ b/Annex/VariantFile.hs @@ -7,8 +7,7 @@ module Annex.VariantFile where -import Common.Annex -import Types.Key +import Annex.Common import Data.Hash.MD5 diff --git a/Annex/Version.hs b/Annex/Version.hs index b54fb68e0..f294f8cd3 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -9,7 +9,7 @@ module Annex.Version where -import Common.Annex +import Annex.Common import Config import qualified Annex diff --git a/Annex/View.hs b/Annex/View.hs index 060301fd5..14c3eccad 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -7,7 +7,7 @@ module Annex.View where -import Common.Annex +import Annex.Common import Annex.View.ViewedFile import Types.View import Types.MetaData diff --git a/Annex/View/ViewedFile.hs b/Annex/View/ViewedFile.hs index 0acba235a..4bd11f756 100644 --- a/Annex/View/ViewedFile.hs +++ b/Annex/View/ViewedFile.hs @@ -16,7 +16,7 @@ module Annex.View.ViewedFile ( prop_viewedFile_roundtrips, ) where -import Common.Annex +import Annex.Common type FileName = String type ViewedFile = FileName diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs index ba7df0a9c..d226483a1 100644 --- a/Annex/Wanted.hs +++ b/Annex/Wanted.hs @@ -7,7 +7,7 @@ module Annex.Wanted where -import Common.Annex +import Annex.Common import Logs.PreferredContent import Annex.UUID diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs index 85ea9a62e..b2c8cb7f3 100644 --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -7,7 +7,7 @@ module Annex.WorkTree where -import Common.Annex +import Annex.Common import Annex.Link import Annex.CatFile import Annex.Version -- cgit v1.2.3