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.
This commit is contained in:
Joey Hess 2011-04-02 13:49:03 -04:00
parent 66ab18325e
commit 616e6f8a84
5 changed files with 43 additions and 26 deletions

View file

@ -23,7 +23,6 @@
module LocationLog ( module LocationLog (
LogStatus(..), LogStatus(..),
logChange, logChange,
logFile,
readLog, readLog,
writeLog, writeLog,
keyLocations keyLocations
@ -33,7 +32,6 @@ import Data.Time.Clock.POSIX
import Data.Time import Data.Time
import System.Locale import System.Locale
import qualified Data.Map as Map import qualified Data.Map as Map
import System.Directory
import Control.Monad (when) import Control.Monad (when)
import qualified GitRepo as Git import qualified GitRepo as Git
@ -93,22 +91,16 @@ logChange repo key u s = do
error $ "unknown UUID for " ++ Git.repoDescribe repo ++ error $ "unknown UUID for " ++ Git.repoDescribe repo ++
" (have you run git annex init there?)" " (have you run git annex init there?)"
line <- logNow s u line <- logNow s u
ls <- readLog logfile let f = logFile repo key
writeLog logfile (compactLog $ line:ls) ls' <- readLog $ logFileOld repo key
return logfile ls <- readLog f
where writeLog f (compactLog $ line:ls'++ls)
logfile = logFile repo key return f
{- Reads a log file. {- Reads a log file.
- Note that the LogLines returned may be in any order. -} - Note that the LogLines returned may be in any order. -}
readLog :: FilePath -> IO [LogLine] readLog :: FilePath -> IO [LogLine]
readLog file = do readLog file = catch (return . parseLog =<< readFile file) (const $ return [])
exists <- doesFileExist file
if exists
then do
s <- readFile file
return $ parseLog s
else return []
parseLog :: String -> [LogLine] parseLog :: String -> [LogLine]
parseLog s = filter parsable $ map read $ lines s parseLog s = filter parsable $ map read $ lines s
@ -131,7 +123,8 @@ logNow s u = do
keyLocations :: Git.Repo -> Key -> IO [UUID] keyLocations :: Git.Repo -> Key -> IO [UUID]
keyLocations thisrepo key = do keyLocations thisrepo key = do
ls <- readLog $ logFile thisrepo key 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 {- Filters the list of LogLines to find ones where the value
- is (or should still be) present. -} - is (or should still be) present. -}

View file

@ -20,7 +20,8 @@ module Locations (
gitAnnexUnusedLog, gitAnnexUnusedLog,
isLinkToAnnex, isLinkToAnnex,
logFile, logFile,
hashDir, logFileOld,
hashDirMixed,
prop_idempotent_fileKey prop_idempotent_fileKey
) where ) where
@ -68,7 +69,7 @@ objectDir = addTrailingPathSeparator $ annexDir </> "objects"
{- Annexed file's location relative to the .git directory. -} {- Annexed file's location relative to the .git directory. -}
annexLocation :: Key -> FilePath annexLocation :: Key -> FilePath
annexLocation key = objectDir </> hashDir key </> f </> f annexLocation key = objectDir </> hashDirMixed key </> f </> f
where where
f = keyFile key f = keyFile key
@ -113,8 +114,18 @@ isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
{- The filename of the log file for a given key. -} {- The filename of the log file for a given key. -}
logFile :: Git.Repo -> Key -> String logFile :: Git.Repo -> Key -> String
logFile repo key = logFile = logFile' hashDirLower
gitStateDir repo ++ hashDir key ++ keyFile key ++ ".log"
{- 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. {- 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, {- Given a key, generates a short directory name to put it in,
- to do hashing to protect against filesystems that dislike having - to do hashing to protect against filesystems that dislike having
- many items in a single directory. -} - many items in a single directory. -}
hashDir :: Key -> FilePath hashDirMixed :: Key -> FilePath
hashDir k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir
where 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 {- Generates a hash directory that is all lower case. -}
abcd_to_dir (ABCD (a,b,c,d)) = concat $ map display_32bits_as_dir [a,b,c,d] 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 {- modified version of display_32bits_as_hex from Data.Hash.MD5
- Copyright (C) 2001 Ian Lynagh - Copyright (C) 2001 Ian Lynagh

View file

@ -66,7 +66,7 @@ directorySetup u c = do
return $ M.delete "directory" c return $ M.delete "directory" c
dirKey :: FilePath -> Key -> FilePath dirKey :: FilePath -> Key -> FilePath
dirKey d k = d </> hashDir k </> f </> f dirKey d k = d </> hashDirMixed k </> f </> f
where where
f = keyFile k f = keyFile k

9
debian/changelog vendored
View file

@ -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 git-annex (0.20110401) experimental; urgency=low
* Amazon S3 is now supported as a special type of remote. * Amazon S3 is now supported as a special type of remote.

View file

@ -53,7 +53,7 @@ Example:
e605dca6-446a-11e0-8b2a-002170d25c55 1 e605dca6-446a-11e0-8b2a-002170d25c55 1
26339d22-446b-11e0-9101-002170d25c55 ? 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 The remainder of the log files record [[location_tracking]] information
for file contents. Again these are placed in two levels of subdirectories for file contents. Again these are placed in two levels of subdirectories