groundwork for parameterizing hash depth

This commit is contained in:
Joey Hess 2015-01-28 15:55:17 -04:00
parent 037d86e046
commit 0fd5f257d0
11 changed files with 52 additions and 32 deletions

View file

@ -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. -}

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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