cycle detection

diff --git a/Remote/Compute.hs b/Remote/Compute.hs
index b54a196e6fea746da198149264add90742a52ec1..53f08c6cf954a2468a49488fcf1e991505fbb301 100644 (file)
--- a/Remote/Compute.hs
+++ b/Remote/Compute.hs
@@ -518,12 +518,10 @@ computeKey rs (ComputeProgram program) k _af dest p vc =
                        Nothing -> error "internal"
        
        getinputcontent' f inputkey = do
-               remotelist <- Annex.getState Annex.remotes
-               locs <- loggedLocations inputkey
-               remotes <- keyPossibilities' (IncludeIgnored False) inputkey locs remotelist
+               remotes <- avoidCycles [k] inputkey
+                       =<< keyPossibilities inputkey
                anyM (getinputcontentfrom f inputkey) remotes
        
-       -- TODO cycle prevention
        getinputcontentfrom f inputkey r = do
                showAction $ "getting input " <> QuotedPath f
                        <> " from " <> UnquotedString (name r)
@@ -571,6 +569,50 @@ computeKey rs (ComputeProgram program) k _af dest p vc =
                -- The program might not be reproducible,
                -- so require strong verification.
                return $ fromMaybe MustVerify mverification
+               
+keyPossibilities :: Key -> Annex [Remote]
+keyPossibilities key = do
+       remotelist <- Annex.getState Annex.remotes
+       locs <- loggedLocations key
+       keyPossibilities' (IncludeIgnored False) key locs remotelist
+
+{- Filter out any remotes that, in order to compute the inputkey, would
+ - need to get the outputkey from some remote.
+ -
+ - This only finds cycles of compute special remotes, not any other
+ - similar type of special remote that might have its own input keys.
+ - There are no other such special remotes in git-annex itself, so this
+ - is the best that can be done.
+ -
+ - Note that, in a case where a compute special remote needs the outputkey
+ - to compute the inputkey, but could get the outputkey from either this
+ - remote, or some other, non-compute remote, that is filtered out as a
+ - cycle because it's not possible to prevent that remote getting from this
+ - remote.
+ -}
+avoidCycles :: [Key] -> Key -> [Remote] -> Annex [Remote]
+avoidCycles outputkeys inputkey = filterM go
+  where
+       go r
+               | iscomputeremote r = 
+                       getComputeState (remoteStateHandle r) inputkey >>= \case
+                               Nothing -> return True
+                               Just state
+                                       | inputsoutput state -> return False
+                                       | otherwise -> checkdeeper state
+               | otherwise = return True
+       
+       iscomputeremote r = remotetype r == remote
+
+       inputsoutput state = not $ M.null $
+               M.filter (`elem` outputkeys)
+                       (computeInputs state)
+       
+       checkdeeper state =
+               flip allM (M.elems (computeInputs state)) $ \inputkey' -> do
+                       rs <- keyPossibilities inputkey'
+                       rs' <- avoidCycles (inputkey:outputkeys) inputkey' rs
+                       return (rs' == rs)
 
 -- Make sure that the compute state exists.
 checkKey :: RemoteStateHandle -> Key -> Annex Bool

diff --git a/TODO-compute b/TODO-compute
index c0a05ef8db410fcebb73f1e43a45b9b6501fce16..3eff82e7102c5aac443d52e7b373100b1d79f822 100644 (file)
--- a/TODO-compute
+++ b/TODO-compute
@@ -3,11 +3,6 @@
 
 * need progress bars for computations and implement PROGRESS message
 
-* get input files for a computation (so `git-annex get .` gets every file,
-  even when input files in a directory are processed after computed files)
-
-  started implementation, but must avoid cycles!
-
 * addcomputed should honor annex.addunlocked.
 
 * Perhaps recompute should write a new version of a file as an unlocked