proxying to local git remotes works

This just happened to work correctly. Rather surprisingly. It turns out
that openP2PSshConnection actually also supports local git remotes,
by just running git-annex-shell with the path to the remote.

Renamed "P2PSsh" to "P2PShell" to make this clear.
This commit is contained in:
Joey Hess 2024-06-12 10:10:11 -04:00
parent 178da0dc99
commit c6e0710281
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 62 additions and 56 deletions

View file

@ -178,61 +178,62 @@ rsyncParams r direction = do
| otherwise = remoteAnnexRsyncUploadOptions gc
gc = gitconfig r
-- A connection over ssh to git-annex shell speaking the P2P protocol.
type P2PSshConnection = P2P.ClosableConnection
-- A connection over ssh or locally to git-annex shell,
-- speaking the P2P protocol.
type P2PShellConnection = P2P.ClosableConnection
(P2P.RunState, P2P.P2PConnection, ProcessHandle)
closeP2PSshConnection :: P2PSshConnection -> IO (P2PSshConnection, Maybe ExitCode)
closeP2PSshConnection P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
closeP2PSshConnection (P2P.OpenConnection (_st, conn, pid)) =
closeP2PShellConnection :: P2PShellConnection -> IO (P2PShellConnection, Maybe ExitCode)
closeP2PShellConnection P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
closeP2PShellConnection (P2P.OpenConnection (_st, conn, pid)) =
-- mask async exceptions, avoid cleanup being interrupted
uninterruptibleMask_ $ do
P2P.closeConnection conn
exitcode <- waitForProcess pid
return (P2P.ClosedConnection, Just exitcode)
-- Pool of connections over ssh to git-annex-shell p2pstdio.
type P2PSshConnectionPool = TVar (Maybe P2PSshConnectionPoolState)
-- Pool of connections to git-annex-shell p2pstdio.
type P2PShellConnectionPool = TVar (Maybe P2PShellConnectionPoolState)
data P2PSshConnectionPoolState
= P2PSshConnections [P2PSshConnection]
data P2PShellConnectionPoolState
= P2PShellConnections [P2PShellConnection]
-- Remotes using an old version of git-annex-shell don't support P2P
| P2PSshUnsupported
| P2PShellUnsupported
mkP2PSshConnectionPool :: Annex P2PSshConnectionPool
mkP2PSshConnectionPool = liftIO $ newTVarIO Nothing
mkP2PShellConnectionPool :: Annex P2PShellConnectionPool
mkP2PShellConnectionPool = liftIO $ newTVarIO Nothing
-- Takes a connection from the pool, if any are available, otherwise
-- tries to open a new one.
getP2PSshConnection :: Remote -> P2PSshConnectionPool -> Annex (Maybe P2PSshConnection)
getP2PSshConnection r connpool = getexistingconn >>= \case
getP2PShellConnection :: Remote -> P2PShellConnectionPool -> Annex (Maybe P2PShellConnection)
getP2PShellConnection r connpool = getexistingconn >>= \case
Nothing -> return Nothing
Just Nothing -> openP2PSshConnection r connpool
Just Nothing -> openP2PShellConnection r connpool
Just (Just c) -> return (Just c)
where
getexistingconn = liftIO $ atomically $ readTVar connpool >>= \case
Just P2PSshUnsupported -> return Nothing
Just (P2PSshConnections (c:cs)) -> do
writeTVar connpool (Just (P2PSshConnections cs))
Just P2PShellUnsupported -> return Nothing
Just (P2PShellConnections (c:cs)) -> do
writeTVar connpool (Just (P2PShellConnections cs))
return (Just (Just c))
Just (P2PSshConnections []) -> return (Just Nothing)
Just (P2PShellConnections []) -> return (Just Nothing)
Nothing -> return (Just Nothing)
-- Add a connection to the pool, unless it's closed.
storeP2PSshConnection :: P2PSshConnectionPool -> P2PSshConnection -> IO ()
storeP2PSshConnection _ P2P.ClosedConnection = return ()
storeP2PSshConnection connpool conn = atomically $ modifyTVar' connpool $ \case
Just (P2PSshConnections cs) -> Just (P2PSshConnections (conn:cs))
_ -> Just (P2PSshConnections [conn])
storeP2PShellConnection :: P2PShellConnectionPool -> P2PShellConnection -> IO ()
storeP2PShellConnection _ P2P.ClosedConnection = return ()
storeP2PShellConnection connpool conn = atomically $ modifyTVar' connpool $ \case
Just (P2PShellConnections cs) -> Just (P2PShellConnections (conn:cs))
_ -> Just (P2PShellConnections [conn])
-- Try to open a P2PSshConnection.
-- Try to open a P2PShellConnection.
-- The new connection is not added to the pool, so it's available
-- for the caller to use.
-- If the remote does not support the P2P protocol, that's remembered in
-- the connection pool.
openP2PSshConnection :: Remote -> P2PSshConnectionPool -> Annex (Maybe P2PSshConnection)
openP2PSshConnection r connpool =
openP2PSshConnection' r P2P.maxProtocolVersion >>= \case
openP2PShellConnection :: Remote -> P2PShellConnectionPool -> Annex (Maybe P2PShellConnection)
openP2PShellConnection r connpool =
openP2PShellConnection' r P2P.maxProtocolVersion >>= \case
Just conn -> return (Just conn)
Nothing -> do
liftIO $ rememberunsupported
@ -240,10 +241,10 @@ openP2PSshConnection r connpool =
where
rememberunsupported = atomically $
modifyTVar' connpool $
maybe (Just P2PSshUnsupported) Just
maybe (Just P2PShellUnsupported) Just
openP2PSshConnection' :: Remote -> P2P.ProtocolVersion -> Annex (Maybe P2PSshConnection)
openP2PSshConnection' r maxprotoversion = do
openP2PShellConnection' :: Remote -> P2P.ProtocolVersion -> Annex (Maybe P2PShellConnection)
openP2PShellConnection' r maxprotoversion = do
u <- getUUID
let ps = [Param (fromUUID u)]
repo <- getRepo r
@ -264,7 +265,7 @@ openP2PSshConnection' r maxprotoversion = do
, P2P.connIhdl = to
, P2P.connOhdl = from
, P2P.connIdent = P2P.ConnIdent $
Just $ "ssh connection " ++ show pidnum
Just $ "git-annex-shell connection " ++ show pidnum
}
runst <- P2P.mkRunState P2P.Client
let c = P2P.OpenConnection (runst, conn, pid)
@ -276,7 +277,7 @@ openP2PSshConnection' r maxprotoversion = do
Right (Right (Just theiruuid)) | theiruuid == uuid r ->
return $ Just c
_ -> do
(cclosed, exitcode) <- closeP2PSshConnection c
(cclosed, exitcode) <- closeP2PShellConnection c
-- ssh exits 255 when unable to connect to
-- server.
if exitcode == Just (ExitFailure 255)
@ -285,19 +286,19 @@ openP2PSshConnection' r maxprotoversion = do
-- Runs a P2P Proto action on a remote when it supports that,
-- otherwise the fallback action.
runProto :: Remote -> P2PSshConnectionPool -> Annex a -> P2P.Proto a -> Annex (Maybe a)
runProto :: Remote -> P2PShellConnectionPool -> Annex a -> P2P.Proto a -> Annex (Maybe a)
runProto r connpool onerr proto = Just <$>
(getP2PSshConnection r connpool >>= maybe onerr go)
(getP2PShellConnection r connpool >>= maybe onerr go)
where
go c = do
(c', v) <- runProtoConn proto c
case v of
Just res -> do
liftIO $ storeP2PSshConnection connpool c'
liftIO $ storeP2PShellConnection connpool c'
return res
Nothing -> onerr
runProtoConn :: P2P.Proto a -> P2PSshConnection -> Annex (P2PSshConnection, Maybe a)
runProtoConn :: P2P.Proto a -> P2PShellConnection -> Annex (P2PShellConnection, Maybe a)
runProtoConn _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
runProtoConn a conn@(P2P.OpenConnection (runst, c, _)) = do
P2P.runFullProto runst c a >>= \case
@ -306,24 +307,24 @@ runProtoConn a conn@(P2P.OpenConnection (runst, c, _)) = do
-- usable, so close it.
Left e -> do
warning $ UnquotedString $ "Lost connection (" ++ P2P.describeProtoFailure e ++ ")"
conn' <- fst <$> liftIO (closeP2PSshConnection conn)
conn' <- fst <$> liftIO (closeP2PShellConnection conn)
return (conn', Nothing)
-- Allocates a P2P ssh connection from the pool, and runs the action with it,
-- returning the connection to the pool once the action is done.
-- Allocates a P2P shell connection from the pool, and runs the action with
-- it, returning the connection to the pool once the action is done.
--
-- If the remote does not support the P2P protocol, runs the fallback
-- action instead.
withP2PSshConnection
withP2PShellConnection
:: Remote
-> P2PSshConnectionPool
-> P2PShellConnectionPool
-> Annex a
-> (P2PSshConnection -> Annex (P2PSshConnection, a))
-> (P2PShellConnection -> Annex (P2PShellConnection, a))
-> Annex a
withP2PSshConnection r connpool fallback a = bracketOnError get cache go
withP2PShellConnection r connpool fallback a = bracketOnError get cache go
where
get = getP2PSshConnection r connpool
cache (Just conn) = liftIO $ storeP2PSshConnection connpool conn
get = getP2PShellConnection r connpool
cache (Just conn) = liftIO $ storeP2PShellConnection connpool conn
cache Nothing = return ()
go (Just conn) = do
(conn', res) <- a conn