summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/Find.hs5
-rw-r--r--Locations.hs33
-rw-r--r--Logs.hs16
-rw-r--r--Remote/Directory.hs3
-rw-r--r--Remote/External.hs3
-rw-r--r--Remote/GCrypt.hs3
-rw-r--r--Remote/Hook.hs7
-rw-r--r--Remote/Rsync.hs3
-rw-r--r--Remote/Rsync/RsyncUrl.hs3
-rw-r--r--Remote/WebDAV/DavLocation.hs5
-rw-r--r--Upgrade/V1.hs3
11 files changed, 52 insertions, 32 deletions
diff --git a/Command/Find.hs b/Command/Find.hs
index a52d173841..55124d8387 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 ed09622306..1a9551b3bc 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
diff --git a/Logs.hs b/Logs.hs
index 8d8ae993b2..7e4a395337 100644
--- a/Logs.hs
+++ b/Logs.hs
@@ -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 2b887a82ff..2eeb793179 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 0ec284ff47..b660c4f1bb 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 b977750c36..aed54d20fc 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 ce7781cfba..31b5ab7c53 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 ae6f5450e0..527bfb80ac 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 7ebd2f68d2..5493e4e909 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 b5d3749430..157e7151a4 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 e8a7efe135..801cdafa0d 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 =
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-01 20:50:07 +0000