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:
parent
66ab18325e
commit
616e6f8a84
5 changed files with 43 additions and 26 deletions
|
@ -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. -}
|
||||||
|
|
33
Locations.hs
33
Locations.hs
|
@ -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
|
||||||
|
|
|
@ -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
9
debian/changelog
vendored
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue