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

set up handles for p2phttp

Browse source 
Now it fully works.. for the first request. But then it gets stuck
waiting for the P2P protocol runner to shut down.
This commit is contained in:
Joey Hess 2024-07-09 13:50:42 -04:00
parent edf8a3df2d
commit 3d13521479
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 15 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Command/P2PHttp.hs
View file

@ -54,7 +54,7 @@ testCheckPresent = do
burl <- liftIO $ parseBaseUrl "http://localhost:8080/" burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- liftIO $ clientCheckPresent (mkClientEnv mgr burl) res <- liftIO $ clientCheckPresent (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3) (P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("WORM--foo" :: String))) (B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo" :: String)))
(B64UUID (toUUID ("cu" :: String))) (B64UUID (toUUID ("cu" :: String)))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String))) (B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
[] []

18
P2P/Http/State.hs
View file

@ -118,21 +118,31 @@ withLocalP2PConnections a = do
resp <- if connectionServerUUID connparams /= myuuid resp <- if connectionServerUUID connparams /= myuuid
then return $ Left $ ConnectionFailed "unknown uuid" then return $ Left $ ConnectionFailed "unknown uuid"
else do else do
hdl1 <- liftIO newEmptyTMVarIO
hdl2 <- liftIO newEmptyTMVarIO
waitv1 <- liftIO newEmptyTMVarIO
waitv2 <- liftIO newEmptyTMVarIO
let h1 = P2PHandleTMVar hdl1 waitv1
let h2 = P2PHandleTMVar hdl2 waitv2
let serverconn = P2PConnection Nothing
(const True) h1 h2
(ConnIdent (Just "http server"))
let clientconn = P2PConnection Nothing
(const True) h2 h1
(ConnIdent (Just "http client"))
runst <- liftIO $ mkrunst connparams runst <- liftIO $ mkrunst connparams
-- TODO not this, need one with MVars.
let conn = stdioP2PConnection Nothing
-- TODO is this right? It needs to exit -- TODO is this right? It needs to exit
-- when the client stops sending messages. -- when the client stops sending messages.
let server = P2P.serveAuthed let server = P2P.serveAuthed
(connectionServerMode connparams) (connectionServerMode connparams)
(connectionServerUUID connparams) (connectionServerUUID connparams)
let protorunner = void $ let protorunner = void $
runFullProto runst conn server runFullProto runst serverconn server
asyncworker <- liftIO . async asyncworker <- liftIO . async
=<< forkState protorunner =<< forkState protorunner
let releaseconn = atomically $ putTMVar relv $ let releaseconn = atomically $ putTMVar relv $
join (liftIO (wait asyncworker)) join (liftIO (wait asyncworker))
return $ Right (runst, conn, releaseconn) return $ Right (runst, clientconn, releaseconn)
liftIO $ atomically $ putTMVar respvar resp liftIO $ atomically $ putTMVar respvar resp
mkrunst connparams = do mkrunst connparams = do