groundwork for parameterizing hash depth
This commit is contained in:
parent
037d86e046
commit
0fd5f257d0
11 changed files with 52 additions and 32 deletions
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue