summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
Diffstat (limited to 'Annex')
-rw-r--r--Annex/CatFile.hs5
-rw-r--r--Annex/Content.hs9
-rw-r--r--Annex/Content/Direct.hs45
-rw-r--r--Annex/Direct.hs105
4 files changed, 138 insertions, 26 deletions
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 88c498d31..cde9d5170 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -9,6 +9,7 @@ module Annex.CatFile (
catFile,
catObject,
catObjectDetails,
+ catKey,
catFileHandle
) where
@@ -42,3 +43,7 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle
h <- inRepo Git.CatFile.catFileStart
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
return h
+
+{- From the Sha of a symlink back to the key. -}
+catKey :: Sha -> Annex (Maybe Key)
+catKey sha = fileKey . takeFileName . encodeW8 . L.unpack <$> catObject sha
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 61f521bd1..980321721 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -10,7 +10,6 @@ module Annex.Content (
inAnnexSafe,
lockContent,
calcGitLink,
- logStatus,
getViaTmp,
getViaTmpUnchecked,
withTmp,
@@ -33,7 +32,6 @@ import System.IO.Unsafe (unsafeInterleaveIO)
import Common.Annex
import Logs.Location
-import Annex.UUID
import qualified Git
import qualified Git.Config
import qualified Annex
@@ -132,13 +130,6 @@ calcGitLink file key = do
where
whoops = error $ "unable to normalize " ++ file
-{- Updates the Logs.Location when a key's presence changes in the current
- - repository. -}
-logStatus :: Key -> LogStatus -> Annex ()
-logStatus key status = do
- u <- getUUID
- logChange key u status
-
{- Runs an action, passing it a temporary filename to get,
- and if the action succeeds, moves the temp file into
- the annex as a key's content. -}
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index f481030ba..f6a564bf0 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -7,13 +7,18 @@
module Annex.Content.Direct (
associatedFiles,
- changeAssociatedFiles,
+ removeAssociatedFile,
+ addAssociatedFile,
updateAssociatedFiles,
goodContent,
updateCache,
recordedCache,
compareCache,
- removeCache
+ writeCache,
+ removeCache,
+ genCache,
+ toCache,
+ Cache
) where
import Common.Annex
@@ -23,9 +28,9 @@ import Git.Sha
import Annex.CatFile
import Utility.TempFile
import Utility.FileMode
+import Logs.Location
import System.Posix.Types
-import qualified Data.ByteString.Lazy as L
{- Files in the tree that are associated with a key. -}
associatedFiles :: Key -> Annex [FilePath]
@@ -42,19 +47,24 @@ associatedFilesRelative key = do
liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
{- Changes the associated files information for a key, applying a
- - transformation to the list. -}
-changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex ()
+ - transformation to the list. Returns a copy of the new info. -}
+changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
changeAssociatedFiles key transform = do
mapping <- inRepo $ gitAnnexMapping key
files <- associatedFilesRelative key
let files' = transform files
when (files /= files') $
liftIO $ viaTmp writeFile mapping $ unlines files'
+ return files'
-removeAssociatedFile :: Key -> FilePath -> Annex ()
-removeAssociatedFile key file = changeAssociatedFiles key $ filter (/= file)
+removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
+removeAssociatedFile key file = do
+ fs <- changeAssociatedFiles key $ filter (/= file)
+ when (null fs) $
+ logStatus key InfoMissing
+ return fs
-addAssociatedFile :: Key -> FilePath -> Annex ()
+addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
addAssociatedFile key file = changeAssociatedFiles key $ \files ->
if file `elem` files
then files
@@ -74,10 +84,8 @@ updateAssociatedFiles oldsha newsha = do
where
go getsha getmode a =
when (getsha item /= nullSha && isSymLink (getmode item)) $ do
- key <- getkey $ getsha item
- maybe noop (\k -> a k $ DiffTree.file item) key
- getkey sha = fileKey . takeFileName . encodeW8 . L.unpack
- <$> catObject sha
+ key <- catKey (getsha item)
+ maybe noop (\k -> void $ a k $ DiffTree.file item) key
{- Checks if a file in the tree, associated with a key, has not been modified.
-
@@ -103,10 +111,13 @@ compareCache file old = do
{- Stores a cache of attributes for a file that is associated with a key. -}
updateCache :: Key -> FilePath -> Annex ()
-updateCache key file = do
- withCacheFile key $ \cachefile -> do
- createDirectoryIfMissing True (parentDir cachefile)
- maybe noop (writeFile cachefile . showCache) =<< genCache file
+updateCache key file = maybe noop (writeCache key) =<< liftIO (genCache file)
+
+{- Writes a cache for a key. -}
+writeCache :: Key -> Cache -> Annex ()
+writeCache key cache = withCacheFile key $ \cachefile -> do
+ createDirectoryIfMissing True (parentDir cachefile)
+ writeFile cachefile $ showCache cache
{- Removes a cache. -}
removeCache :: Key -> Annex ()
@@ -115,7 +126,7 @@ removeCache key = withCacheFile key nukeFile
{- Cache a file's inode, size, and modification time to determine if it's
- been changed. -}
data Cache = Cache FileID FileOffset EpochTime
- deriving (Eq)
+ deriving (Eq, Show)
showCache :: Cache -> String
showCache (Cache inode size mtime) = unwords
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
new file mode 100644
index 000000000..12984687e
--- /dev/null
+++ b/Annex/Direct.hs
@@ -0,0 +1,105 @@
+{- git-annex direct mode
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Direct where
+
+import Common.Annex
+import qualified Git
+import qualified Git.LsFiles
+import qualified Git.UpdateIndex
+import qualified Git.HashObject
+import qualified Annex.Queue
+import Git.Types
+import Annex.CatFile
+import Logs.Location
+import Backend
+import Types.KeySource
+import Annex.Content
+import Annex.Content.Direct
+
+{- Uses git ls-files to find files that need to be committed, and stages
+ - them into the index. Returns True if some changes were staged. -}
+stageDirect :: Annex Bool
+stageDirect = do
+ Annex.Queue.flush
+ top <- fromRepo Git.repoPath
+ (l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top]
+ forM_ l go
+ void $ liftIO cleanup
+ staged <- Annex.Queue.size
+ Annex.Queue.flush
+ return $ staged /= 0
+ where
+ {- Determine what kind of modified or deleted file this is, as
+ - efficiently as we can, by getting any key that's associated
+ - with it in git, as well as its stat info. -}
+ go (file, Just sha) = do
+ mkey <- catKey sha
+ mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+ case (mkey, mstat, toCache =<< mstat) of
+ (Just key, _, Just cache) -> do
+ {- All direct mode files will show as
+ - modified, so compare the cache to see if
+ - it really was. -}
+ oldcache <- recordedCache key
+ when (oldcache /= Just cache) $
+ modifiedannexed file key cache
+ (Just key, Nothing, _) -> deletedannexed file key
+ (Nothing, Nothing, _) -> deletegit file
+ (_, Just _, _) -> addgit file
+ go (file, Nothing) = do
+ mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
+ case (mstat, toCache =<< mstat) of
+ (Nothing, _) -> noop
+ (Just stat, Just cache)
+ | isSymbolicLink stat -> addgit file
+ | otherwise -> void $ addDirect file cache
+ (Just stat, Nothing)
+ | isSymbolicLink stat -> addgit file
+ | otherwise -> noop
+
+ modifiedannexed file oldkey cache = do
+ void $ removeAssociatedFile oldkey file
+ void $ addDirect file cache
+
+ deletedannexed file key = do
+ void $ removeAssociatedFile key file
+ deletegit file
+
+ addgit file = Annex.Queue.addCommand "add" [Param "-f"] [file]
+
+ deletegit file = Annex.Queue.addCommand "rm" [Param "-f"] [file]
+
+{- Adds a file to the annex in direct mode. Can fail, if the file is
+ - modified or deleted while it's being added. -}
+addDirect :: FilePath -> Cache -> Annex Bool
+addDirect file cache = do
+ showStart "add" file
+ let source = KeySource
+ { keyFilename = file
+ , contentLocation = file
+ }
+ got =<< genKey source =<< chooseBackend file
+ where
+ got Nothing = do
+ showEndFail
+ return False
+ got (Just (key, _)) = ifM (compareCache file $ Just cache)
+ ( do
+ link <- calcGitLink file key
+ sha <- inRepo $ Git.HashObject.hashObject BlobObject link
+ Annex.Queue.addUpdateIndex =<<
+ inRepo (Git.UpdateIndex.stageSymlink file sha)
+ writeCache key cache
+ void $ addAssociatedFile key file
+ logStatus key InfoPresent
+ showEndOk
+ return True
+ , do
+ showEndFail
+ return False
+ )