From 38f9337e160190823ad929cd368077338314a73c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 16 Dec 2016 18:26:07 -0400 Subject: [PATCH] Revert "p2p --link now defaults to setting up a bi-directional link" This reverts commit 3037feb1bf9ae9c857b45191309965859b23b0b6. On second thought, this was an overcomplication of what should be the lowest-level primitive. Let's build bi-directional links at the pairing level with eg magic wormhole. --- CHANGELOG | 4 -- Command/P2P.hs | 75 +++++++++++++-------- P2P/Address.hs | 5 -- P2P/Annex.hs | 63 ----------------- P2P/Protocol.hs | 16 +---- doc/git-annex-p2p.mdwn | 14 +--- doc/tips/peer_to_peer_network_with_tor.mdwn | 10 +-- 7 files changed, 56 insertions(+), 131 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index c4d3e27128..b4659fa029 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -14,10 +14,6 @@ git-annex (6.20161211) UNRELEASED; urgency=medium be processed without requiring it to be in the current encoding. * p2p: --link no longer takes a remote name, instead the --name option can be used. - * p2p --link now defaults to setting up a bi-directional link; - both the local and remote git repositories get remotes added - pointing at one-another. - * p2p: Added --one-way option. -- Joey Hess Sun, 11 Dec 2016 21:29:51 -0400 diff --git a/Command/P2P.hs b/Command/P2P.hs index 817840d070..d59d774c43 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -10,10 +10,15 @@ module Command.P2P where import Command import P2P.Address import P2P.Auth -import P2P.Annex +import P2P.IO +import qualified P2P.Protocol as P2P import Utility.AuthToken import Git.Types import qualified Git.Remote +import qualified Git.Command +import qualified Annex +import Annex.UUID +import Config cmd :: Command cmd = command "p2p" SectionSetup @@ -24,13 +29,10 @@ data P2POpts = GenAddresses | LinkRemote -data LinkDirection = BiDirectional | OneWay - -optParser :: CmdParamsDesc -> Parser (P2POpts, Maybe RemoteName, LinkDirection) -optParser _ = (,,) +optParser :: CmdParamsDesc -> Parser (P2POpts, Maybe RemoteName) +optParser _ = (,) <$> (genaddresses <|> linkremote) <*> optional name - <*> direction where genaddresses = flag' GenAddresses ( long "gen-addresses" @@ -45,17 +47,23 @@ optParser _ = (,,) <> metavar paramName <> help "name of remote" ) - direction = flag BiDirectional OneWay - ( long "one-way" - <> help "make one-way link, rather than default bi-directional link" - ) -seek :: (P2POpts, Maybe RemoteName, LinkDirection) -> CommandSeek -seek (GenAddresses, _, _) = genAddresses =<< loadP2PAddresses -seek (LinkRemote, Just name, direction) = commandAction $ - linkRemote direction (Git.Remote.makeLegalName name) -seek (LinkRemote, Nothing, direction) = commandAction $ - linkRemote direction =<< unusedPeerRemoteName +seek :: (P2POpts, Maybe RemoteName) -> CommandSeek +seek (GenAddresses, _) = genAddresses =<< loadP2PAddresses +seek (LinkRemote, Just name) = commandAction $ + linkRemote (Git.Remote.makeLegalName name) +seek (LinkRemote, Nothing) = commandAction $ + linkRemote =<< unusedPeerRemoteName + +unusedPeerRemoteName :: Annex RemoteName +unusedPeerRemoteName = go (1 :: Integer) =<< usednames + where + usednames = mapMaybe remoteName . remotes <$> Annex.gitRepo + go n names = do + let name = "peer" ++ show n + if name `elem` names + then go (n+1) names + else return name -- Only addresses are output to stdout, to allow scripting. genAddresses :: [P2PAddress] -> Annex () @@ -69,8 +77,8 @@ genAddresses addrs = do map (`P2PAddressAuth` authtoken) addrs -- Address is read from stdin, to avoid leaking it in shell history. -linkRemote :: LinkDirection -> RemoteName -> CommandStart -linkRemote direction remotename = do +linkRemote :: RemoteName -> CommandStart +linkRemote remotename = do showStart "p2p link" remotename next $ next prompt where @@ -87,13 +95,24 @@ linkRemote direction remotename = do Nothing -> do liftIO $ hPutStrLn stderr "Unable to parse that address, please check its format and try again." prompt - Just addr -> do - linkbackto <- case direction of - OneWay -> return [] - BiDirectional -> do - myaddrs <- loadP2PAddresses - authtoken <- liftIO $ genAuthToken 128 - storeP2PAuthToken authtoken - return $ map (`P2PAddressAuth` authtoken) myaddrs - linkAddress addr linkbackto remotename - >>= either giveup return + Just addr -> setup addr + setup (P2PAddressAuth addr authtoken) = do + g <- Annex.gitRepo + conn <- liftIO $ connectPeer g addr + `catchNonAsync` connerror + u <- getUUID + v <- liftIO $ runNetProto conn $ P2P.auth u authtoken + case v of + Right (Just theiruuid) -> do + ok <- inRepo $ Git.Command.runBool + [ Param "remote", Param "add" + , Param remotename + , Param (formatP2PAddress addr) + ] + when ok $ do + storeUUIDIn (remoteConfig remotename "uuid") theiruuid + storeP2PRemoteAuthToken addr authtoken + return ok + Right Nothing -> giveup "Unable to authenticate with peer. Please check the address and try again." + Left e -> giveup $ "Unable to authenticate with peer: " ++ e + connerror e = giveup $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. (" ++ show e ++ ")" diff --git a/P2P/Address.hs b/P2P/Address.hs index 9197393276..1b1f66059e 100644 --- a/P2P/Address.hs +++ b/P2P/Address.hs @@ -14,7 +14,6 @@ import Git.Types import Creds import Utility.AuthToken import Utility.Tor -import qualified Utility.SimpleProtocol as Proto import qualified Data.Text as T @@ -47,10 +46,6 @@ instance FormatP2PAddress P2PAddress where return (TorAnnex (OnionAddress onionaddr) onionport) | otherwise = Nothing -instance Proto.Serializable P2PAddressAuth where - serialize = formatP2PAddress - deserialize = unformatP2PAddress - torAnnexScheme :: String torAnnexScheme = "tor-annex:" diff --git a/P2P/Annex.hs b/P2P/Annex.hs index 56f94d2bb7..9971762f59 100644 --- a/P2P/Annex.hs +++ b/P2P/Annex.hs @@ -11,8 +11,6 @@ module P2P.Annex ( RunMode(..) , P2PConnection(..) , runFullProto - , unusedPeerRemoteName - , linkAddress ) where import Annex.Common @@ -21,16 +19,9 @@ import Annex.Transfer import Annex.ChangedRefs import P2P.Protocol import P2P.IO -import P2P.Address -import P2P.Auth import Logs.Location import Types.NumCopies import Utility.Metered -import qualified Git.Command -import qualified Annex -import Annex.UUID -import Git.Types (RemoteName, remoteName, remotes) -import Config import Control.Monad.Free @@ -129,17 +120,6 @@ runLocal runmode runner a = case a of Left e -> return (Left (show e)) Right changedrefs -> runner (next changedrefs) _ -> return $ Left "change notification not available" - AddLinkToPeer addr next -> do - v <- tryNonAsync $ do - -- Flood protection; don't let a huge number - -- of peer remotes be created. - ns <- usedPeerRemoteNames - if length ns > 100 - then return $ Right False - else linkAddress addr [] =<< unusedPeerRemoteName - case v of - Right (Right r) -> runner (next r) - _ -> runner (next False) where transfer mk k af ta = case runmode of -- Update transfer logs when serving. @@ -172,46 +152,3 @@ runLocal runmode runner a = case a of liftIO $ hSeek h AbsoluteSeek o b <- liftIO $ hGetContentsMetered h p' runner (sender b) - -unusedPeerRemoteName :: Annex RemoteName -unusedPeerRemoteName = go (1 :: Integer) =<< usedPeerRemoteNames - where - go n names = do - let name = "peer" ++ show n - if name `elem` names - then go (n+1) names - else return name - -usedPeerRemoteNames :: Annex [RemoteName] -usedPeerRemoteNames = filter ("peer" `isPrefixOf`) - . mapMaybe remoteName . remotes <$> Annex.gitRepo - -linkAddress :: P2PAddressAuth -> [P2PAddressAuth] -> RemoteName -> Annex (Either String Bool) -linkAddress (P2PAddressAuth addr authtoken) linkbackto remotename = do - g <- Annex.gitRepo - cv <- liftIO $ tryNonAsync $ connectPeer g addr - case cv of - Left e -> return $ Left $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. (" ++ show e ++ ")" - Right conn -> do - u <- getUUID - v <- liftIO $ runNetProto conn $ do - authresp <- P2P.Protocol.auth u authtoken - lbok <- forM linkbackto $ P2P.Protocol.link - return (authresp, lbok) - case v of - Right (Just theiruuid, lbok) -> do - ok <- inRepo $ Git.Command.runBool - [ Param "remote", Param "add" - , Param remotename - , Param (formatP2PAddress addr) - ] - when ok $ do - storeUUIDIn (remoteConfig remotename "uuid") theiruuid - storeP2PRemoteAuthToken addr authtoken - if not ok - then return $ Right False - else if or lbok || null linkbackto - then return $ Right True - else return $ Left "Linked with peer. However, the peer was unable to link back to us, so the link is one-way." - Right (Nothing, _) -> return $ Left "Unable to authenticate with peer. Please check the address and try again." - Left e -> return $ Left $ "Unable to authenticate with peer: " ++ e diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs index c383fa966d..135409e262 100644 --- a/P2P/Protocol.hs +++ b/P2P/Protocol.hs @@ -14,7 +14,6 @@ module P2P.Protocol where import qualified Utility.SimpleProtocol as Proto import Types.Key import Types.UUID -import P2P.Address import Utility.AuthToken import Utility.Applicative import Utility.PartialPrelude @@ -50,7 +49,6 @@ data Message = AUTH UUID AuthToken -- uuid of the peer that is authenticating | AUTH_SUCCESS UUID -- uuid of the remote peer | AUTH_FAILURE - | LINK P2PAddressAuth -- sending an address that the peer may link to | CONNECT Service | CONNECTDONE ExitCode | NOTIFYCHANGE @@ -71,9 +69,8 @@ data Message instance Proto.Sendable Message where formatMessage (AUTH uuid authtoken) = ["AUTH", Proto.serialize uuid, Proto.serialize authtoken] - formatMessage (AUTH_SUCCESS uuid) = ["AUTH-SUCCESS", Proto.serialize uuid] + formatMessage (AUTH_SUCCESS uuid) = ["AUTH-SUCCESS", Proto.serialize uuid] formatMessage AUTH_FAILURE = ["AUTH-FAILURE"] - formatMessage (LINK addr) = ["LINK", Proto.serialize addr] formatMessage (CONNECT service) = ["CONNECT", Proto.serialize service] formatMessage (CONNECTDONE exitcode) = ["CONNECTDONE", Proto.serialize exitcode] formatMessage NOTIFYCHANGE = ["NOTIFYCHANGE"] @@ -95,7 +92,6 @@ instance Proto.Receivable Message where parseCommand "AUTH" = Proto.parse2 AUTH parseCommand "AUTH-SUCCESS" = Proto.parse1 AUTH_SUCCESS parseCommand "AUTH-FAILURE" = Proto.parse0 AUTH_FAILURE - parseCommand "LINK" = Proto.parse1 LINK parseCommand "CONNECT" = Proto.parse1 CONNECT parseCommand "CONNECTDONE" = Proto.parse1 CONNECTDONE parseCommand "NOTIFYCHANGE" = Proto.parse0 NOTIFYCHANGE @@ -240,8 +236,6 @@ data LocalF c -- with False. | WaitRefChange (ChangedRefs -> c) -- ^ Waits for one or more git refs to change and returns them. - | AddLinkToPeer P2PAddressAuth (Bool -> c) - -- ^ Adds a link to a peer using the provided address. deriving (Functor) type Local = Free LocalF @@ -261,11 +255,6 @@ auth myuuid t = do net $ sendMessage (ERROR "auth failed") return Nothing -link :: P2PAddressAuth -> Proto Bool -link addr = do - net $ sendMessage (LINK addr) - checkSuccess - checkPresent :: Key -> Proto Bool checkPresent key = do net $ sendMessage (CHECKPRESENT key) @@ -365,9 +354,6 @@ serveAuth myuuid = serverLoop handler serveAuthed :: UUID -> Proto () serveAuthed myuuid = void $ serverLoop handler where - handler (LINK addr) = do - sendSuccess =<< local (addLinkToPeer addr) - return ServerContinue handler (LOCKCONTENT key) = do local $ tryLockContent key $ \locked -> do sendSuccess locked diff --git a/doc/git-annex-p2p.mdwn b/doc/git-annex-p2p.mdwn index dcfb36a3f5..6c50c9dd2f 100644 --- a/doc/git-annex-p2p.mdwn +++ b/doc/git-annex-p2p.mdwn @@ -24,26 +24,18 @@ services. * `--link` - Sets up a link with a peer over the P2P network. + Sets up a git remote that is accessed over a P2P network. This will prompt for an address to be entered; you should paste in the address that was generated by --gen-address in the remote repository. - A git remote will be created, with a name like "peer1", "peer2" - by default (the `--name` option can be used to specify the name). - - The link is bi-directional, so the peer will also have a git - remote added to it, linking back to the repository where this is run. + Defaults to making the git remote be named "peer1", "peer2", + etc. This can be overridden with the `--name` option. * `--name` Specify a name to use when setting up a git remote. -* `--one-way` - - Use with `--link` to create a one-way link with a peer, rather than the - default bi-directional link. - # SEE ALSO [[git-annex]](1) diff --git a/doc/tips/peer_to_peer_network_with_tor.mdwn b/doc/tips/peer_to_peer_network_with_tor.mdwn index 13a7f0cc76..9c97735e43 100644 --- a/doc/tips/peer_to_peer_network_with_tor.mdwn +++ b/doc/tips/peer_to_peer_network_with_tor.mdwn @@ -56,12 +56,12 @@ peer1 remote: git annex sync --content peer1 -Any number of peers can be connected this way, within reason. +You can also generate an address for this new peer, by running `git annex +p2p --gen-addresses`, and link other peers to that address using `git annex +p2p --link`. It's often useful to link peers up in both directions, +so peer1 is a remote of peer2 and peer2 is a remote of peer1. -(When the second peer links to it, the first peer also -gets a new remote added to it, which points to the second peer. -So, on the first peer, you can also sync with the second peer. -The name of the that remote will be "peer1", or "peer2", etc.) +Any number of peers can be connected this way, within reason. ## starting git-annex remotedaemon