diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-01-28 15:55:17 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-01-28 15:55:17 -0400 |
commit | 7ca8ec00a7fcda71a08d22f06838424765a1b215 (patch) | |
tree | aa377fccb40797a734372127c19177524fa8af2b | |
parent | 3327618e5b48afb10a8f98afe15c750d8ed4c416 (diff) |
groundwork for parameterizing hash depth
-rw-r--r-- | Command/Find.hs | 5 | ||||
-rw-r--r-- | Locations.hs | 33 | ||||
-rw-r--r-- | Logs.hs | 16 | ||||
-rw-r--r-- | Remote/Directory.hs | 3 | ||||
-rw-r--r-- | Remote/External.hs | 3 | ||||
-rw-r--r-- | Remote/GCrypt.hs | 3 | ||||
-rw-r--r-- | Remote/Hook.hs | 7 | ||||
-rw-r--r-- | Remote/Rsync.hs | 3 | ||||
-rw-r--r-- | Remote/Rsync/RsyncUrl.hs | 3 | ||||
-rw-r--r-- | Remote/WebDAV/DavLocation.hs | 5 | ||||
-rw-r--r-- | Upgrade/V1.hs | 3 |
11 files changed, 52 insertions, 32 deletions
diff --git a/Command/Find.hs b/Command/Find.hs index a52d17384..55124d838 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -7,6 +7,7 @@ module Command.Find where +import Data.Default import qualified Data.Map as M import Common.Annex @@ -65,8 +66,8 @@ keyVars key = , ("bytesize", size show) , ("humansize", size $ roughSize storageUnits True) , ("keyname", keyName key) - , ("hashdirlower", hashDirLower key) - , ("hashdirmixed", hashDirMixed key) + , ("hashdirlower", hashDirLower def key) + , ("hashdirmixed", hashDirMixed def key) , ("mtime", whenavail show $ keyMtime key) ] where diff --git a/Locations.hs b/Locations.hs index ed0962230..1a9551b3b 100644 --- a/Locations.hs +++ b/Locations.hs @@ -60,6 +60,7 @@ module Locations ( gitAnnexAssistantDefaultDir, isLinkToAnnex, annexHashes, + HashLevels(..), hashDirMixed, hashDirLower, preSanitizeKeyName, @@ -71,6 +72,7 @@ import Data.Bits import Data.Word import Data.Hash.MD5 import Data.Char +import Data.Default import Common import Types @@ -105,7 +107,7 @@ objectDir = addTrailingPathSeparator $ annexDir </> "objects" {- Annexed file's possible locations relative to the .git directory. - There are two different possibilities, using different hashes. -} annexLocations :: Key -> [FilePath] -annexLocations key = map (annexLocation key) annexHashes +annexLocations key = map (annexLocation key) (annexHashes def) annexLocation :: Key -> Hasher -> FilePath annexLocation key hasher = objectDir </> keyPath key hasher @@ -140,7 +142,7 @@ gitAnnexLocation' key r config crippled {- Non-bare repositories only use hashDirMixed, so - don't need to do any work to check if the file is - present. -} - | otherwise = return $ inrepo $ annexLocation key hashDirMixed + | otherwise = return $ inrepo $ annexLocation key (hashDirMixed def) where inrepo d = Git.localGitDir r </> d check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs @@ -419,28 +421,35 @@ keyPath key hasher = hasher key </> f </> f {- All possibile locations to store a key using different directory hashes. -} keyPaths :: Key -> [FilePath] -keyPaths key = map (keyPath key) annexHashes +keyPaths key = map (keyPath key) (annexHashes 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. -} +annexHashes :: HashLevels -> [Hasher] +annexHashes n = [hashDirLower n, hashDirMixed n] + type Hasher = Key -> FilePath -annexHashes :: [Hasher] -annexHashes = [hashDirLower, hashDirMixed] +-- Number of hash levels to use. 2 is the default. +newtype HashLevels = HashLevels Int + +instance Default HashLevels where + def = HashLevels 2 -hashDirMixed :: Hasher -hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir +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 - dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d] ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file $ nonChunkKey k -hashDirLower :: Hasher -hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir - where - dir = take 6 $ md5s $ 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 @@ -10,6 +10,8 @@ module Logs where import Common.Annex import Types.Key +import Data.Default + {- There are several varieties of log file formats. -} data LogVariety = UUIDBasedLog @@ -88,7 +90,7 @@ differenceLog = "difference.log" {- The pathname of the location log file for a given key. -} locationLogFile :: Key -> String -locationLogFile key = hashDirLower key ++ keyFile key ++ ".log" +locationLogFile key = hashDirLower def key ++ keyFile key ++ ".log" {- Converts a pathname into a key if it's a location log. -} locationLogFileKey :: FilePath -> Maybe Key @@ -102,13 +104,13 @@ locationLogFileKey path {- The filename of the url log for a given key. -} urlLogFile :: Key -> FilePath -urlLogFile key = hashDirLower key </> keyFile key ++ urlLogExt +urlLogFile key = hashDirLower def key </> keyFile key ++ urlLogExt {- Old versions stored the urls elsewhere. -} oldurlLogs :: Key -> [FilePath] oldurlLogs key = - [ "remote/web" </> hashDirLower key </> key2file key ++ ".log" - , "remote/web" </> hashDirLower key </> keyFile key ++ ".log" + [ "remote/web" </> hashDirLower def key </> key2file key ++ ".log" + , "remote/web" </> hashDirLower def key </> keyFile key ++ ".log" ] urlLogExt :: String @@ -131,7 +133,7 @@ isUrlLog file = urlLogExt `isSuffixOf` file {- The filename of the remote state log for a given key. -} remoteStateLogFile :: Key -> FilePath -remoteStateLogFile key = hashDirLower key </> keyFile key ++ remoteStateLogExt +remoteStateLogFile key = hashDirLower def key </> keyFile key ++ remoteStateLogExt remoteStateLogExt :: String remoteStateLogExt = ".log.rmt" @@ -141,7 +143,7 @@ isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path {- The filename of the chunk log for a given key. -} chunkLogFile :: Key -> FilePath -chunkLogFile key = hashDirLower key </> keyFile key ++ chunkLogExt +chunkLogFile key = hashDirLower def key </> keyFile key ++ chunkLogExt chunkLogFileKey :: FilePath -> Maybe Key chunkLogFileKey path @@ -160,7 +162,7 @@ isChunkLog path = chunkLogExt `isSuffixOf` path {- The filename of the metadata log for a given key. -} metaDataLogFile :: Key -> FilePath -metaDataLogFile key = hashDirLower key </> keyFile key ++ metaDataLogExt +metaDataLogFile key = hashDirLower def key </> keyFile key ++ metaDataLogExt metaDataLogExt :: String metaDataLogExt = ".log.met" diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 2b887a82f..2eeb79317 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -15,6 +15,7 @@ module Remote.Directory ( import qualified Data.ByteString.Lazy as L import qualified Data.Map as M +import Data.Default import Common.Annex import Types.Remote @@ -107,7 +108,7 @@ getLocation d k = do {- Directory where the file(s) for a key are stored. -} storeDir :: FilePath -> Key -> FilePath -storeDir d k = addTrailingPathSeparator $ d </> hashDirLower k </> keyFile k +storeDir d k = addTrailingPathSeparator $ d </> hashDirLower def k </> keyFile k {- Where we store temporary data for a key, in the directory, as it's being - written. -} diff --git a/Remote/External.hs b/Remote/External.hs index 0ec284ff4..b660c4f1b 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -28,6 +28,7 @@ import Creds import Control.Concurrent.STM import System.Log.Logger (debugM) import qualified Data.Map as M +import Data.Default remote :: RemoteType remote = RemoteType { @@ -184,7 +185,7 @@ handleRequest' lck external req mp responsehandler handleRemoteRequest (PROGRESS bytesprocessed) = maybe noop (\a -> liftIO $ a bytesprocessed) mp handleRemoteRequest (DIRHASH k) = - send $ VALUE $ hashDirMixed k + send $ VALUE $ hashDirMixed def k handleRemoteRequest (SETCONFIG setting value) = liftIO $ atomically $ do let v = externalConfig external diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index b977750c3..aed54d20f 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -16,6 +16,7 @@ module Remote.GCrypt ( import qualified Data.Map as M import qualified Data.ByteString.Lazy as L import Control.Exception +import Data.Default import Common.Annex import Types.Remote @@ -361,7 +362,7 @@ checkKey r rsyncopts k {- Annexed objects are hashed using lower-case directories for max - portability. -} gCryptLocation :: Remote -> Key -> FilePath -gCryptLocation r key = Git.repoLocation (repo r) </> objectDir </> keyPath key hashDirLower +gCryptLocation r key = Git.repoLocation (repo r) </> objectDir </> keyPath key (hashDirLower def) data AccessMethod = AccessDirect | AccessShell diff --git a/Remote/Hook.hs b/Remote/Hook.hs index ce7781cfb..31b5ab7c5 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -7,8 +7,6 @@ module Remote.Hook (remote) where -import qualified Data.Map as M - import Common.Annex import Types.Remote import Types.Key @@ -20,6 +18,9 @@ import Annex.UUID import Remote.Helper.Special import Utility.Env +import Data.Default +import qualified Data.Map as M + type Action = String type HookName = String @@ -90,7 +91,7 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv) ] fileenv Nothing = [] fileenv (Just file) = [envvar "FILE" file] - hashbits = map takeDirectory $ splitPath $ hashDirMixed k + hashbits = map takeDirectory $ splitPath $ hashDirMixed def k lookupHook :: HookName -> Action -> Annex (Maybe String) lookupHook hookname action = do diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index ae6f5450e..527bfb80a 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -38,6 +38,7 @@ import Logs.Transfer import Types.Creds import Types.Key (isChunkKey) +import Data.Default import qualified Data.Map as M remote :: RemoteType @@ -212,7 +213,7 @@ remove o k = do - content could be. Note that the parent directories have - to also be explicitly included, due to how rsync - traverses directories. -} - includes = concatMap use annexHashes + includes = concatMap use (annexHashes def) use h = let dir = h k in [ parentDir dir , dir diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs index 7ebd2f68d..5493e4e90 100644 --- a/Remote/Rsync/RsyncUrl.hs +++ b/Remote/Rsync/RsyncUrl.hs @@ -14,6 +14,7 @@ import Locations import Utility.Rsync import Utility.SafeCommand +import Data.Default import System.FilePath.Posix #ifdef mingw32_HOST_OS import Data.String.Utils @@ -35,7 +36,7 @@ rsyncEscape o u | otherwise = u rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] -rsyncUrls o k = map use annexHashes +rsyncUrls o k = map use (annexHashes def) where use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f) f = keyFile k diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs index b5d374943..157e7151a 100644 --- a/Remote/WebDAV/DavLocation.hs +++ b/Remote/WebDAV/DavLocation.hs @@ -17,6 +17,7 @@ import Utility.Url (URLString) import System.FilePath.Posix -- for manipulating url paths import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT) import Control.Monad.IO.Class (MonadIO) +import Data.Default #ifdef mingw32_HOST_OS import Data.String.Utils #endif @@ -33,9 +34,9 @@ keyDir :: Key -> DavLocation keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k where #ifndef mingw32_HOST_OS - hashdir = hashDirLower k + hashdir = hashDirLower def k #else - hashdir = replace "\\" "/" (hashDirLower k) + hashdir = replace "\\" "/" (hashDirLower def k) #endif keyLocation :: Key -> DavLocation diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index e8a7efe13..801cdafa0 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -9,6 +9,7 @@ module Upgrade.V1 where import System.Posix.Types import Data.Char +import Data.Default import Common.Annex import Types.Key @@ -228,7 +229,7 @@ logFile1 :: Git.Repo -> Key -> String logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log" logFile2 :: Key -> Git.Repo -> String -logFile2 = logFile' hashDirLower +logFile2 = logFile' (hashDirLower def) logFile' :: (Key -> FilePath) -> Key -> Git.Repo -> String logFile' hasher key repo = |