summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/CatFile.hs20
-rw-r--r--Annex/Init.hs2
-rw-r--r--Annex/Link.hs36
-rw-r--r--Backend.hs1
-rw-r--r--Command/Smudge.hs20
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