summaryrefslogtreecommitdiff
path: root/Annex/DirHashes.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Annex/DirHashes.hs')
-rw-r--r--Annex/DirHashes.hs76
1 files changed, 76 insertions, 0 deletions
diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs
new file mode 100644
index 000000000..36998821b
--- /dev/null
+++ b/Annex/DirHashes.hs
@@ -0,0 +1,76 @@
+{- git-annex file locations
+ -
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.DirHashes (
+ Hasher,
+ HashLevels(..),
+ objectHashLevels,
+ dirHashes,
+ hashDirMixed,
+ hashDirLower,
+) where
+
+import Data.Bits
+import Data.Word
+import Data.Hash.MD5
+import Data.Default
+
+import Common
+import Types.Key
+import Types.GitConfig
+import Types.Difference
+
+type Hasher = Key -> FilePath
+
+-- Number of hash levels to use. 2 is the default.
+newtype HashLevels = HashLevels Int
+
+instance Default HashLevels where
+ def = HashLevels 2
+
+objectHashLevels :: GitConfig -> HashLevels
+objectHashLevels config
+ | hasDifference (== OneLevelObjectHash) (annexDifferences config) =
+ HashLevels 1
+ | otherwise = def
+
+{- 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, most repositories use the lower case hash for new data. -}
+dirHashes :: [HashLevels -> Hasher]
+dirHashes = [hashDirLower, hashDirMixed]
+
+hashDirs :: HashLevels -> Int -> String -> FilePath
+hashDirs (HashLevels 1) sz s = addTrailingPathSeparator $ take sz s
+hashDirs _ sz s = addTrailingPathSeparator $ take sz s </> drop sz s
+
+hashDirMixed :: HashLevels -> Hasher
+hashDirMixed n k = hashDirs n 2 $ take 4 $ display_32bits_as_dir =<< [a,b,c,d]
+ where
+ ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file $ nonChunkKey k
+
+hashDirLower :: HashLevels -> Hasher
+hashDirLower n k = hashDirs n 3 $ take 6 $ md5s $ md5FilePath $ key2file $ nonChunkKey k
+
+{- modified version of display_32bits_as_hex from Data.Hash.MD5
+ - Copyright (C) 2001 Ian Lynagh
+ - License: Either BSD or GPL
+ -}
+display_32bits_as_dir :: Word32 -> String
+display_32bits_as_dir w = trim $ swap_pairs cs
+ where
+ -- Need 32 characters to use. To avoid inaverdently making
+ -- a real word, use letters that appear less frequently.
+ chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF"
+ cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7]
+ getc n = chars !! fromIntegral n
+ swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs
+ swap_pairs _ = []
+ -- Last 2 will always be 00, so omit.
+ trim = take 6