diff --git a/Command/AddComputed.hs b/Command/AddComputed.hs index 02d8826683..2c389ef53a 100644 --- a/Command/AddComputed.hs +++ b/Command/AddComputed.hs @@ -24,11 +24,13 @@ import Annex.UUID import Annex.GitShaKey import Types.KeySource import Types.Key +import Annex.FileMatcher import Messages.Progress import Logs.Location import Logs.EquivilantKeys import Utility.Metered import Backend.URL (fromUrl) +import Git.FilePath import qualified Data.Map as M import Data.Time.Clock @@ -73,20 +75,21 @@ seek o = startConcurrency commandStages (seek' o) seek' :: AddComputedOptions -> CommandSeek seek' o = do + addunlockedmatcher <- addUnlockedMatcher r <- getParsed (computeRemote o) unless (Remote.Compute.isComputeRemote r) $ giveup "That is not a compute remote." - commandAction $ start o r + commandAction $ start o r addunlockedmatcher -start :: AddComputedOptions -> Remote -> CommandStart -start o r = starting "addcomputed" ai si $ perform o r +start :: AddComputedOptions -> Remote -> AddUnlockedMatcher -> CommandStart +start o r = starting "addcomputed" ai si . perform o r where ai = ActionItemUUID (Remote.uuid r) (UnquotedString (Remote.name r)) si = SeekInput (computeParams o) -perform :: AddComputedOptions -> Remote -> CommandPerform -perform o r = do +perform :: AddComputedOptions -> Remote -> AddUnlockedMatcher -> CommandPerform +perform o r addunlockedmatcher = do program <- Remote.Compute.getComputeProgram r repopath <- fromRepo Git.repoPath subdir <- liftIO $ relPathDirToFile repopath (literalOsPath ".") @@ -102,8 +105,11 @@ perform o r = do (Remote.Compute.ImmutableState False) (getInputContent fast) Nothing - (addComputed (Just "adding") r (reproducible o) chooseBackend Just fast) + (go fast) next $ return True + where + go fast = addComputed (Just "adding") r (reproducible o) + chooseBackend Just fast (Right addunlockedmatcher) addComputed :: Maybe StringContainingQuotedPath @@ -112,11 +118,12 @@ addComputed -> (OsPath -> Annex Backend) -> (OsPath -> Maybe OsPath) -> Bool + -> Either Bool AddUnlockedMatcher -> Remote.Compute.ComputeProgramResult -> OsPath -> NominalDiffTime -> Annex () -addComputed maddaction r reproducibleconfig choosebackend destfile fast result tmpdir ts = do +addComputed maddaction r reproducibleconfig choosebackend destfile fast addunlockedmatcher result tmpdir ts = do when (M.null outputs) $ giveup "The computation succeeded, but it did not generate any files." oks <- forM (M.keys outputs) $ \outputfile -> do @@ -163,19 +170,43 @@ addComputed maddaction r reproducibleconfig choosebackend destfile fast result t stateurl = Remote.Compute.computeStateUrl r state outputfile stateurlk = fromUrl stateurl Nothing True outputfile' = tmpdir outputfile - ld f = LockedDown ldc (ks f) - ks f = KeySource - { keyFilename = f - , contentLocation = outputfile' - , inodeCache = Nothing - } genkey f p = do backend <- choosebackend outputfile - fst <$> genKey (ks f) p backend - ingesthelper f p mk = - ingestwith $ do - k <- maybe (genkey f p) return mk - ingestAdd' p (Just (ld f)) (Just k) + let ks = KeySource + { keyFilename = f + , contentLocation = outputfile' + , inodeCache = Nothing + } + fst <$> genKey ks p backend + ingesthelper f p mk = ingestwith $ do + k <- maybe (genkey f p) return mk + topf <- inRepo $ toTopFilePath f + let fi = FileInfo + { contentFile = outputfile' + , matchFile = getTopFilePath topf + , matchKey = Just k + } + lockingfile <- case addunlockedmatcher of + Right addunlockedmatcher' -> + not <$> addUnlocked addunlockedmatcher' + (MatchingFile fi) + (not fast) + Left v -> pure v + let ldc = LockDownConfig + { lockingFile = lockingfile + , hardlinkFileTmpDir = Nothing + , checkWritePerms = True + } + liftIO $ createDirectoryIfMissing True $ + takeDirectory f + liftIO $ moveFile outputfile' f + let ks = KeySource + { keyFilename = f + , contentLocation = f + , inodeCache = Nothing + } + let ld = LockedDown ldc ks + ingestAdd' p (Just ld) (Just k) ingestwith a = a >>= \case Nothing -> giveup "ingestion failed" Just k -> do @@ -188,12 +219,6 @@ addComputed maddaction r reproducibleconfig choosebackend destfile fast result t =<< calcRepo (gitAnnexLocation k) return k - ldc = LockDownConfig - { lockingFile = True - , hardlinkFileTmpDir = Nothing - , checkWritePerms = True - } - isreproducible = case reproducibleconfig of Just v -> isReproducible v Nothing -> Remote.Compute.computeReproducible result diff --git a/Command/Recompute.hs b/Command/Recompute.hs index 82ed7ab37e..df701fb852 100644 --- a/Command/Recompute.hs +++ b/Command/Recompute.hs @@ -23,8 +23,10 @@ import Logs.Location import Command.AddComputed (Reproducible(..), parseReproducible, getInputContent, getInputContent', addComputed) import Backend (maybeLookupBackendVariety, unknownBackendVarietyMessage, chooseBackend) import Types.Key +import qualified Utility.RawFilePath as R import qualified Data.Map as M +import System.PosixCompat.Files (isSymbolicLink) cmd :: Command cmd = notBareRepo $ @@ -126,19 +128,22 @@ perform :: RecomputeOptions -> Remote -> OsPath -> Key -> Remote.Compute.Compute perform o r file origkey origstate = do program <- Remote.Compute.getComputeProgram r reproducibleconfig <- getreproducibleconfig + originallocked <- liftIO $ isSymbolicLink + <$> R.getSymbolicLinkStatus (fromOsPath file) showOutput Remote.Compute.runComputeProgram program origstate (Remote.Compute.ImmutableState False) (getinputcontent program) Nothing - (go program reproducibleconfig) + (go program reproducibleconfig originallocked) next cleanup where - go program reproducibleconfig result tmpdir ts = do + go program reproducibleconfig originallocked result tmpdir ts = do checkbehaviorchange program (Remote.Compute.computeState result) addComputed Nothing r reproducibleconfig - choosebackend destfile False result tmpdir ts + choosebackend destfile False (Left originallocked) + result tmpdir ts checkbehaviorchange program state = do let check s w a b = forM_ (M.keys (w a)) $ \f -> diff --git a/doc/todo/compute_special_remote_remaining_todos.mdwn b/doc/todo/compute_special_remote_remaining_todos.mdwn index c6e5a64de6..db31b873cf 100644 --- a/doc/todo/compute_special_remote_remaining_todos.mdwn +++ b/doc/todo/compute_special_remote_remaining_todos.mdwn @@ -29,21 +29,6 @@ compute special remote. --[[Joey]] * allow git-annex enableremote with program= explicitly specified, without checking annex.security.allowed-compute-programs -* addcomputed should honor annex.addunlocked. - - What about recompute? It seems it should either write the new version of - the file as an unlocked file when the old version was unlocked, or also - honor annex.addunlocked. - - Problem: Since recompute does not stage the file, it would have to write - the content to the working tree. And then the user would need to - git-annex add. But then, if the key was a VURL key, it would add it with - the default backend instead, and the file would no longer use a computed - key. - - So it, seems that, for this to be done, recompute would need to stage the - pointer file. - * recompute could ingest keys for other files than the one being recomputed, and remember them. Then recomputing those files could just use those keys, without re-running a computation. (Better than --others @@ -68,3 +53,4 @@ compute special remote. --[[Joey]] that recompute should also support recomputing non-annexed files. Otherwise, adding a file and then recomputing it would vary in what the content of the file is, depending on annex.smallfiles setting. +