aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Assistant/Threads/Committer.hs24
-rw-r--r--Assistant/Threads/Watcher.hs27
-rw-r--r--Command.hs7
-rw-r--r--Command/Add.hs24
-rw-r--r--Git/LsFiles.hs16
5 files changed, 72 insertions, 26 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index ca2148236..4d623eb0a 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -31,6 +31,7 @@ import qualified Utility.DirWatcher as DirWatcher
import Types.KeySource
import Config
import Annex.Exception
+import Annex.Content
import Data.Time.Clock
import Data.Tuple.Utils
@@ -146,7 +147,10 @@ delayaddDefault = Nothing
handleAdds :: Maybe Seconds -> [Change] -> Assistant [Change]
handleAdds delayadd cs = returnWhen (null incomplete) $ do
let (pending, inprocess) = partition isPendingAddChange incomplete
- pending' <- findnew pending
+ direct <- liftAnnex isDirect
+ pending' <- if direct
+ then return pending
+ else findnew pending
(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess
unless (null postponed) $
@@ -154,7 +158,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
returnWhen (null toadd) $ do
added <- catMaybes <$> forM toadd add
- if DirWatcher.eventsCoalesce || null added
+ if DirWatcher.eventsCoalesce || null added || direct
then return $ added ++ otherchanges
else do
r <- handleAdds delayadd =<< getChanges
@@ -195,13 +199,15 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
liftAnnex showEndFail
return Nothing
done change file (Just key) = do
- link <- liftAnnex $ Command.Add.link file key True
- when DirWatcher.eventsCoalesce $
- liftAnnex $ do
- sha <- inRepo $
- Git.HashObject.hashObject BlobObject link
- stageSymlink file sha
- showEndOk
+ link <- liftAnnex $ ifM isDirect
+ ( calcGitLink file key
+ , Command.Add.link file key True
+ )
+ liftAnnex $ whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do
+ sha <- inRepo $
+ Git.HashObject.hashObject BlobObject link
+ stageSymlink file sha
+ showEndOk
queueTransfers Next key (Just file) Upload
return $ Just change
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 08689cca4..fd59f1b27 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -27,13 +27,15 @@ import Utility.Types.DirWatcher
import Utility.Lsof
import qualified Annex
import qualified Annex.Queue
-import qualified Git.Command
+import qualified Git
import qualified Git.UpdateIndex
import qualified Git.HashObject
+import qualified Git.LsFiles as LsFiles
import qualified Backend
import Annex.Content
import Annex.CatFile
import Git.Types
+import Config
import Data.Bits.Utils
import qualified Data.ByteString.Lazy as L
@@ -57,7 +59,8 @@ needLsof = error $ unlines
watchThread :: NamedThread
watchThread = NamedThread "Watcher" $ do
startup <- asIO1 startupScan
- addhook <- hook onAdd
+ direct <- liftAnnex isDirect
+ addhook <- hook $ onAdd direct
delhook <- hook onDel
addsymlinkhook <- hook onAddSymlink
deldirhook <- hook onDelDir
@@ -83,9 +86,15 @@ startupScan scanner = do
-- Notice any files that were deleted before
-- watching was started.
- liftAnnex $ do
- inRepo $ Git.Command.run "add" [Param "--update"]
- showAction "started"
+ top <- liftAnnex $ fromRepo Git.repoPath
+ (fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [top]
+ forM_ fs $ \f -> do
+ liftAnnex $ Annex.Queue.addUpdateIndex =<<
+ inRepo (Git.UpdateIndex.unstageFile f)
+ maybe noop recordChange =<< madeChange f RmChange
+ void $ liftIO $ cleanup
+
+ liftAnnex $ showAction "started"
modifyDaemonStatus_ $ \s -> s { scanComplete = True }
@@ -117,8 +126,9 @@ runHandler handler file filestatus = void $ do
liftAnnex $ Annex.Queue.flushWhenFull
recordChange change
-onAdd :: Handler
-onAdd file filestatus
+onAdd :: Bool -> Handler
+onAdd isdirect file filestatus
+ | isdirect = pendingAddChange file
| maybe False isRegularFile filestatus = pendingAddChange file
| otherwise = noChange
@@ -223,7 +233,8 @@ onErr msg _ = do
{- Adds a symlink to the index, without ever accessing the actual symlink
- on disk. This avoids a race if git add is used, where the symlink is
- - changed to something else immediately after creation.
+ - changed to something else immediately after creation. It also allows
+ - direct mode to work.
-}
stageSymlink :: FilePath -> Sha -> Annex ()
stageSymlink file sha =
diff --git a/Command.hs b/Command.hs
index 478dfdc39..6c127c15d 100644
--- a/Command.hs
+++ b/Command.hs
@@ -18,6 +18,7 @@ module Command (
whenAnnexed,
ifAnnexed,
notBareRepo,
+ notDirect,
isBareRepo,
numCopies,
numCopiesCheck,
@@ -103,6 +104,12 @@ notBareRepo a = do
error "You cannot run this subcommand in a bare repository."
a
+notDirect :: Annex a -> Annex a
+notDirect a = ifM isDirect
+ ( error "You cannot run this subcommand in a direct mode repository."
+ , a
+ )
+
isBareRepo :: Annex Bool
isBareRepo = fromRepo Git.repoIsLocalBare
diff --git a/Command/Add.hs b/Command/Add.hs
index edb2f9cf4..e18f8592c 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -16,9 +16,11 @@ import Types.KeySource
import Backend
import Logs.Location
import Annex.Content
+import Annex.Content.Direct
import Annex.Perms
import Utility.Touch
import Utility.FileMode
+import Config
def :: [Command]
def = [command "add" paramPaths seek "add files to annex"]
@@ -31,7 +33,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
- backend, and then moving it into the annex directory and setting up
- the symlink pointing to its content. -}
start :: FilePath -> CommandStart
-start file = notBareRepo $ ifAnnexed file fixup add
+start file = notBareRepo $ notDirect $ ifAnnexed file fixup add
where
add = do
s <- liftIO $ getSymbolicLinkStatus file
@@ -62,7 +64,11 @@ lockDown file = do
createLink file tmpfile
return $ KeySource { keyFilename = file , contentLocation = tmpfile }
-{- Moves a locked down file into the annex. -}
+{- Moves a locked down file into the annex.
+ -
+ - In direct mode, leaves the file alone, and just updates bookeeping
+ - information.
+ -}
ingest :: KeySource -> Annex (Maybe Key)
ingest source = do
backend <- chooseBackend $ keyFilename source
@@ -72,9 +78,17 @@ ingest source = do
liftIO $ nukeFile $ contentLocation source
return Nothing
go (Just (key, _)) = do
- handle (undo (keyFilename source) key) $
- moveAnnex key $ contentLocation source
- liftIO $ nukeFile $ keyFilename source
+ ifM isDirect
+ ( do
+ updateCache key $ keyFilename source
+ void $ addAssociatedFile key $ keyFilename source
+ liftIO $ allowWrite $ keyFilename source
+ liftIO $ nukeFile $ contentLocation source
+ , do
+ handle (undo (keyFilename source) key) $
+ moveAnnex key $ contentLocation source
+ liftIO $ nukeFile $ keyFilename source
+ )
return $ Just key
perform :: FilePath -> CommandPerform
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 45c830cd6..401ed5562 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -8,6 +8,7 @@
module Git.LsFiles (
inRepo,
notInRepo,
+ deleted,
staged,
stagedNotDeleted,
stagedDetails,
@@ -38,6 +39,13 @@ notInRepo include_ignored l repo = pipeNullSplit params repo
| include_ignored = []
| otherwise = [Param "--exclude-standard"]
+{- Returns a list of files in the specified locations that have been
+ - deleted. -}
+deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+deleted l repo = pipeNullSplit params repo
+ where
+ params = [Params "ls-files --deleted -z --"] ++ map File l
+
{- Returns a list of all files that are staged for commit. -}
staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
staged = staged' []
@@ -112,7 +120,7 @@ data Unmerged = Unmerged
- 1 = old version, can be ignored
- 2 = us
- 3 = them
- - If a line is omitted, that side deleted the file.
+ - If a line is omitted, that side removed the file.
-}
unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool)
unmerged l repo = do
@@ -157,11 +165,11 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
, unmergedBlobType = Conflicting blobtypeA blobtypeB
, unmergedSha = Conflicting shaA shaB
}
- findsib templatei [] = ([], deleted templatei)
+ findsib templatei [] = ([], removed templatei)
findsib templatei (l:ls)
| ifile l == ifile templatei = (ls, l)
- | otherwise = (l:ls, deleted templatei)
- deleted templatei = templatei
+ | otherwise = (l:ls, removed templatei)
+ removed templatei = templatei
{ isus = not (isus templatei)
, iblobtype = Nothing
, isha = Nothing