1{- git-annex file locations 2 - 3 - Copyright 2010-2021 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8{-# LANGUAGE OverloadedStrings #-} 9 10module Annex.Locations ( 11 keyFile, 12 fileKey, 13 keyPaths, 14 keyPath, 15 annexDir, 16 objectDir, 17 objectDir', 18 gitAnnexLocation, 19 gitAnnexLocationDepth, 20 gitAnnexLink, 21 gitAnnexLinkCanonical, 22 gitAnnexContentLock, 23 gitAnnexInodeSentinal, 24 gitAnnexInodeSentinalCache, 25 annexLocationsBare, 26 annexLocationsNonBare, 27 gitAnnexDir, 28 gitAnnexObjectDir, 29 gitAnnexTmpOtherDir, 30 gitAnnexTmpOtherLock, 31 gitAnnexTmpOtherDirOld, 32 gitAnnexTmpWatcherDir, 33 gitAnnexTmpObjectDir, 34 gitAnnexTmpObjectLocation, 35 gitAnnexTmpWorkDir, 36 gitAnnexBadDir, 37 gitAnnexBadLocation, 38 gitAnnexUnusedLog, 39 gitAnnexKeysDb, 40 gitAnnexKeysDbLock, 41 gitAnnexKeysDbIndexCache, 42 gitAnnexFsckState, 43 gitAnnexFsckDbDir, 44 gitAnnexFsckDbDirOld, 45 gitAnnexFsckDbLock, 46 gitAnnexFsckResultsLog, 47 gitAnnexSmudgeLog, 48 gitAnnexSmudgeLock, 49 gitAnnexMoveLog, 50 gitAnnexMoveLock, 51 gitAnnexExportDir, 52 gitAnnexExportDbDir, 53 gitAnnexExportLock, 54 gitAnnexExportUpdateLock, 55 gitAnnexExportExcludeLog, 56 gitAnnexContentIdentifierDbDir, 57 gitAnnexContentIdentifierLock, 58 gitAnnexScheduleState, 59 gitAnnexTransferDir, 60 gitAnnexCredsDir, 61 gitAnnexWebCertificate, 62 gitAnnexWebPrivKey, 63 gitAnnexFeedStateDir, 64 gitAnnexFeedState, 65 gitAnnexMergeDir, 66 gitAnnexJournalDir, 67 gitAnnexPrivateJournalDir, 68 gitAnnexJournalLock, 69 gitAnnexGitQueueLock, 70 gitAnnexIndex, 71 gitAnnexPrivateIndex, 72 gitAnnexIndexStatus, 73 gitAnnexViewIndex, 74 gitAnnexViewLog, 75 gitAnnexMergedRefs, 76 gitAnnexIgnoredRefs, 77 gitAnnexPidFile, 78 gitAnnexPidLockFile, 79 gitAnnexDaemonStatusFile, 80 gitAnnexDaemonLogFile, 81 gitAnnexFuzzTestLogFile, 82 gitAnnexHtmlShim, 83 gitAnnexUrlFile, 84 gitAnnexTmpCfgFile, 85 gitAnnexSshDir, 86 gitAnnexRemotesDir, 87 gitAnnexAssistantDefaultDir, 88 HashLevels(..), 89 hashDirMixed, 90 hashDirLower, 91 preSanitizeKeyName, 92 reSanitizeKeyName, 93) where 94 95import Data.Char 96import Data.Default 97import qualified Data.ByteString.Char8 as S8 98import qualified System.FilePath.ByteString as P 99 100import Common 101import Key 102import Types.UUID 103import Types.GitConfig 104import Types.Difference 105import qualified Git 106import qualified Git.Types as Git 107import Git.FilePath 108import Annex.DirHashes 109import Annex.Fixup 110import qualified Utility.RawFilePath as R 111 112{- Conventions: 113 - 114 - Functions ending in "Dir" should always return values ending with a 115 - trailing path separator. Most code does not rely on that, but a few 116 - things do. 117 - 118 - Everything else should not end in a trailing path sepatator. 119 - 120 - Only functions (with names starting with "git") that build a path 121 - based on a git repository should return full path relative to the git 122 - repository. Everything else returns path segments. 123 -} 124 125{- The directory git annex uses for local state, relative to the .git 126 - directory -} 127annexDir :: RawFilePath 128annexDir = P.addTrailingPathSeparator "annex" 129 130{- The directory git annex uses for locally available object content, 131 - relative to the .git directory -} 132objectDir :: FilePath 133objectDir = fromRawFilePath objectDir' 134 135objectDir' :: RawFilePath 136objectDir' = P.addTrailingPathSeparator $ annexDir P.</> "objects" 137 138{- Annexed file's possible locations relative to the .git directory 139 - in a non-bare repository. 140 - 141 - Normally it is hashDirMixed. However, it's always possible that a 142 - bare repository was converted to non-bare, or that the cripped 143 - filesystem setting changed, so still need to check both. -} 144annexLocationsNonBare :: GitConfig -> Key -> [RawFilePath] 145annexLocationsNonBare config key = 146 map (annexLocation config key) [hashDirMixed, hashDirLower] 147 148{- Annexed file's possible locations relative to a bare repository. -} 149annexLocationsBare :: GitConfig -> Key -> [RawFilePath] 150annexLocationsBare config key = 151 map (annexLocation config key) [hashDirLower, hashDirMixed] 152 153annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> RawFilePath 154annexLocation config key hasher = objectDir' P.</> keyPath key (hasher $ objectHashLevels config) 155 156{- Number of subdirectories from the gitAnnexObjectDir 157 - to the gitAnnexLocation. -} 158gitAnnexLocationDepth :: GitConfig -> Int 159gitAnnexLocationDepth config = hashlevels + 1 160 where 161 HashLevels hashlevels = objectHashLevels config 162 163{- Annexed object's location in a repository. 164 - 165 - When there are multiple possible locations, returns the one where the 166 - file is actually present. 167 - 168 - When the file is not present, returns the location where the file should 169 - be stored. 170 -} 171gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO RawFilePath 172gitAnnexLocation key r config = gitAnnexLocation' key r config 173 (annexCrippledFileSystem config) 174 (coreSymlinks config) 175 R.doesPathExist 176 (Git.localGitDir r) 177 178gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (RawFilePath -> IO Bool) -> RawFilePath -> IO RawFilePath 179gitAnnexLocation' key r config crippled symlinkssupported checker gitdir 180 {- Bare repositories default to hashDirLower for new 181 - content, as it's more portable. But check all locations. -} 182 | Git.repoIsLocalBare r = checkall annexLocationsBare 183 {- If the repository is configured to only use lower, no need 184 - to check both. -} 185 | hasDifference ObjectHashLower (annexDifferences config) = 186 only hashDirLower 187 {- Repositories on crippled filesystems use same layout as bare 188 - repos for new content, unless symlinks are supported too. -} 189 | crippled = if symlinkssupported 190 then checkall annexLocationsNonBare 191 else checkall annexLocationsBare 192 | otherwise = checkall annexLocationsNonBare 193 where 194 only = return . inrepo . annexLocation config key 195 checkall f = check $ map inrepo $ f config key 196 197 inrepo d = gitdir P.</> d 198 check locs@(l:_) = fromMaybe l <$> firstM checker locs 199 check [] = error "internal" 200 201{- Calculates a symlink target to link a file to an annexed object. -} 202gitAnnexLink :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath 203gitAnnexLink file key r config = do 204 currdir <- R.getCurrentDirectory 205 let absfile = absNormPathUnix currdir file 206 let gitdir = getgitdir currdir 207 loc <- gitAnnexLocation' key r config False False (\_ -> return True) gitdir 208 toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc 209 where 210 getgitdir currdir 211 {- This special case is for git submodules on filesystems not 212 - supporting symlinks; generate link target that will 213 - work portably. -} 214 | not (coreSymlinks config) && needsSubmoduleFixup r = 215 absNormPathUnix currdir (Git.repoPath r P.</> ".git") 216 | otherwise = Git.localGitDir r 217 absNormPathUnix d p = toInternalGitPath $ 218 absPathFrom (toInternalGitPath d) (toInternalGitPath p) 219 220{- Calculates a symlink target as would be used in a typical git 221 - repository, with .git in the top of the work tree. -} 222gitAnnexLinkCanonical :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath 223gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config' 224 where 225 r' = case r of 226 Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } -> 227 r { Git.location = l { Git.gitdir = wt P.</> ".git" } } 228 _ -> r 229 config' = config 230 { annexCrippledFileSystem = False 231 , coreSymlinks = True 232 } 233 234{- File used to lock a key's content. -} 235gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath 236gitAnnexContentLock key r config = do 237 loc <- gitAnnexLocation key r config 238 return $ loc <> ".lck" 239 240gitAnnexInodeSentinal :: Git.Repo -> RawFilePath 241gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal" 242 243gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath 244gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache" 245 246{- The annex directory of a repository. -} 247gitAnnexDir :: Git.Repo -> RawFilePath 248gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir 249 250{- The part of the annex directory where file contents are stored. -} 251gitAnnexObjectDir :: Git.Repo -> RawFilePath 252gitAnnexObjectDir r = P.addTrailingPathSeparator $ 253 Git.localGitDir r P.</> objectDir' 254 255{- .git/annex/tmp/ is used for temp files for key's contents -} 256gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath 257gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $ 258 gitAnnexDir r P.</> "tmp" 259 260{- .git/annex/othertmp/ is used for other temp files -} 261gitAnnexTmpOtherDir :: Git.Repo -> RawFilePath 262gitAnnexTmpOtherDir r = P.addTrailingPathSeparator $ 263 gitAnnexDir r P.</> "othertmp" 264 265{- Lock file for gitAnnexTmpOtherDir. -} 266gitAnnexTmpOtherLock :: Git.Repo -> RawFilePath 267gitAnnexTmpOtherLock r = gitAnnexDir r P.</> "othertmp.lck" 268 269{- .git/annex/misctmp/ was used by old versions of git-annex and is still 270 - used during initialization -} 271gitAnnexTmpOtherDirOld :: Git.Repo -> RawFilePath 272gitAnnexTmpOtherDirOld r = P.addTrailingPathSeparator $ 273 gitAnnexDir r P.</> "misctmp" 274 275{- .git/annex/watchtmp/ is used by the watcher and assistant -} 276gitAnnexTmpWatcherDir :: Git.Repo -> RawFilePath 277gitAnnexTmpWatcherDir r = P.addTrailingPathSeparator $ 278 gitAnnexDir r P.</> "watchtmp" 279 280{- The temp file to use for a given key's content. -} 281gitAnnexTmpObjectLocation :: Key -> Git.Repo -> RawFilePath 282gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key 283 284{- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a 285 - subdirectory in the same location, that can be used as a work area 286 - when receiving the key's content. 287 - 288 - There are ordering requirements for creating these directories; 289 - use Annex.Content.withTmpWorkDir to set them up. 290 -} 291gitAnnexTmpWorkDir :: RawFilePath -> RawFilePath 292gitAnnexTmpWorkDir p = 293 let (dir, f) = P.splitFileName p 294 -- Using a prefix avoids name conflict with any other keys. 295 in dir P.</> "work." <> f 296 297{- .git/annex/bad/ is used for bad files found during fsck -} 298gitAnnexBadDir :: Git.Repo -> RawFilePath 299gitAnnexBadDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad" 300 301{- The bad file to use for a given key. -} 302gitAnnexBadLocation :: Key -> Git.Repo -> RawFilePath 303gitAnnexBadLocation key r = gitAnnexBadDir r P.</> keyFile key 304 305{- .git/annex/foounused is used to number possibly unused keys -} 306gitAnnexUnusedLog :: RawFilePath -> Git.Repo -> RawFilePath 307gitAnnexUnusedLog prefix r = gitAnnexDir r P.</> (prefix <> "unused") 308 309{- .git/annex/keysdb/ contains a database of information about keys. -} 310gitAnnexKeysDb :: Git.Repo -> RawFilePath 311gitAnnexKeysDb r = gitAnnexDir r P.</> "keysdb" 312 313{- Lock file for the keys database. -} 314gitAnnexKeysDbLock :: Git.Repo -> RawFilePath 315gitAnnexKeysDbLock r = gitAnnexKeysDb r <> ".lck" 316 317{- Contains the stat of the last index file that was 318 - reconciled with the keys database. -} 319gitAnnexKeysDbIndexCache :: Git.Repo -> RawFilePath 320gitAnnexKeysDbIndexCache r = gitAnnexKeysDb r <> ".cache" 321 322{- .git/annex/fsck/uuid/ is used to store information about incremental 323 - fscks. -} 324gitAnnexFsckDir :: UUID -> Git.Repo -> RawFilePath 325gitAnnexFsckDir u r = gitAnnexDir r P.</> "fsck" P.</> fromUUID u 326 327{- used to store information about incremental fscks. -} 328gitAnnexFsckState :: UUID -> Git.Repo -> RawFilePath 329gitAnnexFsckState u r = gitAnnexFsckDir u r P.</> "state" 330 331{- Directory containing database used to record fsck info. -} 332gitAnnexFsckDbDir :: UUID -> Git.Repo -> RawFilePath 333gitAnnexFsckDbDir u r = gitAnnexFsckDir u r P.</> "fsckdb" 334 335{- Directory containing old database used to record fsck info. -} 336gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> RawFilePath 337gitAnnexFsckDbDirOld u r = gitAnnexFsckDir u r P.</> "db" 338 339{- Lock file for the fsck database. -} 340gitAnnexFsckDbLock :: UUID -> Git.Repo -> RawFilePath 341gitAnnexFsckDbLock u r = gitAnnexFsckDir u r P.</> "fsck.lck" 342 343{- .git/annex/fsckresults/uuid is used to store results of git fscks -} 344gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath 345gitAnnexFsckResultsLog u r = 346 gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u 347 348{- .git/annex/smudge.log is used to log smudges worktree files that need to 349 - be updated. -} 350gitAnnexSmudgeLog :: Git.Repo -> RawFilePath 351gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log" 352 353gitAnnexSmudgeLock :: Git.Repo -> RawFilePath 354gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck" 355 356{- .git/annex/move.log is used to log moves that are in progress, 357 - to better support resuming an interrupted move. -} 358gitAnnexMoveLog :: Git.Repo -> RawFilePath 359gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log" 360 361gitAnnexMoveLock :: Git.Repo -> RawFilePath 362gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck" 363 364{- .git/annex/export/ is used to store information about 365 - exports to special remotes. -} 366gitAnnexExportDir :: Git.Repo -> RawFilePath 367gitAnnexExportDir r = gitAnnexDir r P.</> "export" 368 369{- Directory containing database used to record export info. -} 370gitAnnexExportDbDir :: UUID -> Git.Repo -> RawFilePath 371gitAnnexExportDbDir u r = gitAnnexExportDir r P.</> fromUUID u P.</> "exportdb" 372 373{- Lock file for export state for a special remote. -} 374gitAnnexExportLock :: UUID -> Git.Repo -> RawFilePath 375gitAnnexExportLock u r = gitAnnexExportDbDir u r <> ".lck" 376 377{- Lock file for updating the export state for a special remote. -} 378gitAnnexExportUpdateLock :: UUID -> Git.Repo -> RawFilePath 379gitAnnexExportUpdateLock u r = gitAnnexExportDbDir u r <> ".upl" 380 381{- Log file used to keep track of files that were in the tree exported to a 382 - remote, but were excluded by its preferred content settings. -} 383gitAnnexExportExcludeLog :: UUID -> Git.Repo -> RawFilePath 384gitAnnexExportExcludeLog u r = gitAnnexDir r P.</> "export.ex" P.</> fromUUID u 385 386{- Directory containing database used to record remote content ids. 387 - 388 - (This used to be "cid", but a problem with the database caused it to 389 - need to be rebuilt with a new name.) 390 -} 391gitAnnexContentIdentifierDbDir :: Git.Repo -> RawFilePath 392gitAnnexContentIdentifierDbDir r = gitAnnexDir r P.</> "cidsdb" 393 394{- Lock file for writing to the content id database. -} 395gitAnnexContentIdentifierLock :: Git.Repo -> RawFilePath 396gitAnnexContentIdentifierLock r = gitAnnexContentIdentifierDbDir r <> ".lck" 397 398{- .git/annex/schedulestate is used to store information about when 399 - scheduled jobs were last run. -} 400gitAnnexScheduleState :: Git.Repo -> RawFilePath 401gitAnnexScheduleState r = gitAnnexDir r P.</> "schedulestate" 402 403{- .git/annex/creds/ is used to store credentials to access some special 404 - remotes. -} 405gitAnnexCredsDir :: Git.Repo -> RawFilePath 406gitAnnexCredsDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "creds" 407 408{- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp 409 - when HTTPS is enabled -} 410gitAnnexWebCertificate :: Git.Repo -> FilePath 411gitAnnexWebCertificate r = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem" 412gitAnnexWebPrivKey :: Git.Repo -> FilePath 413gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem" 414 415{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -} 416gitAnnexFeedStateDir :: Git.Repo -> RawFilePath 417gitAnnexFeedStateDir r = P.addTrailingPathSeparator $ 418 gitAnnexDir r P.</> "feedstate" 419 420gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath 421gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k 422 423{- .git/annex/merge/ is used as a empty work tree for merges in 424 - adjusted branches. -} 425gitAnnexMergeDir :: Git.Repo -> FilePath 426gitAnnexMergeDir r = fromRawFilePath $ 427 P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge" 428 429{- .git/annex/transfer/ is used to record keys currently 430 - being transferred, and other transfer bookkeeping info. -} 431gitAnnexTransferDir :: Git.Repo -> RawFilePath 432gitAnnexTransferDir r = 433 P.addTrailingPathSeparator $ gitAnnexDir r P.</> "transfer" 434 435{- .git/annex/journal/ is used to journal changes made to the git-annex 436 - branch -} 437gitAnnexJournalDir :: Git.Repo -> RawFilePath 438gitAnnexJournalDir r = 439 P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal" 440 441{- .git/annex/journal.private/ is used to journal changes regarding private 442 - repositories. -} 443gitAnnexPrivateJournalDir :: Git.Repo -> RawFilePath 444gitAnnexPrivateJournalDir r = 445 P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal-private" 446 447{- Lock file for the journal. -} 448gitAnnexJournalLock :: Git.Repo -> RawFilePath 449gitAnnexJournalLock r = gitAnnexDir r P.</> "journal.lck" 450 451{- Lock file for flushing a git queue that writes to the git index or 452 - other git state that should only have one writer at a time. -} 453gitAnnexGitQueueLock :: Git.Repo -> RawFilePath 454gitAnnexGitQueueLock r = gitAnnexDir r P.</> "gitqueue.lck" 455 456{- .git/annex/index is used to stage changes to the git-annex branch -} 457gitAnnexIndex :: Git.Repo -> RawFilePath 458gitAnnexIndex r = gitAnnexDir r P.</> "index" 459 460{- .git/annex/index-private is used to store information that is not to 461 - be exposed to the git-annex branch. -} 462gitAnnexPrivateIndex :: Git.Repo -> RawFilePath 463gitAnnexPrivateIndex r = gitAnnexDir r P.</> "index-private" 464 465{- Holds the ref of the git-annex branch that the index was last updated to. 466 - 467 - The .lck in the name is a historical accident; this is not used as a 468 - lock. -} 469gitAnnexIndexStatus :: Git.Repo -> RawFilePath 470gitAnnexIndexStatus r = gitAnnexDir r P.</> "index.lck" 471 472{- The index file used to generate a filtered branch view._-} 473gitAnnexViewIndex :: Git.Repo -> RawFilePath 474gitAnnexViewIndex r = gitAnnexDir r P.</> "viewindex" 475 476{- File containing a log of recently accessed views. -} 477gitAnnexViewLog :: Git.Repo -> RawFilePath 478gitAnnexViewLog r = gitAnnexDir r P.</> "viewlog" 479 480{- List of refs that have already been merged into the git-annex branch. -} 481gitAnnexMergedRefs :: Git.Repo -> RawFilePath 482gitAnnexMergedRefs r = gitAnnexDir r P.</> "mergedrefs" 483 484{- List of refs that should not be merged into the git-annex branch. -} 485gitAnnexIgnoredRefs :: Git.Repo -> RawFilePath 486gitAnnexIgnoredRefs r = gitAnnexDir r P.</> "ignoredrefs" 487 488{- Pid file for daemon mode. -} 489gitAnnexPidFile :: Git.Repo -> RawFilePath 490gitAnnexPidFile r = gitAnnexDir r P.</> "daemon.pid" 491 492{- Pid lock file for pidlock mode -} 493gitAnnexPidLockFile :: Git.Repo -> RawFilePath 494gitAnnexPidLockFile r = gitAnnexDir r P.</> "pidlock" 495 496{- Status file for daemon mode. -} 497gitAnnexDaemonStatusFile :: Git.Repo -> FilePath 498gitAnnexDaemonStatusFile r = fromRawFilePath $ 499 gitAnnexDir r P.</> "daemon.status" 500 501{- Log file for daemon mode. -} 502gitAnnexDaemonLogFile :: Git.Repo -> RawFilePath 503gitAnnexDaemonLogFile r = gitAnnexDir r P.</> "daemon.log" 504 505{- Log file for fuzz test. -} 506gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath 507gitAnnexFuzzTestLogFile r = fromRawFilePath $ 508 gitAnnexDir r P.</> "fuzztest.log" 509 510{- Html shim file used to launch the webapp. -} 511gitAnnexHtmlShim :: Git.Repo -> RawFilePath 512gitAnnexHtmlShim r = gitAnnexDir r P.</> "webapp.html" 513 514{- File containing the url to the webapp. -} 515gitAnnexUrlFile :: Git.Repo -> RawFilePath 516gitAnnexUrlFile r = gitAnnexDir r P.</> "url" 517 518{- Temporary file used to edit configuriation from the git-annex branch. -} 519gitAnnexTmpCfgFile :: Git.Repo -> RawFilePath 520gitAnnexTmpCfgFile r = gitAnnexDir r P.</> "config.tmp" 521 522{- .git/annex/ssh/ is used for ssh connection caching -} 523gitAnnexSshDir :: Git.Repo -> RawFilePath 524gitAnnexSshDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh" 525 526{- .git/annex/remotes/ is used for remote-specific state. -} 527gitAnnexRemotesDir :: Git.Repo -> RawFilePath 528gitAnnexRemotesDir r = 529 P.addTrailingPathSeparator $ gitAnnexDir r P.</> "remotes" 530 531{- This is the base directory name used by the assistant when making 532 - repositories, by default. -} 533gitAnnexAssistantDefaultDir :: FilePath 534gitAnnexAssistantDefaultDir = "annex" 535 536{- Sanitizes a String that will be used as part of a Key's keyName, 537 - dealing with characters that cause problems. 538 - 539 - This is used when a new Key is initially being generated, eg by genKey. 540 - Unlike keyFile and fileKey, it does not need to be a reversable 541 - escaping. Also, it's ok to change this to add more problematic 542 - characters later. Unlike changing keyFile, which could result in the 543 - filenames used for existing keys changing and contents getting lost. 544 - 545 - It is, however, important that the input and output of this function 546 - have a 1:1 mapping, to avoid two different inputs from mapping to the 547 - same key. 548 -} 549preSanitizeKeyName :: String -> String 550preSanitizeKeyName = preSanitizeKeyName' False 551 552preSanitizeKeyName' :: Bool -> String -> String 553preSanitizeKeyName' resanitize = concatMap escape 554 where 555 escape c 556 | isAsciiUpper c || isAsciiLower c || isDigit c = [c] 557 | c `elem` ['.', '-', '_'] = [c] -- common, assumed safe 558 | c `elem` ['/', '%', ':'] = [c] -- handled by keyFile 559 -- , is safe and uncommon, so will be used to escape 560 -- other characters. By itself, it is escaped to 561 -- doubled form. 562 | c == ',' = if not resanitize 563 then ",," 564 else "," 565 | otherwise = ',' : show (ord c) 566 567{- Converts a keyName that has been santizied with an old version of 568 - preSanitizeKeyName to be sanitized with the new version. -} 569reSanitizeKeyName :: String -> String 570reSanitizeKeyName = preSanitizeKeyName' True 571 572{- Converts a key into a filename fragment without any directory. 573 - 574 - Escape "/" in the key name, to keep a flat tree of files and avoid 575 - issues with keys containing "/../" or ending with "/" etc. 576 - 577 - "/" is escaped to "%" because it's short and rarely used, and resembles 578 - a slash 579 - "%" is escaped to "&s", and "&" to "&a"; this ensures that the mapping 580 - is one to one. 581 - ":" is escaped to "&c", because it seemed like a good idea at the time. 582 - 583 - Changing what this function escapes and how is not a good idea, as it 584 - can cause existing objects to get lost. 585 -} 586keyFile :: Key -> RawFilePath 587keyFile k = 588 let b = serializeKey' k 589 in if S8.any (`elem` ['&', '%', ':', '/']) b 590 then S8.concatMap esc b 591 else b 592 where 593 esc '&' = "&a" 594 esc '%' = "&s" 595 esc ':' = "&c" 596 esc '/' = "%" 597 esc c = S8.singleton c 598 599{- Reverses keyFile, converting a filename fragment (ie, the basename of 600 - the symlink target) into a key. -} 601fileKey :: RawFilePath -> Maybe Key 602fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%' 603 where 604 go = S8.concat . unescafterfirst . S8.split '&' 605 unescafterfirst [] = [] 606 unescafterfirst (b:bs) = b : map (unesc . S8.uncons) bs 607 unesc :: Maybe (Char, S8.ByteString) -> S8.ByteString 608 unesc Nothing = mempty 609 unesc (Just ('c', b)) = S8.cons ':' b 610 unesc (Just ('s', b)) = S8.cons '%' b 611 unesc (Just ('a', b)) = S8.cons '&' b 612 unesc (Just (c, b)) = S8.cons c b 613 614{- A location to store a key on a special remote that uses a filesystem. 615 - A directory hash is used, to protect against filesystems that dislike 616 - having many items in a single directory. 617 - 618 - The file is put in a directory with the same name, this allows 619 - write-protecting the directory to avoid accidental deletion of the file. 620 -} 621keyPath :: Key -> Hasher -> RawFilePath 622keyPath key hasher = hasher key P.</> f P.</> f 623 where 624 f = keyFile key 625 626{- All possibile locations to store a key in a special remote 627 - using different directory hashes. 628 - 629 - This is compatible with the annexLocationsNonBare and annexLocationsBare, 630 - for interoperability between special remotes and git-annex repos. 631 -} 632keyPaths :: Key -> [RawFilePath] 633keyPaths key = map (\h -> keyPath key (h def)) dirHashes 634