diff options
| -rw-r--r-- | LocationLog.hs | 23 | ||||
| -rw-r--r-- | Locations.hs | 33 | ||||
| -rw-r--r-- | Remote/Directory.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 9 | ||||
| -rw-r--r-- | doc/internals.mdwn | 2 |
5 files changed, 43 insertions, 26 deletions
diff --git a/LocationLog.hs b/LocationLog.hs index d989cad61..8a47db2da 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -23,7 +23,6 @@ module LocationLog ( LogStatus(..), logChange, - logFile, readLog, writeLog, keyLocations @@ -33,7 +32,6 @@ import Data.Time.Clock.POSIX import Data.Time import System.Locale import qualified Data.Map as Map -import System.Directory import Control.Monad (when) import qualified GitRepo as Git @@ -93,22 +91,16 @@ logChange repo key u s = do error $ "unknown UUID for " ++ Git.repoDescribe repo ++ " (have you run git annex init there?)" line <- logNow s u - ls <- readLog logfile - writeLog logfile (compactLog $ line:ls) - return logfile - where - logfile = logFile repo key + let f = logFile repo key + ls' <- readLog $ logFileOld repo key + ls <- readLog f + writeLog f (compactLog $ line:ls'++ls) + return f {- Reads a log file. - Note that the LogLines returned may be in any order. -} readLog :: FilePath -> IO [LogLine] -readLog file = do - exists <- doesFileExist file - if exists - then do - s <- readFile file - return $ parseLog s - else return [] +readLog file = catch (return . parseLog =<< readFile file) (const $ return []) parseLog :: String -> [LogLine] parseLog s = filter parsable $ map read $ lines s @@ -131,7 +123,8 @@ logNow s u = do keyLocations :: Git.Repo -> Key -> IO [UUID] keyLocations thisrepo key = do ls <- readLog $ logFile thisrepo key - return $ map uuid $ filterPresent ls + ls' <- readLog $ logFileOld thisrepo key + return $ map uuid $ filterPresent $ ls'++ls {- Filters the list of LogLines to find ones where the value - is (or should still be) present. -} diff --git a/Locations.hs b/Locations.hs index 8e10c36b4..6c413a218 100644 --- a/Locations.hs +++ b/Locations.hs @@ -20,7 +20,8 @@ module Locations ( gitAnnexUnusedLog, isLinkToAnnex, logFile, - hashDir, + logFileOld, + hashDirMixed, prop_idempotent_fileKey ) where @@ -68,7 +69,7 @@ objectDir = addTrailingPathSeparator $ annexDir </> "objects" {- Annexed file's location relative to the .git directory. -} annexLocation :: Key -> FilePath -annexLocation key = objectDir </> hashDir key </> f </> f +annexLocation key = objectDir </> hashDirMixed key </> f </> f where f = keyFile key @@ -113,8 +114,18 @@ isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s {- The filename of the log file for a given key. -} logFile :: Git.Repo -> Key -> String -logFile repo key = - gitStateDir repo ++ hashDir key ++ keyFile key ++ ".log" +logFile = logFile' hashDirLower + +{- The old filename of the log file for a key. These can have mixed + - case, which turned out to be a bad idea for directories whose contents + - are checked into git. There was no conversion, so these have to be checked + - for and merged in at runtime. -} +logFileOld :: Git.Repo -> Key -> String +logFileOld = logFile' hashDirMixed + +logFile' :: (Key -> FilePath) -> Git.Repo -> Key -> String +logFile' hasher repo key = + gitStateDir repo ++ hasher key ++ keyFile key ++ ".log" {- Converts a key into a filename fragment. - @@ -147,13 +158,17 @@ prop_idempotent_fileKey s = Just k == fileKey (keyFile k) {- Given a key, generates a short directory name to put it in, - to do hashing to protect against filesystems that dislike having - many items in a single directory. -} -hashDir :: Key -> FilePath -hashDir k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir +hashDirMixed :: Key -> FilePath +hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir where - dir = take 4 $ abcd_to_dir $ md5 $ Str $ show k + dir = take 4 $ concat $ map display_32bits_as_dir [a,b,c,d] + ABCD (a,b,c,d) = md5 $ Str $ show k -abcd_to_dir :: ABCD -> String -abcd_to_dir (ABCD (a,b,c,d)) = concat $ map display_32bits_as_dir [a,b,c,d] +{- Generates a hash directory that is all lower case. -} +hashDirLower :: Key -> FilePath +hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir + where + dir = take 6 $ md5s $ Str $ show k {- modified version of display_32bits_as_hex from Data.Hash.MD5 - Copyright (C) 2001 Ian Lynagh diff --git a/Remote/Directory.hs b/Remote/Directory.hs index f97449eaa..0d3478b79 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -66,7 +66,7 @@ directorySetup u c = do return $ M.delete "directory" c dirKey :: FilePath -> Key -> FilePath -dirKey d k = d </> hashDir k </> f </> f +dirKey d k = d </> hashDirMixed k </> f </> f where f = keyFile k diff --git a/debian/changelog b/debian/changelog index 6d56eeb46..29f60063e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +git-annex (0.20110402) UNRELEASED; urgency=low + + * Use lowercase hash directories for locationlog files, to avoid + some issues with git on OSX with the mixed-case directories. + No migration is needed; the old mixed case hash directories are still + read; new information is written to the new directories. + + -- Joey Hess <joeyh@debian.org> Sat, 02 Apr 2011 13:45:54 -0400 + git-annex (0.20110401) experimental; urgency=low * Amazon S3 is now supported as a special type of remote. diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 2e9f25383..b362e68e1 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -53,7 +53,7 @@ Example: e605dca6-446a-11e0-8b2a-002170d25c55 1 26339d22-446b-11e0-9101-002170d25c55 ? -## `.git-annex/aa/bb/*.log` +## `.git-annex/aaa/bbb/*.log` The remainder of the log files record [[location_tracking]] information for file contents. Again these are placed in two levels of subdirectories |