{- git-annex file locations - - Copyright 2010-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE OverloadedStrings #-} module Annex.Locations ( keyFile, keyFile', fileKey, fileKey', keyPaths, keyPath, annexDir, objectDir, gitAnnexLocation, gitAnnexLocationDepth, gitAnnexLink, gitAnnexLinkCanonical, gitAnnexContentLock, gitAnnexMapping, gitAnnexInodeCache, gitAnnexInodeSentinal, gitAnnexInodeSentinalCache, annexLocations, gitAnnexDir, gitAnnexObjectDir, gitAnnexTmpOtherDir, gitAnnexTmpOtherLock, gitAnnexTmpOtherDirOld, gitAnnexTmpObjectDir, gitAnnexTmpObjectLocation, gitAnnexTmpWorkDir, gitAnnexBadDir, gitAnnexBadLocation, gitAnnexUnusedLog, gitAnnexKeysDb, gitAnnexKeysDbLock, gitAnnexKeysDbIndexCache, gitAnnexFsckState, gitAnnexFsckDbDir, gitAnnexFsckDbLock, gitAnnexFsckResultsLog, gitAnnexSmudgeLog, gitAnnexSmudgeLock, gitAnnexExportDbDir, gitAnnexExportLock, gitAnnexExportUpdateLock, gitAnnexContentIdentifierDbDir, gitAnnexContentIdentifierLock, gitAnnexScheduleState, gitAnnexTransferDir, gitAnnexCredsDir, gitAnnexWebCertificate, gitAnnexWebPrivKey, gitAnnexFeedStateDir, gitAnnexFeedState, gitAnnexMergeDir, gitAnnexJournalDir, gitAnnexJournalLock, gitAnnexPreCommitLock, gitAnnexMergeLock, gitAnnexIndex, gitAnnexIndexStatus, gitAnnexViewIndex, gitAnnexViewLog, gitAnnexMergedRefs, gitAnnexIgnoredRefs, gitAnnexPidFile, gitAnnexPidLockFile, gitAnnexDaemonStatusFile, gitAnnexLogFile, gitAnnexFuzzTestLogFile, gitAnnexHtmlShim, gitAnnexUrlFile, gitAnnexTmpCfgFile, gitAnnexSshDir, gitAnnexRemotesDir, gitAnnexAssistantDefaultDir, HashLevels(..), hashDirMixed, hashDirLower, preSanitizeKeyName, reSanitizeKeyName, ) where import Data.Char import Data.Default import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Common import Key import Types.UUID import Types.GitConfig import Types.Difference import qualified Git import qualified Git.Types as 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) (coreSymlinks config) doesFileExist (Git.localGitDir r) gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (FilePath -> IO Bool) -> FilePath -> IO FilePath gitAnnexLocation' key r config crippled symlinkssupported checker gitdir {- Bare repositories default to hashDirLower for new - content, as it's more portable. But check all locations. -} | Git.repoIsLocalBare r = checkall | hasDifference ObjectHashLower (annexDifferences config) = only hashDirLower {- Repositories on crippled filesystems use hashDirLower - for new content, unless symlinks are supported too. - Then hashDirMixed is used. But, the content could be - in either location so check both. -} | crippled = if symlinkssupported then check $ map inrepo $ reverse $ annexLocations config key else checkall {- Regular repositories only use hashDirMixed, so - don't need to do any work to check if the file is - present. -} | otherwise = only hashDirMixed where only = return . inrepo . annexLocation config key checkall = check $ map inrepo $ annexLocations config key 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 = absNormPathUnix currdir file let gitdir = getgitdir currdir loc <- gitAnnexLocation' key r config False 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 = absNormPathUnix currdir $ Git.repoPath r ".git" | otherwise = Git.localGitDir r absNormPathUnix d p = toInternalGitPath $ absPathFrom (toInternalGitPath d) (toInternalGitPath p) {- Calculates a symlink target as would be used in a typical git - repository, with .git in the top of the work tree. -} gitAnnexLinkCanonical :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config' where r' = case r of Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } -> r { Git.location = l { Git.gitdir = wt ".git" } } _ -> r config' = config { annexCrippledFileSystem = False , coreSymlinks = True } {- 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/tmp/ is used for temp files for key's contents -} gitAnnexTmpObjectDir :: Git.Repo -> FilePath gitAnnexTmpObjectDir r = addTrailingPathSeparator $ gitAnnexDir r "tmp" {- .git/annex/othertmp/ is used for other temp files -} gitAnnexTmpOtherDir :: Git.Repo -> FilePath gitAnnexTmpOtherDir r = addTrailingPathSeparator $ gitAnnexDir r "othertmp" {- Lock file for gitAnnexTmpOtherDir. -} gitAnnexTmpOtherLock :: Git.Repo -> FilePath gitAnnexTmpOtherLock r = gitAnnexDir r "othertmp.lck" {- Directory used by old versions of git-annex. -} gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ gitAnnexDir r "misctmp" {- The temp file to use for a given key's content. -} gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r keyFile key {- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a - subdirectory in the same location, that can be used as a work area - when receiving the key's content. - - There are ordering requirements for creating these directories; - use Annex.Content.withTmpWorkDir to set them up. -} gitAnnexTmpWorkDir :: FilePath -> FilePath gitAnnexTmpWorkDir p = let (dir, f) = splitFileName p -- Using a prefix avoids name conflict with any other keys. in dir "work." ++ f {- .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" {- Contains the stat of the last index file that was - reconciled with rhe keys database. -} gitAnnexKeysDbIndexCache :: Git.Repo -> FilePath gitAnnexKeysDbIndexCache r = gitAnnexKeysDb r ++ ".cache" {- .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/smudge.log is used to log smudges worktree files that need to - be updated. -} gitAnnexSmudgeLog :: Git.Repo -> FilePath gitAnnexSmudgeLog r = gitAnnexDir r "smudge.log" gitAnnexSmudgeLock :: Git.Repo -> FilePath gitAnnexSmudgeLock r = gitAnnexDir r "smudge.lck" {- .git/annex/export/uuid/ is used to store information about - exports to special remotes. -} gitAnnexExportDir :: UUID -> Git.Repo -> FilePath gitAnnexExportDir u r = gitAnnexDir r "export" fromUUID u {- Directory containing database used to record export info. -} gitAnnexExportDbDir :: UUID -> Git.Repo -> FilePath gitAnnexExportDbDir u r = gitAnnexExportDir u r "db" {- Lock file for export state for a special remote. -} gitAnnexExportLock :: UUID -> Git.Repo -> FilePath gitAnnexExportLock u r = gitAnnexExportDbDir u r ++ ".lck" {- Lock file for updating the export state for a special remote. -} gitAnnexExportUpdateLock :: UUID -> Git.Repo -> FilePath gitAnnexExportUpdateLock u r = gitAnnexExportDbDir u r ++ ".upl" {- Directory containing database used to record remote content ids. - - (This used to be "cid", but a problem with the database caused it to - need to be rebuilt with a new name.) -} gitAnnexContentIdentifierDbDir :: Git.Repo -> FilePath gitAnnexContentIdentifierDbDir r = gitAnnexDir r "cids" {- Lock file for writing to the content id database. -} gitAnnexContentIdentifierLock :: Git.Repo -> FilePath gitAnnexContentIdentifierLock r = gitAnnexContentIdentifierDbDir r ++ ".lck" {- .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 as a empty work tree for direct mode merges and - merges in adjusted branches. -} 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 have already been merged into the git-annex branch. -} gitAnnexMergedRefs :: Git.Repo -> FilePath gitAnnexMergedRefs r = gitAnnexDir r "mergedrefs" {- 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" {- Sanitizes a String that will be used as part of a Key's keyName, - dealing with characters that cause problems. - - 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 problematic - 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 = preSanitizeKeyName' False preSanitizeKeyName' :: Bool -> String -> String preSanitizeKeyName' resanitize = 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 == ',' = if not resanitize then ",," else "," | otherwise = ',' : show (ord c) {- Converts a keyName that has been santizied with an old version of - preSanitizeKeyName to be sanitized with the new version. -} reSanitizeKeyName :: String -> String reSanitizeKeyName = preSanitizeKeyName' True {- 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 = fromRawFilePath . keyFile' keyFile' :: Key -> RawFilePath keyFile' k = let b = L.toStrict (serializeKey' k) in if any (`S8.elem` b) ['&', '%', ':', '/'] then S8.concatMap esc b else b where esc '&' = "&a" esc '%' = "&s" esc ':' = "&c" esc '/' = "%" esc c = S8.singleton c {- Reverses keyFile, converting a filename fragment (ie, the basename of - the symlink target) into a key. -} fileKey :: FilePath -> Maybe Key fileKey = fileKey' . toRawFilePath fileKey' :: RawFilePath -> Maybe Key fileKey' = deserializeKey' . S8.intercalate "/" . map go . S8.split '%' where go = S8.concat . unescafterfirst . S8.split '&' unescafterfirst [] = [] unescafterfirst (b:bs) = b : map (unesc . S8.uncons) bs unesc :: Maybe (Char, S8.ByteString) -> S8.ByteString unesc Nothing = mempty unesc (Just ('c', b)) = S8.cons ':' b unesc (Just ('s', b)) = S8.cons '%' b unesc (Just ('a', b)) = S8.cons '&' b unesc (Just (c, b)) = S8.cons c b {- 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