f1ce15036f
This is most of the way there, but not quite working. The layout of migrate.tree/ needs to be changed to follow this approach. git log will list all the files in tree order, so the new layout needs to alternate old and new keys. Can that be done? git may not document tree order, or may not preserve it here. Alternatively, change to using git log --format=raw and extract the tree header from that, then use git diff --raw $tree:migrate.tree/old $tree:migrate.tree/new That will be a little more expensive, but only when there are lots of migrations. Sponsored-by: Joshua Antonishen on Patreon
727 lines
26 KiB
Haskell
727 lines
26 KiB
Haskell
{- git-annex file locations
|
|
-
|
|
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Annex.Locations (
|
|
keyFile,
|
|
fileKey,
|
|
keyPaths,
|
|
keyPath,
|
|
annexDir,
|
|
objectDir,
|
|
gitAnnexLocation,
|
|
gitAnnexLocation',
|
|
gitAnnexLocationDepth,
|
|
gitAnnexLink,
|
|
gitAnnexLinkCanonical,
|
|
gitAnnexContentLock,
|
|
gitAnnexContentLockLock,
|
|
gitAnnexInodeSentinal,
|
|
gitAnnexInodeSentinalCache,
|
|
annexLocationsBare,
|
|
annexLocationsNonBare,
|
|
gitAnnexDir,
|
|
gitAnnexObjectDir,
|
|
gitAnnexTmpOtherDir,
|
|
gitAnnexTmpOtherLock,
|
|
gitAnnexTmpOtherDirOld,
|
|
gitAnnexTmpWatcherDir,
|
|
gitAnnexTmpObjectDir,
|
|
gitAnnexTmpObjectLocation,
|
|
gitAnnexTmpWorkDir,
|
|
gitAnnexBadDir,
|
|
gitAnnexBadLocation,
|
|
gitAnnexUnusedLog,
|
|
gitAnnexKeysDbDir,
|
|
gitAnnexKeysDbLock,
|
|
gitAnnexKeysDbIndexCache,
|
|
gitAnnexFsckState,
|
|
gitAnnexFsckDbDir,
|
|
gitAnnexFsckDbDirOld,
|
|
gitAnnexFsckDbLock,
|
|
gitAnnexFsckResultsLog,
|
|
gitAnnexUpgradeLog,
|
|
gitAnnexUpgradeLock,
|
|
gitAnnexSmudgeLog,
|
|
gitAnnexSmudgeLock,
|
|
gitAnnexRestageLog,
|
|
gitAnnexRestageLogOld,
|
|
gitAnnexRestageLock,
|
|
gitAnnexAdjustedBranchUpdateLog,
|
|
gitAnnexAdjustedBranchUpdateLock,
|
|
gitAnnexMigrateLog,
|
|
gitAnnexMigrateLock,
|
|
gitAnnexMigrationsLog,
|
|
gitAnnexMigrationsLock,
|
|
gitAnnexMoveLog,
|
|
gitAnnexMoveLock,
|
|
gitAnnexExportDir,
|
|
gitAnnexExportDbDir,
|
|
gitAnnexExportLock,
|
|
gitAnnexExportUpdateLock,
|
|
gitAnnexExportExcludeLog,
|
|
gitAnnexImportDir,
|
|
gitAnnexImportLog,
|
|
gitAnnexContentIdentifierDbDir,
|
|
gitAnnexContentIdentifierLock,
|
|
gitAnnexImportFeedDbDir,
|
|
gitAnnexImportFeedDbLock,
|
|
gitAnnexScheduleState,
|
|
gitAnnexTransferDir,
|
|
gitAnnexCredsDir,
|
|
gitAnnexWebCertificate,
|
|
gitAnnexWebPrivKey,
|
|
gitAnnexFeedStateDir,
|
|
gitAnnexFeedState,
|
|
gitAnnexMergeDir,
|
|
gitAnnexJournalDir,
|
|
gitAnnexPrivateJournalDir,
|
|
gitAnnexJournalLock,
|
|
gitAnnexGitQueueLock,
|
|
gitAnnexIndex,
|
|
gitAnnexPrivateIndex,
|
|
gitAnnexIndexStatus,
|
|
gitAnnexViewIndex,
|
|
gitAnnexViewLog,
|
|
gitAnnexMergedRefs,
|
|
gitAnnexIgnoredRefs,
|
|
gitAnnexPidFile,
|
|
gitAnnexPidLockFile,
|
|
gitAnnexDaemonStatusFile,
|
|
gitAnnexDaemonLogFile,
|
|
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 System.FilePath.ByteString as P
|
|
|
|
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
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
{- 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 :: RawFilePath
|
|
annexDir = P.addTrailingPathSeparator "annex"
|
|
|
|
{- The directory git annex uses for locally available object content,
|
|
- relative to the .git directory -}
|
|
objectDir :: RawFilePath
|
|
objectDir = P.addTrailingPathSeparator $ annexDir P.</> "objects"
|
|
|
|
{- Annexed file's possible locations relative to the .git directory
|
|
- in a non-bare repository.
|
|
-
|
|
- Normally it is hashDirMixed. However, it's always possible that a
|
|
- bare repository was converted to non-bare, or that the cripped
|
|
- filesystem setting changed, so still need to check both. -}
|
|
annexLocationsNonBare :: GitConfig -> Key -> [RawFilePath]
|
|
annexLocationsNonBare config key =
|
|
map (annexLocation config key) [hashDirMixed, hashDirLower]
|
|
|
|
{- Annexed file's possible locations relative to a bare repository. -}
|
|
annexLocationsBare :: GitConfig -> Key -> [RawFilePath]
|
|
annexLocationsBare config key =
|
|
map (annexLocation config key) [hashDirLower, hashDirMixed]
|
|
|
|
annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> RawFilePath
|
|
annexLocation config key hasher = objectDir P.</> 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.
|
|
-}
|
|
gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO RawFilePath
|
|
gitAnnexLocation = gitAnnexLocation' R.doesPathExist
|
|
|
|
gitAnnexLocation' :: (RawFilePath -> IO Bool) -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
|
|
gitAnnexLocation' checker key r config = gitAnnexLocation'' key r config
|
|
(annexCrippledFileSystem config)
|
|
(coreSymlinks config)
|
|
checker
|
|
(Git.localGitDir r)
|
|
|
|
gitAnnexLocation'' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (RawFilePath -> IO Bool) -> RawFilePath -> IO RawFilePath
|
|
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 annexLocationsBare
|
|
{- If the repository is configured to only use lower, no need
|
|
- to check both. -}
|
|
| hasDifference ObjectHashLower (annexDifferences config) =
|
|
only hashDirLower
|
|
{- Repositories on crippled filesystems use same layout as bare
|
|
- repos for new content, unless symlinks are supported too. -}
|
|
| crippled = if symlinkssupported
|
|
then checkall annexLocationsNonBare
|
|
else checkall annexLocationsBare
|
|
| otherwise = checkall annexLocationsNonBare
|
|
where
|
|
only = return . inrepo . annexLocation config key
|
|
checkall f = check $ map inrepo $ f config key
|
|
|
|
inrepo d = gitdir P.</> 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 :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
|
|
gitAnnexLink file key r config = do
|
|
currdir <- R.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 P.</> ".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 :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
|
|
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 P.</> ".git" } }
|
|
_ -> r
|
|
config' = config
|
|
{ annexCrippledFileSystem = False
|
|
, coreSymlinks = True
|
|
}
|
|
|
|
{- File used to lock a key's content. -}
|
|
gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath
|
|
gitAnnexContentLock key r config = do
|
|
loc <- gitAnnexLocation key r config
|
|
return $ loc <> ".lck"
|
|
|
|
{- Lock that is held when taking the gitAnnexContentLock to support the v10
|
|
- upgrade.
|
|
-
|
|
- This uses the gitAnnexInodeSentinal file, because it needs to be a file
|
|
- that exists in the repository, even when it's an old v8 repository that
|
|
- is mounted read-only. The gitAnnexInodeSentinal is created by git-annex
|
|
- init, so should already exist.
|
|
-}
|
|
gitAnnexContentLockLock :: Git.Repo -> RawFilePath
|
|
gitAnnexContentLockLock = gitAnnexInodeSentinal
|
|
|
|
gitAnnexInodeSentinal :: Git.Repo -> RawFilePath
|
|
gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal"
|
|
|
|
gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath
|
|
gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache"
|
|
|
|
{- The annex directory of a repository. -}
|
|
gitAnnexDir :: Git.Repo -> RawFilePath
|
|
gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir
|
|
|
|
{- The part of the annex directory where file contents are stored. -}
|
|
gitAnnexObjectDir :: Git.Repo -> RawFilePath
|
|
gitAnnexObjectDir r = P.addTrailingPathSeparator $
|
|
Git.localGitDir r P.</> objectDir
|
|
|
|
{- .git/annex/tmp/ is used for temp files for key's contents -}
|
|
gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath
|
|
gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $
|
|
gitAnnexDir r P.</> "tmp"
|
|
|
|
{- .git/annex/othertmp/ is used for other temp files -}
|
|
gitAnnexTmpOtherDir :: Git.Repo -> RawFilePath
|
|
gitAnnexTmpOtherDir r = P.addTrailingPathSeparator $
|
|
gitAnnexDir r P.</> "othertmp"
|
|
|
|
{- Lock file for gitAnnexTmpOtherDir. -}
|
|
gitAnnexTmpOtherLock :: Git.Repo -> RawFilePath
|
|
gitAnnexTmpOtherLock r = gitAnnexDir r P.</> "othertmp.lck"
|
|
|
|
{- .git/annex/misctmp/ was used by old versions of git-annex and is still
|
|
- used during initialization -}
|
|
gitAnnexTmpOtherDirOld :: Git.Repo -> RawFilePath
|
|
gitAnnexTmpOtherDirOld r = P.addTrailingPathSeparator $
|
|
gitAnnexDir r P.</> "misctmp"
|
|
|
|
{- .git/annex/watchtmp/ is used by the watcher and assistant -}
|
|
gitAnnexTmpWatcherDir :: Git.Repo -> RawFilePath
|
|
gitAnnexTmpWatcherDir r = P.addTrailingPathSeparator $
|
|
gitAnnexDir r P.</> "watchtmp"
|
|
|
|
{- The temp file to use for a given key's content. -}
|
|
gitAnnexTmpObjectLocation :: Key -> Git.Repo -> RawFilePath
|
|
gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> 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 :: RawFilePath -> RawFilePath
|
|
gitAnnexTmpWorkDir p =
|
|
let (dir, f) = P.splitFileName p
|
|
-- Using a prefix avoids name conflict with any other keys.
|
|
in dir P.</> "work." <> f
|
|
|
|
{- .git/annex/bad/ is used for bad files found during fsck -}
|
|
gitAnnexBadDir :: Git.Repo -> RawFilePath
|
|
gitAnnexBadDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad"
|
|
|
|
{- The bad file to use for a given key. -}
|
|
gitAnnexBadLocation :: Key -> Git.Repo -> RawFilePath
|
|
gitAnnexBadLocation key r = gitAnnexBadDir r P.</> keyFile key
|
|
|
|
{- .git/annex/foounused is used to number possibly unused keys -}
|
|
gitAnnexUnusedLog :: RawFilePath -> Git.Repo -> RawFilePath
|
|
gitAnnexUnusedLog prefix r = gitAnnexDir r P.</> (prefix <> "unused")
|
|
|
|
{- .git/annex/keysdb/ contains a database of information about keys. -}
|
|
gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexKeysDbDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "keysdb"
|
|
|
|
{- Lock file for the keys database. -}
|
|
gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> ".lck"
|
|
|
|
{- Contains the stat of the last index file that was
|
|
- reconciled with the keys database. -}
|
|
gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexKeysDbIndexCache r c = gitAnnexKeysDbDir r c <> ".cache"
|
|
|
|
{- .git/annex/fsck/uuid/ is used to store information about incremental
|
|
- fscks. -}
|
|
gitAnnexFsckDir :: UUID -> Git.Repo -> Maybe GitConfig -> RawFilePath
|
|
gitAnnexFsckDir u r mc = case annexDbDir =<< mc of
|
|
Nothing -> go (gitAnnexDir r)
|
|
Just d -> go d
|
|
where
|
|
go d = d P.</> "fsck" P.</> fromUUID u
|
|
|
|
{- used to store information about incremental fscks. -}
|
|
gitAnnexFsckState :: UUID -> Git.Repo -> RawFilePath
|
|
gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing P.</> "state"
|
|
|
|
{- Directory containing database used to record fsck info. -}
|
|
gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) P.</> "fsckdb"
|
|
|
|
{- Directory containing old database used to record fsck info. -}
|
|
gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) P.</> "db"
|
|
|
|
{- Lock file for the fsck database. -}
|
|
gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) P.</> "fsck.lck"
|
|
|
|
{- .git/annex/fsckresults/uuid is used to store results of git fscks -}
|
|
gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath
|
|
gitAnnexFsckResultsLog u r =
|
|
gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u
|
|
|
|
{- .git/annex/upgrade.log is used to record repository version upgrades. -}
|
|
gitAnnexUpgradeLog :: Git.Repo -> RawFilePath
|
|
gitAnnexUpgradeLog r = gitAnnexDir r P.</> "upgrade.log"
|
|
|
|
gitAnnexUpgradeLock :: Git.Repo -> RawFilePath
|
|
gitAnnexUpgradeLock r = gitAnnexDir r P.</> "upgrade.lck"
|
|
|
|
{- .git/annex/smudge.log is used to log smudged worktree files that need to
|
|
- be updated. -}
|
|
gitAnnexSmudgeLog :: Git.Repo -> RawFilePath
|
|
gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log"
|
|
|
|
gitAnnexSmudgeLock :: Git.Repo -> RawFilePath
|
|
gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck"
|
|
|
|
{- .git/annex/restage.log is used to log worktree files that need to be
|
|
- restaged in git -}
|
|
gitAnnexRestageLog :: Git.Repo -> RawFilePath
|
|
gitAnnexRestageLog r = gitAnnexDir r P.</> "restage.log"
|
|
|
|
{- .git/annex/restage.old is used while restaging files in git -}
|
|
gitAnnexRestageLogOld :: Git.Repo -> RawFilePath
|
|
gitAnnexRestageLogOld r = gitAnnexDir r P.</> "restage.old"
|
|
|
|
gitAnnexRestageLock :: Git.Repo -> RawFilePath
|
|
gitAnnexRestageLock r = gitAnnexDir r P.</> "restage.lck"
|
|
|
|
{- .git/annex/adjust.log is used to log when the adjusted branch needs to
|
|
- be updated. -}
|
|
gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> RawFilePath
|
|
gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r P.</> "adjust.log"
|
|
|
|
gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> RawFilePath
|
|
gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r P.</> "adjust.lck"
|
|
|
|
{- .git/annex/migrate.log is used to log migrations before committing them. -}
|
|
gitAnnexMigrateLog :: Git.Repo -> RawFilePath
|
|
gitAnnexMigrateLog r = gitAnnexDir r P.</> "migrate.log"
|
|
|
|
gitAnnexMigrateLock :: Git.Repo -> RawFilePath
|
|
gitAnnexMigrateLock r = gitAnnexDir r P.</> "migrate.lck"
|
|
|
|
{- .git/annex/migrations.log is used to log committed migrations. -}
|
|
gitAnnexMigrationsLog :: Git.Repo -> RawFilePath
|
|
gitAnnexMigrationsLog r = gitAnnexDir r P.</> "migrations.log"
|
|
|
|
gitAnnexMigrationsLock :: Git.Repo -> RawFilePath
|
|
gitAnnexMigrationsLock r = gitAnnexDir r P.</> "migrations.lck"
|
|
|
|
{- .git/annex/move.log is used to log moves that are in progress,
|
|
- to better support resuming an interrupted move. -}
|
|
gitAnnexMoveLog :: Git.Repo -> RawFilePath
|
|
gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log"
|
|
|
|
gitAnnexMoveLock :: Git.Repo -> RawFilePath
|
|
gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck"
|
|
|
|
{- .git/annex/export/ is used to store information about
|
|
- exports to special remotes. -}
|
|
gitAnnexExportDir :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "export"
|
|
|
|
{- Directory containing database used to record export info. -}
|
|
gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexExportDbDir u r c =
|
|
gitAnnexExportDir r c P.</> fromUUID u P.</> "exportdb"
|
|
|
|
{- Lock file for export database. -}
|
|
gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> ".lck"
|
|
|
|
{- Lock file for updating the export database with information from the
|
|
- repository. -}
|
|
gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexExportUpdateLock u r c = gitAnnexExportDbDir u r c <> ".upl"
|
|
|
|
{- Log file used to keep track of files that were in the tree exported to a
|
|
- remote, but were excluded by its preferred content settings. -}
|
|
gitAnnexExportExcludeLog :: UUID -> Git.Repo -> RawFilePath
|
|
gitAnnexExportExcludeLog u r = gitAnnexDir r P.</> "export.ex" P.</> fromUUID u
|
|
|
|
{- 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 -> GitConfig -> RawFilePath
|
|
gitAnnexContentIdentifierDbDir r c =
|
|
fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "cidsdb"
|
|
|
|
{- Lock file for writing to the content id database. -}
|
|
gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexContentIdentifierLock r c = gitAnnexContentIdentifierDbDir r c <> ".lck"
|
|
|
|
{- .git/annex/import/ is used to store information about
|
|
- imports from special remotes. -}
|
|
gitAnnexImportDir :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexImportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "import"
|
|
|
|
{- File containing state about the last import done from a remote. -}
|
|
gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexImportLog u r c =
|
|
gitAnnexImportDir r c P.</> fromUUID u P.</> "log"
|
|
|
|
{- Directory containing database used by importfeed. -}
|
|
gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexImportFeedDbDir r c =
|
|
fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "importfeed"
|
|
|
|
{- Lock file for writing to the importfeed database. -}
|
|
gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> RawFilePath
|
|
gitAnnexImportFeedDbLock r c = gitAnnexImportFeedDbDir r c <> ".lck"
|
|
|
|
{- .git/annex/schedulestate is used to store information about when
|
|
- scheduled jobs were last run. -}
|
|
gitAnnexScheduleState :: Git.Repo -> RawFilePath
|
|
gitAnnexScheduleState r = gitAnnexDir r P.</> "schedulestate"
|
|
|
|
{- .git/annex/creds/ is used to store credentials to access some special
|
|
- remotes. -}
|
|
gitAnnexCredsDir :: Git.Repo -> RawFilePath
|
|
gitAnnexCredsDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "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 = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem"
|
|
gitAnnexWebPrivKey :: Git.Repo -> FilePath
|
|
gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"
|
|
|
|
{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}
|
|
gitAnnexFeedStateDir :: Git.Repo -> RawFilePath
|
|
gitAnnexFeedStateDir r = P.addTrailingPathSeparator $
|
|
gitAnnexDir r P.</> "feedstate"
|
|
|
|
gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath
|
|
gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k
|
|
|
|
{- .git/annex/merge/ is used as a empty work tree for merges in
|
|
- adjusted branches. -}
|
|
gitAnnexMergeDir :: Git.Repo -> FilePath
|
|
gitAnnexMergeDir r = fromRawFilePath $
|
|
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge"
|
|
|
|
{- .git/annex/transfer/ is used to record keys currently
|
|
- being transferred, and other transfer bookkeeping info. -}
|
|
gitAnnexTransferDir :: Git.Repo -> RawFilePath
|
|
gitAnnexTransferDir r =
|
|
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "transfer"
|
|
|
|
{- .git/annex/journal/ is used to journal changes made to the git-annex
|
|
- branch -}
|
|
gitAnnexJournalDir :: Git.Repo -> RawFilePath
|
|
gitAnnexJournalDir r =
|
|
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal"
|
|
|
|
{- .git/annex/journal.private/ is used to journal changes regarding private
|
|
- repositories. -}
|
|
gitAnnexPrivateJournalDir :: Git.Repo -> RawFilePath
|
|
gitAnnexPrivateJournalDir r =
|
|
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal-private"
|
|
|
|
{- Lock file for the journal. -}
|
|
gitAnnexJournalLock :: Git.Repo -> RawFilePath
|
|
gitAnnexJournalLock r = gitAnnexDir r P.</> "journal.lck"
|
|
|
|
{- Lock file for flushing a git queue that writes to the git index or
|
|
- other git state that should only have one writer at a time. -}
|
|
gitAnnexGitQueueLock :: Git.Repo -> RawFilePath
|
|
gitAnnexGitQueueLock r = gitAnnexDir r P.</> "gitqueue.lck"
|
|
|
|
{- .git/annex/index is used to stage changes to the git-annex branch -}
|
|
gitAnnexIndex :: Git.Repo -> RawFilePath
|
|
gitAnnexIndex r = gitAnnexDir r P.</> "index"
|
|
|
|
{- .git/annex/index-private is used to store information that is not to
|
|
- be exposed to the git-annex branch. -}
|
|
gitAnnexPrivateIndex :: Git.Repo -> RawFilePath
|
|
gitAnnexPrivateIndex r = gitAnnexDir r P.</> "index-private"
|
|
|
|
{- 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 -> RawFilePath
|
|
gitAnnexIndexStatus r = gitAnnexDir r P.</> "index.lck"
|
|
|
|
{- The index file used to generate a filtered branch view._-}
|
|
gitAnnexViewIndex :: Git.Repo -> RawFilePath
|
|
gitAnnexViewIndex r = gitAnnexDir r P.</> "viewindex"
|
|
|
|
{- File containing a log of recently accessed views. -}
|
|
gitAnnexViewLog :: Git.Repo -> RawFilePath
|
|
gitAnnexViewLog r = gitAnnexDir r P.</> "viewlog"
|
|
|
|
{- List of refs that have already been merged into the git-annex branch. -}
|
|
gitAnnexMergedRefs :: Git.Repo -> RawFilePath
|
|
gitAnnexMergedRefs r = gitAnnexDir r P.</> "mergedrefs"
|
|
|
|
{- List of refs that should not be merged into the git-annex branch. -}
|
|
gitAnnexIgnoredRefs :: Git.Repo -> RawFilePath
|
|
gitAnnexIgnoredRefs r = gitAnnexDir r P.</> "ignoredrefs"
|
|
|
|
{- Pid file for daemon mode. -}
|
|
gitAnnexPidFile :: Git.Repo -> RawFilePath
|
|
gitAnnexPidFile r = gitAnnexDir r P.</> "daemon.pid"
|
|
|
|
{- Pid lock file for pidlock mode -}
|
|
gitAnnexPidLockFile :: Git.Repo -> RawFilePath
|
|
gitAnnexPidLockFile r = gitAnnexDir r P.</> "pidlock"
|
|
|
|
{- Status file for daemon mode. -}
|
|
gitAnnexDaemonStatusFile :: Git.Repo -> FilePath
|
|
gitAnnexDaemonStatusFile r = fromRawFilePath $
|
|
gitAnnexDir r P.</> "daemon.status"
|
|
|
|
{- Log file for daemon mode. -}
|
|
gitAnnexDaemonLogFile :: Git.Repo -> RawFilePath
|
|
gitAnnexDaemonLogFile r = gitAnnexDir r P.</> "daemon.log"
|
|
|
|
{- Log file for fuzz test. -}
|
|
gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath
|
|
gitAnnexFuzzTestLogFile r = fromRawFilePath $
|
|
gitAnnexDir r P.</> "fuzztest.log"
|
|
|
|
{- Html shim file used to launch the webapp. -}
|
|
gitAnnexHtmlShim :: Git.Repo -> RawFilePath
|
|
gitAnnexHtmlShim r = gitAnnexDir r P.</> "webapp.html"
|
|
|
|
{- File containing the url to the webapp. -}
|
|
gitAnnexUrlFile :: Git.Repo -> RawFilePath
|
|
gitAnnexUrlFile r = gitAnnexDir r P.</> "url"
|
|
|
|
{- Temporary file used to edit configuriation from the git-annex branch. -}
|
|
gitAnnexTmpCfgFile :: Git.Repo -> RawFilePath
|
|
gitAnnexTmpCfgFile r = gitAnnexDir r P.</> "config.tmp"
|
|
|
|
{- .git/annex/ssh/ is used for ssh connection caching -}
|
|
gitAnnexSshDir :: Git.Repo -> RawFilePath
|
|
gitAnnexSshDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh"
|
|
|
|
{- .git/annex/remotes/ is used for remote-specific state. -}
|
|
gitAnnexRemotesDir :: Git.Repo -> RawFilePath
|
|
gitAnnexRemotesDir r =
|
|
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "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 genKey.
|
|
- Unlike keyFile and fileKey, it does not need to be a reversible
|
|
- 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 -> RawFilePath
|
|
keyFile k =
|
|
let b = serializeKey' k
|
|
in if S8.any (`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 :: 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 -> RawFilePath
|
|
keyPath key hasher = hasher key P.</> f P.</> f
|
|
where
|
|
f = keyFile key
|
|
|
|
{- All possible locations to store a key in a special remote
|
|
- using different directory hashes.
|
|
-
|
|
- This is compatible with the annexLocationsNonBare and annexLocationsBare,
|
|
- for interoperability between special remotes and git-annex repos.
|
|
-}
|
|
keyPaths :: Key -> [RawFilePath]
|
|
keyPaths key = map (\h -> keyPath key (h def)) dirHashes
|