diff options
| -rw-r--r-- | Annex/CatFile.hs | 20 | ||||
| -rw-r--r-- | Annex/Init.hs | 2 | ||||
| -rw-r--r-- | Annex/Link.hs | 36 | ||||
| -rw-r--r-- | Backend.hs | 1 | ||||
| -rw-r--r-- | Command/Smudge.hs | 20 |
5 files changed, 44 insertions, 35 deletions
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 7c0022ca5..aefccd424 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -14,7 +14,6 @@ module Annex.CatFile ( catFileHandle, catFileStop, catKey, - parsePointer, catKeyFile, catKeyFileHEAD, catSymLinkTarget, @@ -31,7 +30,7 @@ import qualified Annex import Git.Types import Git.FilePath import qualified Git.Ref -import Types.Key +import Annex.Link catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do @@ -83,22 +82,7 @@ catFileStop = do {- From ref to a symlink or a pointer file, get the key. -} catKey :: Ref -> Annex (Maybe Key) -catKey ref = parsePointer . fromInternalGitPath . decodeBS . L.take maxsz - <$> catObject ref - where - -- Want to avoid buffering really big files in git into memory. - -- 8192 bytes is plenty for a pointer to a key. - -- Pad some more to allow for any pointer files that might have - -- lines after the key explaining what the file is used for. - maxsz = 81920 - -{- Only look at the first line of a pointer file. -} -parsePointer :: String -> Maybe Key -parsePointer s = headMaybe (lines s) >>= go - where - go l - | isLinkToAnnex l = file2key $ takeFileName l - | otherwise = Nothing +catKey ref = parseLinkOrPointer <$> catObject ref {- Gets a symlink target. -} catSymLinkTarget :: Sha -> Annex String diff --git a/Annex/Init.hs b/Annex/Init.hs index b00e41218..7eea0dfa1 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -29,11 +29,11 @@ import Types.TrustLevel import Annex.Version import Annex.Difference import Annex.UUID +import Annex.Link import Config import Annex.Direct import Annex.Content.Direct import Annex.Environment -import Backend import Annex.Hook import Upgrade #ifndef mingw32_HOST_OS diff --git a/Annex/Link.hs b/Annex/Link.hs index 98b200f0a..f405403f2 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -5,7 +5,9 @@ - On other filesystems, git instead stores the symlink target in a regular - file. - - - Copyright 2013 Joey Hess <id@joeyh.name> + - Pointer files are used instead of symlinks for unlocked files. + - + - Copyright 2013-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -19,6 +21,9 @@ import qualified Git.UpdateIndex import qualified Annex.Queue import Git.Types import Git.FilePath +import Types.Key + +import qualified Data.ByteString.Lazy as L type LinkTarget = String @@ -110,3 +115,32 @@ stageSymlink :: FilePath -> Sha -> Annex () stageSymlink file sha = Annex.Queue.addUpdateIndex =<< inRepo (Git.UpdateIndex.stageSymlink file sha) + +{- Parses a symlink target or a pointer file to a Key. + - Only looks at the first line, as pointer files can have subsequent + - lines. -} +parseLinkOrPointer :: L.ByteString -> Maybe Key +parseLinkOrPointer = parseLinkOrPointer' . decodeBS . L.take maxsz + where + {- Want to avoid buffering really big files in git into + - memory when reading files that may be pointers. + - + - 8192 bytes is plenty for a pointer to a key. + - Pad some more to allow for any pointer files that might have + - lines after the key explaining what the file is used for. -} + maxsz = 81920 + +parseLinkOrPointer' :: String -> Maybe Key +parseLinkOrPointer' s = headMaybe (lines (fromInternalGitPath s)) >>= go + where + go l + | isLinkToAnnex l = file2key $ takeFileName l + | otherwise = Nothing + +formatPointer :: Key -> String +formatPointer k = toInternalGitPath $ pathSeparator:objectDir </> key2file k + +{- Checks if a file is a pointer to a key. -} +isPointerFile :: FilePath -> Annex (Maybe Key) +isPointerFile f = liftIO $ catchDefaultIO Nothing $ + parseLinkOrPointer <$> L.readFile f diff --git a/Backend.hs b/Backend.hs index 28f83c7e0..d37eed34a 100644 --- a/Backend.hs +++ b/Backend.hs @@ -11,7 +11,6 @@ module Backend ( genKey, lookupFile, getBackend, - isAnnexLink, chooseBackend, lookupBackendName, maybeLookupBackendName, diff --git a/Command/Smudge.hs b/Command/Smudge.hs index e08afed6b..f9f819bec 100644 --- a/Command/Smudge.hs +++ b/Command/Smudge.hs @@ -9,16 +9,14 @@ module Command.Smudge where import Common.Annex import Command -import Types.Key import Annex.Content -import Annex.CatFile +import Annex.Link import Annex.MetaData import Annex.FileMatcher import Types.KeySource import Backend import Logs.Location import qualified Database.AssociatedFiles as AssociatedFiles -import Git.FilePath import qualified Data.ByteString.Lazy as B @@ -46,16 +44,13 @@ seek o = commandAction $ -- available annex object, should output its content. smudge :: FilePath -> CommandStart smudge file = do - liftIO $ fileEncoding stdin - s <- liftIO $ hGetContents stdin - case parsePointer s of - Nothing -> liftIO $ putStr s + b <- liftIO $ B.hGetContents stdin + case parseLinkOrPointer b of + Nothing -> liftIO $ B.putStr b Just k -> do updateAssociatedFiles k file content <- calcRepo (gitAnnexLocation k) - liftIO $ maybe - (putStr s) - (B.hPut stdout) + liftIO $ B.hPut stdout . fromMaybe b =<< catchMaybeIO (B.readFile content) stop @@ -102,11 +97,8 @@ ingest file = do =<< liftIO (getFileStatus file) return k --- Could add a newline and some text explaining this file is a pointer. --- parsePointer only looks at the first line. emitPointer :: Key -> IO () -emitPointer k = putStrLn $ toInternalGitPath $ - pathSeparator:objectDir </> key2file k +emitPointer = putStrLn . formatPointer updateAssociatedFiles :: Key -> FilePath -> Annex () updateAssociatedFiles k f = do |