mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions 1

compute protocol debugging

Browse source
This commit is contained in:
Joey Hess 2025-03-10 15:14:59 -04:00
parent 7bda5f470c
commit 657ff9a32e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 8 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Remote/Compute.hs
View file

@ -434,6 +434,7 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate)
Just l Just l
| null l -> getinput tmpdir subdir result meterfile p | null l -> getinput tmpdir subdir result meterfile p
| otherwise -> do | otherwise -> do
fastDebug "Compute" ("< " ++ l)
result' <- parseoutput p tmpdir subdir result meterfile l result' <- parseoutput p tmpdir subdir result meterfile l
getinput tmpdir subdir result' meterfile p getinput tmpdir subdir result' meterfile p
Nothing -> do Nothing -> do
@ -443,6 +444,11 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate)
giveup $ program ++ " exited unsuccessfully" giveup $ program ++ " exited unsuccessfully"
return result return result
sendresponse p s = do
fastDebug "Compute" ("> " ++ s)
liftIO $ hPutStrLn (stdinHandle p) s
liftIO $ hFlush (stdinHandle p)
parseoutput p tmpdir subdir result meterfile l = case Proto.parseMessage l of parseoutput p tmpdir subdir result meterfile l = case Proto.parseMessage l of
Just (ProcessInput f) -> do Just (ProcessInput f) -> do
let f' = toOsPath f let f' = toOsPath f
@ -458,9 +464,8 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate)
Just (Left gitsha) -> Just (Left gitsha) ->
Just <$> (liftIO . relPathDirToFile subdir Just <$> (liftIO . relPathDirToFile subdir
=<< populategitsha gitsha tmpdir) =<< populategitsha gitsha tmpdir)
liftIO $ hPutStrLn (stdinHandle p) $ sendresponse p $
maybe "" fromOsPath mp maybe "" fromOsPath mp
liftIO $ hFlush (stdinHandle p)
let result' = result let result' = result
{ computeInputsUnavailable = { computeInputsUnavailable =
isNothing mp || computeInputsUnavailable result isNothing mp || computeInputsUnavailable result
@ -476,9 +481,7 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate)
let f' = toOsPath f let f' = toOsPath f
checksafefile tmpdir subdir f' "output" checksafefile tmpdir subdir f' "output"
-- Modify filename so eg "-foo" becomes "./-foo" -- Modify filename so eg "-foo" becomes "./-foo"
liftIO $ hPutStrLn (stdinHandle p) $ sendresponse p $ toCommand' (File f)
toCommand' (File f)
liftIO $ hFlush (stdinHandle p)
-- If the output file is in a subdirectory, make -- If the output file is in a subdirectory, make
-- the directories so the compute program doesn't -- the directories so the compute program doesn't
-- need to. -- need to.