diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs index d5effb4126..e4709ab82a 100644 --- a/Command/P2PStdIO.hs +++ b/Command/P2PStdIO.hs @@ -15,7 +15,7 @@ import qualified P2P.Protocol as P2P import qualified Annex import Annex.UUID import qualified CmdLine.GitAnnexShell.Checks as Checks -import Remote.Helper.Ssh (openP2PSshConnection', closeP2PSshConnection) +import Remote.Helper.Ssh (openP2PShellConnection', closeP2PShellConnection) import System.IO.Error @@ -72,12 +72,12 @@ performProxy clientuuid servermode remote = do othermsg protoerrhandler withclientversion _ Nothing = done - -- FIXME: Support special remotes and non-ssh git remotes. + -- FIXME: Support special remotes. connectremote clientmaxversion cont = - openP2PSshConnection' remote clientmaxversion >>= \case + openP2PShellConnection' remote clientmaxversion >>= \case Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) -> cont (RemoteSide remoterunst remoteconn) - `finally` liftIO (closeP2PSshConnection conn) + `finally` liftIO (closeP2PShellConnection conn) _ -> giveup "Unable to connect to remote." protoerrhandler cont a = a >>= \case diff --git a/Remote/Git.hs b/Remote/Git.hs index f1e54617a4..60382f1563 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -472,7 +472,7 @@ lockKey' repo r st@(State connpool duc _ _ _) key callback ) | Git.repoIsSsh repo = do showLocking r - let withconn = Ssh.withP2PSshConnection r connpool failedlock + let withconn = Ssh.withP2PShellConnection r connpool failedlock P2PHelper.lock withconn Ssh.runProtoConn (uuid r) key callback | otherwise = failedlock where @@ -733,7 +733,7 @@ mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do - This returns False when the repository UUID is not as expected. -} type DeferredUUIDCheck = Annex Bool -data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck CopyCoWTried (Annex (Git.Repo, GitConfig)) LocalRemoteAnnex +data State = State Ssh.P2PShellConnectionPool DeferredUUIDCheck CopyCoWTried (Annex (Git.Repo, GitConfig)) LocalRemoteAnnex getRepoFromState :: State -> Annex Git.Repo getRepoFromState (State _ _ _ a _) = fst <$> a @@ -746,7 +746,7 @@ getGitConfigFromState (State _ _ _ a _) = snd <$> a mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State mkState r u gc = do - pool <- Ssh.mkP2PSshConnectionPool + pool <- Ssh.mkP2PShellConnectionPool copycowtried <- liftIO newCopyCoWTried lra <- mkLocalRemoteAnnex r (duc, getrepo) <- go diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 787bc1824f..ccf26ae692 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -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 diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index 5b5df34107..d6e5fcb80a 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -36,13 +36,18 @@ For June's work on [[design/passthrough_proxy]], implementation plan: 2. Remote instantiation for proxies. (done) +4. Prevent listProxied from listing anything when the proxy remote's + url is a local directory. Proxying does not work in that situation, + because the proxied remotes have the same url, and so git-annex-shell + is not run when accessing them, instead the proxy remote is accessed + directly. + 3. Implement git-annex-shell proxying for CONNECT and NOTIFYCHANGES. (For completeness, they will only be used when using tor-annex to access a proxy.) -4. Either implement proxying for local path remotes, or prevent - listProxied from operating on them. Currently it seems to work, - but doesn't work right. +3. Proxy should update location tracking information for proxied remotes, + so it is available to other users who sync with it. 4. Either implement proxying for tor-annex remotes, or prevent listProxied from operating on them.