direct mode committing
This commit is contained in:
parent
bfb446604a
commit
e7b8cb0063
11 changed files with 186 additions and 54 deletions
|
@ -9,6 +9,7 @@ module Annex.CatFile (
|
||||||
catFile,
|
catFile,
|
||||||
catObject,
|
catObject,
|
||||||
catObjectDetails,
|
catObjectDetails,
|
||||||
|
catKey,
|
||||||
catFileHandle
|
catFileHandle
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -42,3 +43,7 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle
|
||||||
h <- inRepo Git.CatFile.catFileStart
|
h <- inRepo Git.CatFile.catFileStart
|
||||||
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
|
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
|
||||||
return 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
|
||||||
|
|
|
@ -10,7 +10,6 @@ module Annex.Content (
|
||||||
inAnnexSafe,
|
inAnnexSafe,
|
||||||
lockContent,
|
lockContent,
|
||||||
calcGitLink,
|
calcGitLink,
|
||||||
logStatus,
|
|
||||||
getViaTmp,
|
getViaTmp,
|
||||||
getViaTmpUnchecked,
|
getViaTmpUnchecked,
|
||||||
withTmp,
|
withTmp,
|
||||||
|
@ -33,7 +32,6 @@ import System.IO.Unsafe (unsafeInterleaveIO)
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Logs.Location
|
import Logs.Location
|
||||||
import Annex.UUID
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
@ -132,13 +130,6 @@ calcGitLink file key = do
|
||||||
where
|
where
|
||||||
whoops = error $ "unable to normalize " ++ file
|
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,
|
{- Runs an action, passing it a temporary filename to get,
|
||||||
- and if the action succeeds, moves the temp file into
|
- and if the action succeeds, moves the temp file into
|
||||||
- the annex as a key's content. -}
|
- the annex as a key's content. -}
|
||||||
|
|
|
@ -7,13 +7,18 @@
|
||||||
|
|
||||||
module Annex.Content.Direct (
|
module Annex.Content.Direct (
|
||||||
associatedFiles,
|
associatedFiles,
|
||||||
changeAssociatedFiles,
|
removeAssociatedFile,
|
||||||
|
addAssociatedFile,
|
||||||
updateAssociatedFiles,
|
updateAssociatedFiles,
|
||||||
goodContent,
|
goodContent,
|
||||||
updateCache,
|
updateCache,
|
||||||
recordedCache,
|
recordedCache,
|
||||||
compareCache,
|
compareCache,
|
||||||
removeCache
|
writeCache,
|
||||||
|
removeCache,
|
||||||
|
genCache,
|
||||||
|
toCache,
|
||||||
|
Cache
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
@ -23,9 +28,9 @@ import Git.Sha
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
import Utility.TempFile
|
import Utility.TempFile
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
|
import Logs.Location
|
||||||
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import qualified Data.ByteString.Lazy as L
|
|
||||||
|
|
||||||
{- Files in the tree that are associated with a key. -}
|
{- Files in the tree that are associated with a key. -}
|
||||||
associatedFiles :: Key -> Annex [FilePath]
|
associatedFiles :: Key -> Annex [FilePath]
|
||||||
|
@ -42,19 +47,24 @@ associatedFilesRelative key = do
|
||||||
liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
|
liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
|
||||||
|
|
||||||
{- Changes the associated files information for a key, applying a
|
{- Changes the associated files information for a key, applying a
|
||||||
- transformation to the list. -}
|
- transformation to the list. Returns a copy of the new info. -}
|
||||||
changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex ()
|
changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
|
||||||
changeAssociatedFiles key transform = do
|
changeAssociatedFiles key transform = do
|
||||||
mapping <- inRepo $ gitAnnexMapping key
|
mapping <- inRepo $ gitAnnexMapping key
|
||||||
files <- associatedFilesRelative key
|
files <- associatedFilesRelative key
|
||||||
let files' = transform files
|
let files' = transform files
|
||||||
when (files /= files') $
|
when (files /= files') $
|
||||||
liftIO $ viaTmp writeFile mapping $ unlines files'
|
liftIO $ viaTmp writeFile mapping $ unlines files'
|
||||||
|
return files'
|
||||||
|
|
||||||
removeAssociatedFile :: Key -> FilePath -> Annex ()
|
removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
||||||
removeAssociatedFile key file = changeAssociatedFiles key $ filter (/= file)
|
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 ->
|
addAssociatedFile key file = changeAssociatedFiles key $ \files ->
|
||||||
if file `elem` files
|
if file `elem` files
|
||||||
then files
|
then files
|
||||||
|
@ -74,10 +84,8 @@ updateAssociatedFiles oldsha newsha = do
|
||||||
where
|
where
|
||||||
go getsha getmode a =
|
go getsha getmode a =
|
||||||
when (getsha item /= nullSha && isSymLink (getmode item)) $ do
|
when (getsha item /= nullSha && isSymLink (getmode item)) $ do
|
||||||
key <- getkey $ getsha item
|
key <- catKey (getsha item)
|
||||||
maybe noop (\k -> a k $ DiffTree.file item) key
|
maybe noop (\k -> void $ a k $ DiffTree.file item) key
|
||||||
getkey sha = fileKey . takeFileName . encodeW8 . L.unpack
|
|
||||||
<$> catObject sha
|
|
||||||
|
|
||||||
{- Checks if a file in the tree, associated with a key, has not been modified.
|
{- 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. -}
|
{- Stores a cache of attributes for a file that is associated with a key. -}
|
||||||
updateCache :: Key -> FilePath -> Annex ()
|
updateCache :: Key -> FilePath -> Annex ()
|
||||||
updateCache key file = do
|
updateCache key file = maybe noop (writeCache key) =<< liftIO (genCache file)
|
||||||
withCacheFile key $ \cachefile -> do
|
|
||||||
createDirectoryIfMissing True (parentDir cachefile)
|
{- Writes a cache for a key. -}
|
||||||
maybe noop (writeFile cachefile . showCache) =<< genCache file
|
writeCache :: Key -> Cache -> Annex ()
|
||||||
|
writeCache key cache = withCacheFile key $ \cachefile -> do
|
||||||
|
createDirectoryIfMissing True (parentDir cachefile)
|
||||||
|
writeFile cachefile $ showCache cache
|
||||||
|
|
||||||
{- Removes a cache. -}
|
{- Removes a cache. -}
|
||||||
removeCache :: Key -> Annex ()
|
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
|
{- Cache a file's inode, size, and modification time to determine if it's
|
||||||
- been changed. -}
|
- been changed. -}
|
||||||
data Cache = Cache FileID FileOffset EpochTime
|
data Cache = Cache FileID FileOffset EpochTime
|
||||||
deriving (Eq)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
showCache :: Cache -> String
|
showCache :: Cache -> String
|
||||||
showCache (Cache inode size mtime) = unwords
|
showCache (Cache inode size mtime) = unwords
|
||||||
|
|
105
Annex/Direct.hs
Normal file
105
Annex/Direct.hs
Normal file
|
@ -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
|
||||||
|
)
|
|
@ -52,8 +52,7 @@ orderedList = do
|
||||||
parseBackendList s = map lookupBackendName $ words s
|
parseBackendList s = map lookupBackendName $ words s
|
||||||
|
|
||||||
{- Generates a key for a file, trying each backend in turn until one
|
{- 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 :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend))
|
||||||
genKey source trybackend = do
|
genKey source trybackend = do
|
||||||
bs <- orderedList
|
bs <- orderedList
|
||||||
|
@ -94,8 +93,7 @@ lookupFile file = do
|
||||||
return Nothing
|
return Nothing
|
||||||
|
|
||||||
{- Looks up the backend that should be used for a file.
|
{- 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 :: FilePath -> Annex (Maybe Backend)
|
||||||
chooseBackend f = Annex.getState Annex.forcebackend >>= go
|
chooseBackend f = Annex.getState Annex.forcebackend >>= go
|
||||||
where
|
where
|
||||||
|
|
|
@ -16,6 +16,7 @@ import qualified Annex.Branch
|
||||||
import qualified Annex.Queue
|
import qualified Annex.Queue
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.Content.Direct
|
import Annex.Content.Direct
|
||||||
|
import Annex.Direct
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
|
@ -29,7 +30,6 @@ import qualified Remote.Git
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
|
||||||
import Data.Hash.MD5
|
import Data.Hash.MD5
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
|
@ -79,14 +79,20 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
|
||||||
fastest = fromMaybe [] . headMaybe . Remote.byCost
|
fastest = fromMaybe [] . headMaybe . Remote.byCost
|
||||||
|
|
||||||
commit :: CommandStart
|
commit :: CommandStart
|
||||||
commit = do
|
commit = next $ next $ do
|
||||||
showStart "commit" ""
|
Annex.Branch.commit "update"
|
||||||
next $ next $ do
|
ifM isDirect
|
||||||
|
( ifM stageDirect
|
||||||
|
( runcommit [] , return True )
|
||||||
|
, runcommit [Param "-a"]
|
||||||
|
)
|
||||||
|
where
|
||||||
|
runcommit ps = do
|
||||||
|
showStart "commit" ""
|
||||||
showOutput
|
showOutput
|
||||||
Annex.Branch.commit "update"
|
|
||||||
-- Commit will fail when the tree is clean, so ignore failure.
|
-- Commit will fail when the tree is clean, so ignore failure.
|
||||||
_ <- inRepo $ Git.Command.runBool "commit"
|
_ <- inRepo $ Git.Command.runBool "commit" $ ps ++
|
||||||
[Param "-a", Param "-m", Param "git-annex automatic sync"]
|
[Param "-m", Param "git-annex automatic sync"]
|
||||||
return True
|
return True
|
||||||
|
|
||||||
mergeLocal :: Git.Ref -> CommandStart
|
mergeLocal :: Git.Ref -> CommandStart
|
||||||
|
@ -136,7 +142,7 @@ mergeRemote remote b = case b of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
branch <- inRepo Git.Branch.currentUnsafe
|
branch <- inRepo Git.Branch.currentUnsafe
|
||||||
all id <$> (mapM merge $ branchlist branch)
|
all id <$> (mapM merge $ branchlist branch)
|
||||||
Just branch -> all id <$> (mapM merge =<< tomerge (branchlist b))
|
Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b))
|
||||||
where
|
where
|
||||||
merge = mergeFrom . remoteBranch remote
|
merge = mergeFrom . remoteBranch remote
|
||||||
tomerge branches = filterM (changed remote) branches
|
tomerge branches = filterM (changed remote) branches
|
||||||
|
@ -259,9 +265,7 @@ resolveMerge' u
|
||||||
case msha of
|
case msha of
|
||||||
Nothing -> a Nothing
|
Nothing -> a Nothing
|
||||||
Just sha -> do
|
Just sha -> do
|
||||||
key <- fileKey . takeFileName
|
key <- catKey sha
|
||||||
. encodeW8 . L.unpack
|
|
||||||
<$> catObject sha
|
|
||||||
maybe (return False) (a . Just) key
|
maybe (return False) (a . Just) key
|
||||||
|
|
||||||
{- The filename to use when resolving a conflicted merge of a file,
|
{- The filename to use when resolving a conflicted merge of a file,
|
||||||
|
|
|
@ -10,7 +10,7 @@ module Git.LsFiles (
|
||||||
notInRepo,
|
notInRepo,
|
||||||
staged,
|
staged,
|
||||||
stagedNotDeleted,
|
stagedNotDeleted,
|
||||||
notStaged,
|
stagedDetails,
|
||||||
typeChanged,
|
typeChanged,
|
||||||
typeChangedStaged,
|
typeChangedStaged,
|
||||||
Conflicting(..),
|
Conflicting(..),
|
||||||
|
@ -53,13 +53,21 @@ staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
|
||||||
prefix = [Params "diff --cached --name-only -z"]
|
prefix = [Params "diff --cached --name-only -z"]
|
||||||
suffix = Param "--" : map File l
|
suffix = Param "--" : map File l
|
||||||
|
|
||||||
{- Returns a list of all files that have unstaged changes. This includes
|
{- Returns details about files that are staged in the index
|
||||||
- any new files, that have not been added yet. -}
|
- (including the Sha of their staged contents),
|
||||||
notStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
- as well as files not yet in git. -}
|
||||||
notStaged l repo = pipeNullSplit params repo
|
stagedDetails :: [FilePath] -> Repo -> IO ([(FilePath, Maybe Sha)], IO Bool)
|
||||||
|
stagedDetails l repo = do
|
||||||
|
(ls, cleanup) <- pipeNullSplit params repo
|
||||||
|
return (map parse ls, cleanup)
|
||||||
where
|
where
|
||||||
params = [Params "ls-files --others --deleted --modified --exclude-standard -z --"] ++
|
params = [Params "ls-files --others --exclude-standard --stage -z --"] ++
|
||||||
map File l
|
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
|
{- Returns a list of the files in the specified locations that are staged
|
||||||
- for commit, and whose type has changed. -}
|
- for commit, and whose type has changed. -}
|
||||||
|
|
|
@ -15,6 +15,7 @@
|
||||||
|
|
||||||
module Logs.Location (
|
module Logs.Location (
|
||||||
LogStatus(..),
|
LogStatus(..),
|
||||||
|
logStatus,
|
||||||
logChange,
|
logChange,
|
||||||
loggedLocations,
|
loggedLocations,
|
||||||
loggedKeys,
|
loggedKeys,
|
||||||
|
@ -26,6 +27,13 @@ module Logs.Location (
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import Logs.Presence
|
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. -}
|
{- Log a change in the presence of a key's value in a repository. -}
|
||||||
logChange :: Key -> UUID -> LogStatus -> Annex ()
|
logChange :: Key -> UUID -> LogStatus -> Annex ()
|
||||||
|
|
|
@ -51,7 +51,7 @@ import qualified Annex
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Logs.UUID
|
import Logs.UUID
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Logs.Location
|
import Logs.Location hiding (logStatus)
|
||||||
import Remote.List
|
import Remote.List
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
|
||||||
|
|
|
@ -37,6 +37,7 @@ import Config
|
||||||
import Init
|
import Init
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import qualified Fields
|
import qualified Fields
|
||||||
|
import Logs.Location
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.MSampleVar
|
import Control.Concurrent.MSampleVar
|
||||||
|
@ -243,7 +244,7 @@ dropKey r key
|
||||||
whenM (Annex.Content.inAnnex key) $ do
|
whenM (Annex.Content.inAnnex key) $ do
|
||||||
Annex.Content.lockContent key $
|
Annex.Content.lockContent key $
|
||||||
Annex.Content.removeAnnex key
|
Annex.Content.removeAnnex key
|
||||||
Annex.Content.logStatus key InfoMissing
|
logStatus key InfoMissing
|
||||||
Annex.Content.saveState True
|
Annex.Content.saveState True
|
||||||
return True
|
return True
|
||||||
| Git.repoIsHttp r = error "dropping from http repo not supported"
|
| Git.repoIsHttp r = error "dropping from http repo not supported"
|
||||||
|
|
|
@ -20,11 +20,9 @@ deleted or modified at any time). To do so: `git annex untrust .`
|
||||||
|
|
||||||
## use a direct mode repository
|
## use a direct mode repository
|
||||||
|
|
||||||
You can use `git annex add` to add files to your direct mode repository.
|
The main command that's used in direct mode repositories is
|
||||||
|
`git annex sync`. This automatically adds new files, commits all
|
||||||
The main command that's supported in direct mode repositories is
|
changed files to git, pushes them out, pulls down any changes, etc.
|
||||||
`git annex sync`. This automatically 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
|
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
|
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
|
## 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
|
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
|
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.
|
represented as symlinks, which git-annex commands know how to operate on.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue