annex.addunlocked support for git-annex compute

And for git-annex recompute, add the file unlocked when the original is
unlocked.
This commit is contained in:
Joey Hess 2025-03-17 14:26:09 -04:00
parent de6e9f5beb
commit 23538ea17b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 58 additions and 42 deletions

View file

@ -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

View file

@ -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 ->

View file

@ -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.