summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-12-22 15:23:27 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-12-22 15:23:27 -0400
commit56d1ad16c61d9e5abe1c123b3f791c9e5f641bd8 (patch)
tree1c6b88f7e44b18551cc6090ba465e0375df03e44 /Assistant
parent00e240f3803384ae8761f2d5bc95319351f4e0fa (diff)
finish v6 support for assistant
Seems to basically work now!
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/Committer.hs69
-rw-r--r--Assistant/Types/Changes.hs13
2 files changed, 40 insertions, 42 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 5e8df56c8..3e00011f5 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -266,10 +266,12 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
let (pending, inprocess) = partition isPendingAddChange incomplete
direct <- liftAnnex isDirect
unlocked <- liftAnnex versionSupportsUnlockedPointers
+ let lockingfiles = not (unlocked || direct)
(pending', cleanup) <- if unlocked || direct
then return (pending, noop)
else findnew pending
- (postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess
+ (postponed, toadd) <- partitionEithers
+ <$> safeToAdd lockingfiles havelsof delayadd pending' inprocess
cleanup
unless (null postponed) $
@@ -278,9 +280,9 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
returnWhen (null toadd) $ do
added <- addaction toadd $
catMaybes <$>
- if unlocked || direct
+ if not lockingfiles
then addunlocked direct toadd
- else forM toadd add
+ else forM toadd (add lockingfiles)
if DirWatcher.eventsCoalesce || null added || unlocked || direct
then return $ added ++ otherchanges
else do
@@ -307,16 +309,17 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
| c = return otherchanges
| otherwise = a
- add :: Change -> Assistant (Maybe Change)
- add change@(InProcessAddChange { keySource = ks }) =
+ add :: Bool -> Change -> Assistant (Maybe Change)
+ add lockingfile change@(InProcessAddChange { lockedDown = ld }) =
catchDefaultIO Nothing <~> doadd
where
+ ks = keySource ld
doadd = sanitycheck ks $ do
(mkey, mcache) <- liftAnnex $ do
showStart "add" $ keyFilename ks
- ingest $ Just ks
+ ingest $ Just $ LockedDown lockingfile ks
maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
- add _ = return Nothing
+ add _ _ = return Nothing
{- Avoid overhead of re-injesting a renamed unlocked file, by
- examining the other Changes to see if a removed file has the
@@ -329,29 +332,22 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
m <- liftAnnex $ removedKeysMap isdirect ct cs
delta <- liftAnnex getTSDelta
if M.null m
- then forM toadd add
+ then forM toadd (add False)
else forM toadd $ \c -> do
mcache <- liftIO $ genInodeCache (changeFile c) delta
case mcache of
- Nothing -> add c
+ Nothing -> add False c
Just cache ->
case M.lookup (inodeCacheToKey ct cache) m of
- Nothing -> add c
- Just k -> if isdirect
- then fastadddirect c k
- else fastaddunlocked c k
-
- fastadddirect :: Change -> Key -> Assistant (Maybe Change)
- fastadddirect change key = do
- let source = keySource change
- liftAnnex $ finishIngestDirect key source
- done change Nothing (keyFilename source) key
-
- fastaddunlocked :: Change -> Key -> Assistant (Maybe Change)
- fastaddunlocked change key = do
- let source = keySource change
- liftAnnex $ do
- Database.Keys.addAssociatedFile key (keyFilename source)
+ Nothing -> add False c
+ Just k -> fastadd isdirect c k
+
+ fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change)
+ fastadd isdirect change key = do
+ let source = keySource $ lockedDown change
+ liftAnnex $ if isdirect
+ then finishIngestDirect key source
+ else Database.Keys.addAssociatedFile key (keyFilename source)
done change Nothing (keyFilename source) key
removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
@@ -419,16 +415,16 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
-
- Check by running lsof on the repository.
-}
-safeToAdd :: Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
-safeToAdd _ _ [] [] = return []
-safeToAdd havelsof delayadd pending inprocess = do
+safeToAdd :: Bool -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
+safeToAdd _ _ _ [] [] = return []
+safeToAdd lockingfiles havelsof delayadd pending inprocess = do
maybe noop (liftIO . threadDelaySeconds) delayadd
liftAnnex $ do
- keysources <- forM pending $ lockDown . changeFile
- let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending keysources)
+ lockeddown <- forM pending $ lockDown lockingfiles . changeFile
+ let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending lockeddown)
openfiles <- if havelsof
then S.fromList . map fst3 . filter openwrite <$>
- findopenfiles (map keySource inprocess')
+ findopenfiles (map (keySource . lockedDown) inprocess')
else pure S.empty
let checked = map (check openfiles) inprocess'
@@ -441,17 +437,18 @@ safeToAdd havelsof delayadd pending inprocess = do
allRight $ rights checked
else return checked
where
- check openfiles change@(InProcessAddChange { keySource = ks })
- | S.member (contentLocation ks) openfiles = Left change
+ check openfiles change@(InProcessAddChange { lockedDown = ld })
+ | S.member (contentLocation (keySource ld)) openfiles = Left change
check _ change = Right change
- mkinprocess (c, Just ks) = Just InProcessAddChange
+ mkinprocess (c, Just ld) = Just InProcessAddChange
{ changeTime = changeTime c
- , keySource = ks
+ , lockedDown = ld
}
mkinprocess (_, Nothing) = Nothing
- canceladd (InProcessAddChange { keySource = ks }) = do
+ canceladd (InProcessAddChange { lockedDown = ld }) = do
+ let ks = keySource ld
warning $ keyFilename ks
++ " still has writers, not adding"
-- remove the hard link
diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs
index 1d8b51775..8c2d02cab 100644
--- a/Assistant/Types/Changes.hs
+++ b/Assistant/Types/Changes.hs
@@ -10,6 +10,7 @@ module Assistant.Types.Changes where
import Types.KeySource
import Types.Key
import Utility.TList
+import Annex.Ingest
import Control.Concurrent.STM
import Data.Time.Clock
@@ -38,7 +39,7 @@ data Change
}
| InProcessAddChange
{ changeTime ::UTCTime
- , keySource :: KeySource
+ , lockedDown :: LockedDown
}
deriving (Show)
@@ -53,7 +54,7 @@ changeInfoKey _ = Nothing
changeFile :: Change -> FilePath
changeFile (Change _ f _) = f
changeFile (PendingAddChange _ f) = f
-changeFile (InProcessAddChange _ ks) = keyFilename ks
+changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld
isPendingAddChange :: Change -> Bool
isPendingAddChange (PendingAddChange {}) = True
@@ -64,14 +65,14 @@ isInProcessAddChange (InProcessAddChange {}) = True
isInProcessAddChange _ = False
retryChange :: Change -> Change
-retryChange (InProcessAddChange time ks) =
- PendingAddChange time (keyFilename ks)
+retryChange c@(InProcessAddChange time _) =
+ PendingAddChange time $ changeFile c
retryChange c = c
finishedChange :: Change -> Key -> Change
-finishedChange c@(InProcessAddChange { keySource = ks }) k = Change
+finishedChange c@(InProcessAddChange {}) k = Change
{ changeTime = changeTime c
- , _changeFile = keyFilename ks
+ , _changeFile = changeFile c
, changeInfo = AddKeyChange k
}
finishedChange c _ = c