refactor
This commit is contained in:
parent
97f809c006
commit
0815cc2fc1
2 changed files with 33 additions and 23 deletions
52
Locations.hs
52
Locations.hs
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex file locations
|
{- git-annex file locations
|
||||||
-
|
-
|
||||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -8,6 +8,7 @@
|
||||||
module Locations (
|
module Locations (
|
||||||
keyFile,
|
keyFile,
|
||||||
fileKey,
|
fileKey,
|
||||||
|
keyPaths,
|
||||||
gitAnnexLocation,
|
gitAnnexLocation,
|
||||||
annexLocations,
|
annexLocations,
|
||||||
gitAnnexDir,
|
gitAnnexDir,
|
||||||
|
@ -59,22 +60,12 @@ annexDir = addTrailingPathSeparator "annex"
|
||||||
objectDir :: FilePath
|
objectDir :: FilePath
|
||||||
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
||||||
|
|
||||||
{- Two different directory hashes may be used. The mixed case hash
|
|
||||||
- came first, and is fine, except for the problem of case-strict
|
|
||||||
- filesystems such as Linux VFAT (mounted with shortname=mixed),
|
|
||||||
- which do not allow using a directory "XX" when "xx" already exists.
|
|
||||||
- To support that, some repositories will use a lower case hash. -}
|
|
||||||
annexHashes :: [Key -> FilePath]
|
|
||||||
annexHashes = [hashDirMixed, hashDirLower]
|
|
||||||
|
|
||||||
{- Annexed file's possible locations relative to the .git directory.
|
{- Annexed file's possible locations relative to the .git directory.
|
||||||
- There are two different possibilities, using different hashes. -}
|
- There are two different possibilities, using different hashes. -}
|
||||||
annexLocations :: Key -> [FilePath]
|
annexLocations :: Key -> [FilePath]
|
||||||
annexLocations key = map (annexLocation key) annexHashes
|
annexLocations key = map (annexLocation key) annexHashes
|
||||||
annexLocation :: Key -> (Key -> FilePath) -> FilePath
|
annexLocation :: Key -> Hasher -> FilePath
|
||||||
annexLocation key hasher = objectDir </> hasher key </> f </> f
|
annexLocation key hasher = objectDir </> keyPath key hasher
|
||||||
where
|
|
||||||
f = keyFile key
|
|
||||||
|
|
||||||
{- Annexed file's absolute location in a repository.
|
{- Annexed file's absolute location in a repository.
|
||||||
-
|
-
|
||||||
|
@ -150,7 +141,7 @@ gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck"
|
||||||
isLinkToAnnex :: FilePath -> Bool
|
isLinkToAnnex :: FilePath -> Bool
|
||||||
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
||||||
|
|
||||||
{- Converts a key into a filename fragment.
|
{- Converts a key into a filename fragment without any directory.
|
||||||
-
|
-
|
||||||
- Escape "/" in the key name, to keep a flat tree of files and avoid
|
- Escape "/" in the key name, to keep a flat tree of files and avoid
|
||||||
- issues with keys containing "/../" or ending with "/" etc.
|
- issues with keys containing "/../" or ending with "/" etc.
|
||||||
|
@ -166,6 +157,22 @@ keyFile :: Key -> FilePath
|
||||||
keyFile key = replace "/" "%" $ replace ":" "&c" $
|
keyFile key = replace "/" "%" $ replace ":" "&c" $
|
||||||
replace "%" "&s" $ replace "&" "&a" $ show key
|
replace "%" "&s" $ replace "&" "&a" $ show key
|
||||||
|
|
||||||
|
{- A location to store a key on the 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 using different directory hashes. -}
|
||||||
|
keyPaths :: Key -> [FilePath]
|
||||||
|
keyPaths key = map (keyPath key) annexHashes
|
||||||
|
|
||||||
{- Reverses keyFile, converting a filename fragment (ie, the basename of
|
{- Reverses keyFile, converting a filename fragment (ie, the basename of
|
||||||
- the symlink target) into a key. -}
|
- the symlink target) into a key. -}
|
||||||
fileKey :: FilePath -> Maybe Key
|
fileKey :: FilePath -> Maybe Key
|
||||||
|
@ -178,17 +185,22 @@ prop_idempotent_fileKey :: String -> Bool
|
||||||
prop_idempotent_fileKey s = Just k == fileKey (keyFile k)
|
prop_idempotent_fileKey s = Just k == fileKey (keyFile k)
|
||||||
where k = stubKey { keyName = s, keyBackendName = "test" }
|
where k = stubKey { keyName = s, keyBackendName = "test" }
|
||||||
|
|
||||||
{- Given a key, generates a short directory name to put it in,
|
{- Two different directory hashes may be used. The mixed case hash
|
||||||
- to do hashing to protect against filesystems that dislike having
|
- came first, and is fine, except for the problem of case-strict
|
||||||
- many items in a single directory. -}
|
- filesystems such as Linux VFAT (mounted with shortname=mixed),
|
||||||
hashDirMixed :: Key -> FilePath
|
- which do not allow using a directory "XX" when "xx" already exists.
|
||||||
|
- To support that, some repositories will use a lower case hash. -}
|
||||||
|
type Hasher = Key -> FilePath
|
||||||
|
annexHashes :: [Hasher]
|
||||||
|
annexHashes = [hashDirMixed, hashDirLower]
|
||||||
|
|
||||||
|
hashDirMixed :: Hasher
|
||||||
hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir
|
hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir
|
||||||
where
|
where
|
||||||
dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d]
|
dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d]
|
||||||
ABCD (a,b,c,d) = md5 $ Str $ show k
|
ABCD (a,b,c,d) = md5 $ Str $ show k
|
||||||
|
|
||||||
{- Generates a hash directory that is all lower case. -}
|
hashDirLower :: Hasher
|
||||||
hashDirLower :: Key -> FilePath
|
|
||||||
hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir
|
hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir
|
||||||
where
|
where
|
||||||
dir = take 6 $ md5s $ Str $ show k
|
dir = take 6 $ md5s $ Str $ show k
|
||||||
|
|
|
@ -64,9 +64,7 @@ directorySetup u c = do
|
||||||
|
|
||||||
{- Locations to try to access a given Key in the Directory. -}
|
{- Locations to try to access a given Key in the Directory. -}
|
||||||
locations :: FilePath -> Key -> [FilePath]
|
locations :: FilePath -> Key -> [FilePath]
|
||||||
locations d k = map (\h -> d </> h k </> f </> f) annexHashes
|
locations d k = map (d </>) (keyLocations k)
|
||||||
where
|
|
||||||
f = keyFile k
|
|
||||||
|
|
||||||
withCheckedFile :: (FilePath -> IO Bool) -> FilePath -> Key -> (FilePath -> IO Bool) -> IO Bool
|
withCheckedFile :: (FilePath -> IO Bool) -> FilePath -> Key -> (FilePath -> IO Bool) -> IO Bool
|
||||||
withCheckedFile _ [] _ _ = return False
|
withCheckedFile _ [] _ _ = return False
|
||||||
|
|
Loading…
Reference in a new issue