diff options
Diffstat (limited to 'Annex')
| -rw-r--r-- | Annex/CatFile.hs | 5 | ||||
| -rw-r--r-- | Annex/Content.hs | 9 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 45 | ||||
| -rw-r--r-- | Annex/Direct.hs | 105 |
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 + ) |