summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/DirHashes.hs16
-rw-r--r--Command/Log.hs3
-rw-r--r--Logs.hs56
-rw-r--r--Logs/Chunk.hs8
-rw-r--r--Logs/Location.hs9
-rw-r--r--Logs/MetaData.hs20
-rw-r--r--Logs/RemoteState.hs10
-rw-r--r--Logs/Web.hs11
-rw-r--r--Test.hs2
-rw-r--r--Upgrade/V2.hs4
-rw-r--r--debian/changelog3
11 files changed, 78 insertions, 64 deletions
diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs
index 36998821b..b58b5a215 100644
--- a/Annex/DirHashes.hs
+++ b/Annex/DirHashes.hs
@@ -9,6 +9,8 @@ module Annex.DirHashes (
Hasher,
HashLevels(..),
objectHashLevels,
+ branchHashLevels,
+ branchHashDir,
dirHashes,
hashDirMixed,
hashDirLower,
@@ -33,11 +35,19 @@ instance Default HashLevels where
def = HashLevels 2
objectHashLevels :: GitConfig -> HashLevels
-objectHashLevels config
- | hasDifference (== OneLevelObjectHash) (annexDifferences config) =
- HashLevels 1
+objectHashLevels = configHashLevels OneLevelObjectHash
+
+branchHashLevels :: GitConfig -> HashLevels
+branchHashLevels = configHashLevels OneLevelBranchHash
+
+configHashLevels :: Difference -> GitConfig -> HashLevels
+configHashLevels d config
+ | hasDifference (== d) (annexDifferences config) = HashLevels 1
| otherwise = def
+branchHashDir :: GitConfig -> Key -> String
+branchHashDir config key = hashDirLower (branchHashLevels config) key
+
{- 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),
diff --git a/Command/Log.hs b/Command/Log.hs
index 7eaa48f70..7c48388c2 100644
--- a/Command/Log.hs
+++ b/Command/Log.hs
@@ -141,7 +141,8 @@ getLog :: Key -> [CommandParam] -> Annex [String]
getLog key os = do
top <- fromRepo Git.repoPath
p <- liftIO $ relPathCwdToFile top
- let logfile = p </> locationLogFile key
+ config <- Annex.getGitConfig
+ let logfile = p </> locationLogFile config key
inRepo $ pipeNullSplitZombie $
[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
, Param "--remove-empty"
diff --git a/Logs.hs b/Logs.hs
index b0f330e93..1f8cf9f9c 100644
--- a/Logs.hs
+++ b/Logs.hs
@@ -9,6 +9,7 @@ module Logs where
import Common.Annex
import Types.Key
+import Annex.DirHashes
{- There are several varieties of log file formats. -}
data LogVariety
@@ -87,8 +88,8 @@ differenceLog :: FilePath
differenceLog = "difference.log"
{- The pathname of the location log file for a given key. -}
-locationLogFile :: Key -> String
-locationLogFile key = hashDirLower def key ++ keyFile key ++ ".log"
+locationLogFile :: GitConfig -> Key -> String
+locationLogFile config key = branchHashDir config key </> keyFile key ++ ".log"
{- Converts a pathname into a key if it's a location log. -}
locationLogFileKey :: FilePath -> Maybe Key
@@ -101,15 +102,17 @@ locationLogFileKey path
(base, ext) = splitAt (length file - 4) file
{- The filename of the url log for a given key. -}
-urlLogFile :: Key -> FilePath
-urlLogFile key = hashDirLower def key </> keyFile key ++ urlLogExt
+urlLogFile :: GitConfig -> Key -> FilePath
+urlLogFile config key = branchHashDir config key </> keyFile key ++ urlLogExt
{- Old versions stored the urls elsewhere. -}
-oldurlLogs :: Key -> [FilePath]
-oldurlLogs key =
- [ "remote/web" </> hashDirLower def key </> key2file key ++ ".log"
- , "remote/web" </> hashDirLower def key </> keyFile key ++ ".log"
+oldurlLogs :: GitConfig -> Key -> [FilePath]
+oldurlLogs config key =
+ [ "remote/web" </> hdir </> key2file key ++ ".log"
+ , "remote/web" </> hdir </> keyFile key ++ ".log"
]
+ where
+ hdir = branchHashDir config key
urlLogExt :: String
urlLogExt = ".log.web"
@@ -130,8 +133,9 @@ isUrlLog :: FilePath -> Bool
isUrlLog file = urlLogExt `isSuffixOf` file
{- The filename of the remote state log for a given key. -}
-remoteStateLogFile :: Key -> FilePath
-remoteStateLogFile key = hashDirLower def key </> keyFile key ++ remoteStateLogExt
+remoteStateLogFile :: GitConfig -> Key -> FilePath
+remoteStateLogFile config key = branchHashDir config key
+ </> keyFile key ++ remoteStateLogExt
remoteStateLogExt :: String
remoteStateLogExt = ".log.rmt"
@@ -140,8 +144,8 @@ isRemoteStateLog :: FilePath -> Bool
isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path
{- The filename of the chunk log for a given key. -}
-chunkLogFile :: Key -> FilePath
-chunkLogFile key = hashDirLower def key </> keyFile key ++ chunkLogExt
+chunkLogFile :: GitConfig -> Key -> FilePath
+chunkLogFile config key = branchHashDir config key </> keyFile key ++ chunkLogExt
chunkLogFileKey :: FilePath -> Maybe Key
chunkLogFileKey path
@@ -159,35 +163,11 @@ isChunkLog :: FilePath -> Bool
isChunkLog path = chunkLogExt `isSuffixOf` path
{- The filename of the metadata log for a given key. -}
-metaDataLogFile :: Key -> FilePath
-metaDataLogFile key = hashDirLower def key </> keyFile key ++ metaDataLogExt
+metaDataLogFile :: GitConfig -> Key -> FilePath
+metaDataLogFile config key = branchHashDir config key </> keyFile key ++ metaDataLogExt
metaDataLogExt :: String
metaDataLogExt = ".log.met"
isMetaDataLog :: FilePath -> Bool
isMetaDataLog path = metaDataLogExt `isSuffixOf` path
-
-prop_logs_sane :: Key -> Bool
-prop_logs_sane dummykey = and
- [ isNothing (getLogVariety "unknown")
- , expect gotUUIDBasedLog (getLogVariety uuidLog)
- , expect gotPresenceLog (getLogVariety $ locationLogFile dummykey)
- , expect gotPresenceLog (getLogVariety $ urlLogFile dummykey)
- , expect gotNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)
- , expect gotChunkLog (getLogVariety $ chunkLogFile dummykey)
- , expect gotOtherLog (getLogVariety $ metaDataLogFile dummykey)
- , expect gotOtherLog (getLogVariety numcopiesLog)
- ]
- where
- expect = maybe False
- gotUUIDBasedLog UUIDBasedLog = True
- gotUUIDBasedLog _ = False
- gotNewUUIDBasedLog NewUUIDBasedLog = True
- gotNewUUIDBasedLog _ = False
- gotChunkLog (ChunkLog k) = k == dummykey
- gotChunkLog _ = False
- gotPresenceLog (PresenceLog k) = k == dummykey
- gotPresenceLog _ = False
- gotOtherLog OtherLog = True
- gotOtherLog _ = False
diff --git a/Logs/Chunk.hs b/Logs/Chunk.hs
index 8ca3ffed3..8f0e7cedb 100644
--- a/Logs/Chunk.hs
+++ b/Logs/Chunk.hs
@@ -29,6 +29,7 @@ import Logs
import Logs.MapLog
import qualified Annex.Branch
import Logs.Chunk.Pure
+import qualified Annex
import qualified Data.Map as M
import Data.Time.Clock.POSIX
@@ -36,14 +37,17 @@ import Data.Time.Clock.POSIX
chunksStored :: UUID -> Key -> ChunkMethod -> ChunkCount -> Annex ()
chunksStored u k chunkmethod chunkcount = do
ts <- liftIO getPOSIXTime
- Annex.Branch.change (chunkLogFile k) $
+ config <- Annex.getGitConfig
+ Annex.Branch.change (chunkLogFile config k) $
showLog . changeMapLog ts (u, chunkmethod) chunkcount . parseLog
chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex ()
chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0
getCurrentChunks :: UUID -> Key -> Annex [(ChunkMethod, ChunkCount)]
-getCurrentChunks u k = select . parseLog <$> Annex.Branch.get (chunkLogFile k)
+getCurrentChunks u k = do
+ config <- Annex.getGitConfig
+ select . parseLog <$> Annex.Branch.get (chunkLogFile config k)
where
select = filter (\(_m, ct) -> ct > 0)
. map (\((_ku, m), l) -> (m, value l))
diff --git a/Logs/Location.hs b/Logs/Location.hs
index d0109b848..7c6888c0b 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -29,6 +29,7 @@ import Logs
import Logs.Presence
import Annex.UUID
import Git.Types (RefDate)
+import qualified Annex
{- Log a change in the presence of a key's value in current repository. -}
logStatus :: Key -> LogStatus -> Annex ()
@@ -38,7 +39,9 @@ logStatus key s = do
{- Log a change in the presence of a key's value in a repository. -}
logChange :: Key -> UUID -> LogStatus -> Annex ()
-logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u
+logChange key (UUID u) s = do
+ config <- Annex.getGitConfig
+ addLog (locationLogFile config key) =<< logNow s u
logChange _ NoUUID _ = noop
{- Returns a list of repository UUIDs that, according to the log, have
@@ -51,7 +54,9 @@ loggedLocationsHistorical :: RefDate -> Key -> Annex [UUID]
loggedLocationsHistorical = getLoggedLocations . historicalLog
getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID]
-getLoggedLocations getter key = map toUUID <$> (getter . locationLogFile) key
+getLoggedLocations getter key = do
+ config <- Annex.getGitConfig
+ map toUUID <$> (getter . locationLogFile config) key
{- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -}
diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs
index 3091935cf..ed4e2363e 100644
--- a/Logs/MetaData.hs
+++ b/Logs/MetaData.hs
@@ -38,6 +38,7 @@ import Common.Annex
import Types.MetaData
import Annex.MetaData.StandardFields
import qualified Annex.Branch
+import qualified Annex
import Logs
import Logs.SingleValue
@@ -52,7 +53,9 @@ instance SingleValueSerializable MetaData where
deserialize = Types.MetaData.deserialize
getMetaDataLog :: Key -> Annex (Log MetaData)
-getMetaDataLog = readLog . metaDataLogFile
+getMetaDataLog key = do
+ config <- Annex.getGitConfig
+ readLog $ metaDataLogFile config key
{- Go through the log from oldest to newest, and combine it all
- into a single MetaData representing the current state.
@@ -97,10 +100,12 @@ addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime
addMetaData' :: Key -> MetaData -> POSIXTime -> Annex ()
addMetaData' k d@(MetaData m) now
| d == emptyMetaData = noop
- | otherwise = Annex.Branch.change (metaDataLogFile k) $
- showLog . simplifyLog
- . S.insert (LogEntry now metadata)
- . parseLog
+ | otherwise = do
+ config <- Annex.getGitConfig
+ Annex.Branch.change (metaDataLogFile config k) $
+ showLog . simplifyLog
+ . S.insert (LogEntry now metadata)
+ . parseLog
where
metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m
@@ -181,6 +186,7 @@ copyMetaData oldkey newkey
| oldkey == newkey = noop
| otherwise = do
l <- getMetaDataLog oldkey
- unless (S.null l) $
- Annex.Branch.change (metaDataLogFile newkey) $
+ unless (S.null l) $ do
+ config <- Annex.getGitConfig
+ Annex.Branch.change (metaDataLogFile config newkey) $
const $ showLog l
diff --git a/Logs/RemoteState.hs b/Logs/RemoteState.hs
index 7b3859a35..b302b739a 100644
--- a/Logs/RemoteState.hs
+++ b/Logs/RemoteState.hs
@@ -14,6 +14,7 @@ import Common.Annex
import Logs
import Logs.UUIDBased
import qualified Annex.Branch
+import qualified Annex
import qualified Data.Map as M
import Data.Time.Clock.POSIX
@@ -23,11 +24,14 @@ type RemoteState = String
setRemoteState :: UUID -> Key -> RemoteState -> Annex ()
setRemoteState u k s = do
ts <- liftIO getPOSIXTime
- Annex.Branch.change (remoteStateLogFile k) $
+ config <- Annex.getGitConfig
+ Annex.Branch.change (remoteStateLogFile config k) $
showLogNew id . changeLog ts u s . parseLogNew Just
getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState)
-getRemoteState u k = extract . parseLogNew Just
- <$> Annex.Branch.get (remoteStateLogFile k)
+getRemoteState u k = do
+ config <- Annex.getGitConfig
+ extract . parseLogNew Just
+ <$> Annex.Branch.get (remoteStateLogFile config k)
where
extract m = value <$> M.lookup u m
diff --git a/Logs/Web.hs b/Logs/Web.hs
index 4729cead4..38993c33c 100644
--- a/Logs/Web.hs
+++ b/Logs/Web.hs
@@ -37,7 +37,8 @@ import Utility.Url
{- Gets all urls that a key might be available from. -}
getUrls :: Key -> Annex [URLString]
getUrls key = do
- l <- go $ urlLogFile key : oldurlLogs key
+ config <- Annex.getGitConfig
+ l <- go $ urlLogFile config key : oldurlLogs config key
tmpl <- Annex.getState (maybeToList . M.lookup key . Annex.tempurls)
return (tmpl ++ l)
where
@@ -54,13 +55,15 @@ getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`) <$> getUrls key
setUrlPresent :: UUID -> Key -> URLString -> Annex ()
setUrlPresent uuid key url = do
us <- getUrls key
- unless (url `elem` us) $
- addLog (urlLogFile key) =<< logNow InfoPresent url
+ unless (url `elem` us) $ do
+ config <- Annex.getGitConfig
+ addLog (urlLogFile config key) =<< logNow InfoPresent url
logChange key uuid InfoPresent
setUrlMissing :: UUID -> Key -> URLString -> Annex ()
setUrlMissing uuid key url = do
- addLog (urlLogFile key) =<< logNow InfoMissing url
+ config <- Annex.getGitConfig
+ addLog (urlLogFile config key) =<< logNow InfoMissing url
whenM (null <$> getUrls key) $
logChange key uuid InfoMissing
diff --git a/Test.hs b/Test.hs
index 8d432cb61..633ef3690 100644
--- a/Test.hs
+++ b/Test.hs
@@ -38,7 +38,6 @@ import qualified Types.KeySource
import qualified Types.Backend
import qualified Types.TrustLevel
import qualified Types
-import qualified Logs
import qualified Logs.MapLog
import qualified Logs.Trust
import qualified Logs.Remote
@@ -138,7 +137,6 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
, testProperty "prop_idempotent_key_decode" Types.Key.prop_idempotent_key_decode
, testProperty "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape
, testProperty "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword
- , testProperty "prop_logs_sane" Logs.prop_logs_sane
, testProperty "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
, testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
, testProperty "prop_upFrom_basics" Utility.Path.prop_upFrom_basics
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index 2b0b277e8..0f09205ff 100644
--- a/Upgrade/V2.hs
+++ b/Upgrade/V2.hs
@@ -12,6 +12,7 @@ import qualified Git
import qualified Git.Command
import qualified Git.Ref
import qualified Annex.Branch
+import qualified Annex
import Annex.Content
import Utility.Tmp
import Logs
@@ -47,7 +48,8 @@ upgrade = do
e <- liftIO $ doesDirectoryExist old
when e $ do
- mapM_ (\(k, f) -> inject f $ locationLogFile k) =<< locationLogs
+ config <- Annex.getGitConfig
+ mapM_ (\(k, f) -> inject f $ locationLogFile config k) =<< locationLogs
mapM_ (\f -> inject f f) =<< logFiles old
saveState False
diff --git a/debian/changelog b/debian/changelog
index 8aa351fea..529d460c8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -26,7 +26,8 @@ git-annex (5.20150114) UNRELEASED; urgency=medium
http://git-annex.branchable.com/tuning/
* merge: Refuse to merge changes from a git-annex branch of a repo
that has been tuned in incompatable ways.
- * Support annex.tune.objecthash1 and annex.tune.objecthashlower.
+ * Support annex.tune.objecthash1, annex.tune.objecthashlower, and
+ annex.tune.branchhash1.
-- Joey Hess <id@joeyh.name> Tue, 13 Jan 2015 17:03:39 -0400
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-10 09:04:10 +0000