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

external backends wip

Browse source 
It's able to start them up, the only thing not implemented is generating
and verifying keys. And, the key translation for HasExt.
This commit is contained in:
Joey Hess 2020-07-29 15:23:18 -04:00
parent b5d6a36db0
commit f75be32166
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
24 changed files with 482 additions and 136 deletions
Download patch file Download diff file Expand all files Collapse all files

26
Annex/ExternalAddonProcess.hs
View file

@ -13,8 +13,8 @@ import Git.Env
import Utility.Shell
import Messages.Progress
import Control.Concurrent.STM
import Control.Concurrent.Async
import System.Log.Logger (debugM)
data ExternalAddonProcess = ExternalAddonProcess
{ externalSend :: Handle
@ -23,6 +23,7 @@ data ExternalAddonProcess = ExternalAddonProcess
-- immediately.
, externalShutdown :: Bool -> IO ()
, externalPid :: ExternalAddonPID
, externalProgram :: String
}
type ExternalAddonPID = Int
@ -31,8 +32,8 @@ data ExternalAddonStartError
= ProgramNotInstalled String
| ProgramFailure String
startExternalAddonProcess :: String -> TVar ExternalAddonPID-> Annex (Either ExternalAddonStartError ExternalAddonProcess)
startExternalAddonProcess basecmd pidvar = do
startExternalAddonProcess :: String -> ExternalAddonPID -> Annex (Either ExternalAddonStartError ExternalAddonProcess)
startExternalAddonProcess basecmd pid = do
errrelayer <- mkStderrRelayer
g <- Annex.gitRepo
cmdpath <- liftIO $ searchPath basecmd
@ -47,16 +48,12 @@ startExternalAddonProcess basecmd pidvar = do
}
p <- propgit g basep
tryNonAsync (createProcess p) >>= \case
Right v -> (Right <$> started errrelayer v)
Right v -> (Right <$> started cmd errrelayer v)
`catchNonAsync` const (runerr cmdpath)
Left _ -> runerr cmdpath
started errrelayer pall@(Just hin, Just hout, Just herr, ph) = do
started cmd errrelayer pall@(Just hin, Just hout, Just herr, ph) = do
stderrelay <- async $ errrelayer herr
pid <- atomically $ do
n <- succ <$> readTVar pidvar
writeTVar pidvar n
return n
let shutdown forcestop = do
cancel stderrelay
if forcestop
@ -71,8 +68,9 @@ startExternalAddonProcess basecmd pidvar = do
, externalReceive = hout
, externalPid = pid
, externalShutdown = shutdown
, externalProgram = cmd
}
started _ _ = giveup "internal"
started _ _ _ = giveup "internal"
propgit g p = do
environ <- propGitEnv g
@ -85,3 +83,11 @@ startExternalAddonProcess basecmd pidvar = do
path <- intercalate ":" <$> getSearchPath
return $ Left $ ProgramNotInstalled $
"Cannot run " ++ basecmd ++ " -- It is not installed in PATH (" ++ path ++ ")"
protocolDebug :: ExternalAddonProcess -> Bool -> String -> IO ()
protocolDebug external sendto line = debugM "external" $ unwords
[ externalProgram external ++
"[" ++ show (externalPid external) ++ "]"
, if sendto then "<--" else "-->"
, line
]