diff options
| -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 | ||||
| -rw-r--r-- | Backend.hs | 6 | ||||
| -rw-r--r-- | Command/Sync.hs | 26 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 20 | ||||
| -rw-r--r-- | Logs/Location.hs | 8 | ||||
| -rw-r--r-- | Remote.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 3 | ||||
| -rw-r--r-- | doc/direct_mode.mdwn | 11 |
11 files changed, 186 insertions, 54 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 + ) diff --git a/Backend.hs b/Backend.hs index b66e6130e..1e3d8f94f 100644 --- a/Backend.hs +++ b/Backend.hs @@ -52,8 +52,7 @@ orderedList = do parseBackendList s = map lookupBackendName $ words s {- Generates a key for a file, trying each backend in turn until one - - accepts it. - -} + - accepts it. -} genKey :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend)) genKey source trybackend = do bs <- orderedList @@ -94,8 +93,7 @@ lookupFile file = do return Nothing {- Looks up the backend that should be used for a file. - - That can be configured on a per-file basis in the gitattributes file. - -} + - That can be configured on a per-file basis in the gitattributes file. -} chooseBackend :: FilePath -> Annex (Maybe Backend) chooseBackend f = Annex.getState Annex.forcebackend >>= go where diff --git a/Command/Sync.hs b/Command/Sync.hs index cf402f0ca..7e3769864 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -16,6 +16,7 @@ import qualified Annex.Branch import qualified Annex.Queue import Annex.Content import Annex.Content.Direct +import Annex.Direct import Annex.CatFile import qualified Git.Command import qualified Git.LsFiles as LsFiles @@ -29,7 +30,6 @@ import qualified Remote.Git import Types.Key import Config -import qualified Data.ByteString.Lazy as L import Data.Hash.MD5 def :: [Command] @@ -79,14 +79,20 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) fastest = fromMaybe [] . headMaybe . Remote.byCost commit :: CommandStart -commit = do - showStart "commit" "" - next $ next $ do +commit = next $ next $ do + Annex.Branch.commit "update" + ifM isDirect + ( ifM stageDirect + ( runcommit [] , return True ) + , runcommit [Param "-a"] + ) + where + runcommit ps = do + showStart "commit" "" showOutput - Annex.Branch.commit "update" -- Commit will fail when the tree is clean, so ignore failure. - _ <- inRepo $ Git.Command.runBool "commit" - [Param "-a", Param "-m", Param "git-annex automatic sync"] + _ <- inRepo $ Git.Command.runBool "commit" $ ps ++ + [Param "-m", Param "git-annex automatic sync"] return True mergeLocal :: Git.Ref -> CommandStart @@ -136,7 +142,7 @@ mergeRemote remote b = case b of Nothing -> do branch <- inRepo Git.Branch.currentUnsafe all id <$> (mapM merge $ branchlist branch) - Just branch -> all id <$> (mapM merge =<< tomerge (branchlist b)) + Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b)) where merge = mergeFrom . remoteBranch remote tomerge branches = filterM (changed remote) branches @@ -259,9 +265,7 @@ resolveMerge' u case msha of Nothing -> a Nothing Just sha -> do - key <- fileKey . takeFileName - . encodeW8 . L.unpack - <$> catObject sha + key <- catKey sha maybe (return False) (a . Just) key {- The filename to use when resolving a conflicted merge of a file, diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index e264dee8b..45c830cd6 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -10,7 +10,7 @@ module Git.LsFiles ( notInRepo, staged, stagedNotDeleted, - notStaged, + stagedDetails, typeChanged, typeChangedStaged, Conflicting(..), @@ -53,13 +53,21 @@ staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix prefix = [Params "diff --cached --name-only -z"] suffix = Param "--" : map File l -{- Returns a list of all files that have unstaged changes. This includes - - any new files, that have not been added yet. -} -notStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) -notStaged l repo = pipeNullSplit params repo +{- Returns details about files that are staged in the index + - (including the Sha of their staged contents), + - as well as files not yet in git. -} +stagedDetails :: [FilePath] -> Repo -> IO ([(FilePath, Maybe Sha)], IO Bool) +stagedDetails l repo = do + (ls, cleanup) <- pipeNullSplit params repo + return (map parse ls, cleanup) where - params = [Params "ls-files --others --deleted --modified --exclude-standard -z --"] ++ + params = [Params "ls-files --others --exclude-standard --stage -z --"] ++ map File l + parse s + | null file = (s, Nothing) + | otherwise = (file, extractSha $ take shaSize $ drop 7 metadata) + where + (metadata, file) = separate (== '\t') s {- Returns a list of the files in the specified locations that are staged - for commit, and whose type has changed. -} diff --git a/Logs/Location.hs b/Logs/Location.hs index 4273710fc..0f57b6663 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -15,6 +15,7 @@ module Logs.Location ( LogStatus(..), + logStatus, logChange, loggedLocations, loggedKeys, @@ -26,6 +27,13 @@ module Logs.Location ( import Common.Annex import qualified Annex.Branch import Logs.Presence +import Annex.UUID + +{- Log a change in the presence of a key's value in current repository. -} +logStatus :: Key -> LogStatus -> Annex () +logStatus key status = do + u <- getUUID + logChange key u status {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () @@ -51,7 +51,7 @@ import qualified Annex import Annex.UUID import Logs.UUID import Logs.Trust -import Logs.Location +import Logs.Location hiding (logStatus) import Remote.List import qualified Git diff --git a/Remote/Git.hs b/Remote/Git.hs index a333a707b..952fbf29f 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -37,6 +37,7 @@ import Config import Init import Types.Key import qualified Fields +import Logs.Location import Control.Concurrent import Control.Concurrent.MSampleVar @@ -243,7 +244,7 @@ dropKey r key whenM (Annex.Content.inAnnex key) $ do Annex.Content.lockContent key $ Annex.Content.removeAnnex key - Annex.Content.logStatus key InfoMissing + logStatus key InfoMissing Annex.Content.saveState True return True | Git.repoIsHttp r = error "dropping from http repo not supported" diff --git a/doc/direct_mode.mdwn b/doc/direct_mode.mdwn index 552725249..095f15d5a 100644 --- a/doc/direct_mode.mdwn +++ b/doc/direct_mode.mdwn @@ -20,11 +20,9 @@ deleted or modified at any time). To do so: `git annex untrust .` ## use a direct mode repository -You can use `git annex add` to add files to your direct mode repository. - -The main command that's supported in direct mode repositories is -`git annex sync`. This automatically commits all changed files to git, -pushes them out, pulls down any changes, etc. +The main command that's used in direct mode repositories is +`git annex sync`. This automatically adds new files, commits all +changed files to git, pushes them out, pulls down any changes, etc. You can also run `git annex get` to transfer the content of files into your direct mode repository. Or if the direct mode repository is a remote of @@ -39,6 +37,9 @@ You can use `git log` and other git query commands. ## what doesn't work in direct mode +Don't use `git annex add` -- it thinks all direct mode files are unlocked, +and locks them. + In general git-annex commands will only work in direct mode repositories on files whose content is not present. That's because such files are still represented as symlinks, which git-annex commands know how to operate on. |