record VURL key hashes when getting from compute remote
Like when getting from the web special remote, when the output of the computation has changed, record the new hash of the content as an equivilant key for the VURL key. Still needs to be done for addcomputed and recompute.
This commit is contained in:
parent
b813549b2d
commit
2bd64059f1
2 changed files with 25 additions and 12 deletions
|
@ -36,6 +36,7 @@ import Annex.UUID
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.Tmp
|
import Annex.Tmp
|
||||||
import Logs.MetaData
|
import Logs.MetaData
|
||||||
|
import Logs.EquivilantKeys
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Utility.TimeStamp
|
import Utility.TimeStamp
|
||||||
import Utility.Env
|
import Utility.Env
|
||||||
|
@ -44,6 +45,8 @@ import Utility.Url
|
||||||
import Utility.MonotonicClock
|
import Utility.MonotonicClock
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Utility.SimpleProtocol as Proto
|
import qualified Utility.SimpleProtocol as Proto
|
||||||
|
import Types.Key
|
||||||
|
import Backend
|
||||||
|
|
||||||
import Network.HTTP.Types.URI
|
import Network.HTTP.Types.URI
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
|
@ -447,7 +450,7 @@ computationBehaviorChangeError (ComputeProgram program) requestdesc p =
|
||||||
giveup $ program ++ " is not behaving the same way it used to, now " ++ requestdesc ++ ": " ++ fromOsPath p
|
giveup $ program ++ " is not behaving the same way it used to, now " ++ requestdesc ++ ": " ++ fromOsPath p
|
||||||
|
|
||||||
computeKey :: RemoteStateHandle -> ComputeProgram -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
computeKey :: RemoteStateHandle -> ComputeProgram -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||||
computeKey rs (ComputeProgram program) k af dest p vc =
|
computeKey rs (ComputeProgram program) k _af dest p vc =
|
||||||
getComputeState rs k >>= \case
|
getComputeState rs k >>= \case
|
||||||
Just state ->
|
Just state ->
|
||||||
case computeskey state of
|
case computeskey state of
|
||||||
|
@ -475,28 +478,38 @@ computeKey rs (ComputeProgram program) k af dest p vc =
|
||||||
(keyfile : _) -> Just keyfile
|
(keyfile : _) -> Just keyfile
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
|
|
||||||
go keyfile state tmpdir ts = do
|
go keyfile state tmpdir _ts = do
|
||||||
|
hb <- hashBackend
|
||||||
|
let updatevurl key getobj =
|
||||||
|
if (fromKey keyVariety key == VURLKey)
|
||||||
|
then do
|
||||||
|
obj <- getobj
|
||||||
|
updateEquivilantKeys hb obj key
|
||||||
|
=<< getEquivilantKeys key
|
||||||
|
else return Nothing
|
||||||
|
|
||||||
let keyfile' = tmpdir </> keyfile
|
let keyfile' = tmpdir </> keyfile
|
||||||
unlessM (liftIO $ doesFileExist keyfile') $
|
unlessM (liftIO $ doesFileExist keyfile') $
|
||||||
giveup $ program ++ " exited sucessfully, but failed to write the computed file"
|
giveup $ program ++ " exited sucessfully, but failed to write the computed file"
|
||||||
catchNonAsync (liftIO $ moveFile keyfile' dest)
|
catchNonAsync (liftIO $ moveFile keyfile' dest)
|
||||||
(\err -> giveup $ "failed to move the computed file: " ++ show err)
|
(\err -> giveup $ "failed to move the computed file: " ++ show err)
|
||||||
|
mverification <- updatevurl k (pure dest)
|
||||||
|
|
||||||
-- Try to move any other computed object files into the annex.
|
-- Try to move any other computed object files into the annex.
|
||||||
forM_ (M.toList $ computeOutputs state) $ \case
|
forM_ (M.toList $ computeOutputs state) $ \case
|
||||||
(file, (Just key)) ->
|
(file, (Just key)) ->
|
||||||
when (k /= key) $ do
|
when (k /= key) $ do
|
||||||
let file' = tmpdir </> file
|
let file' = tmpdir </> file
|
||||||
whenM (liftIO $ doesFileExist file') $
|
whenM (liftIO $ doesFileExist file') $ do
|
||||||
whenM (verifyKeyContentPostRetrieval RetrievalAllKeysSecure vc verification k file') $
|
whenM (verifyKeyContentPostRetrieval RetrievalAllKeysSecure vc MustVerify key file') $ do
|
||||||
void $ tryNonAsync $ moveAnnex k file'
|
moved <- moveAnnex key file' `catchNonAsync` const (pure False)
|
||||||
|
when moved $
|
||||||
|
void $ updatevurl key (calcRepo (gitAnnexLocation key))
|
||||||
_ -> noop
|
_ -> noop
|
||||||
|
|
||||||
return verification
|
-- The program might not be reproducible,
|
||||||
|
-- so require strong verification.
|
||||||
-- The program might not be reproducible, so require strong
|
return $ fromMaybe MustVerify mverification
|
||||||
-- verification.
|
|
||||||
verification = MustVerify
|
|
||||||
|
|
||||||
-- Make sure that the compute state exists.
|
-- Make sure that the compute state exists.
|
||||||
checkKey :: RemoteStateHandle -> Key -> Annex Bool
|
checkKey :: RemoteStateHandle -> Key -> Annex Bool
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
* VURL keys don't currently have the hash key recorded in the equivilant
|
* VURL keys don't currently have the hash key recorded in the equivilant
|
||||||
key log by addcompute or when getting from a compute remote.
|
key log by addcompute
|
||||||
|
|
||||||
* need progress bars for computations and implement PROGRESS message
|
* need progress bars for computations and implement PROGRESS message
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue