From 66b3af4aa5c3bbb53fc27b25303c4e69364930f5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Nov 2016 14:35:24 -0400 Subject: implement p2p command --- Command/EnableRemote.hs | 7 +++--- Command/P2P.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+), 4 deletions(-) create mode 100644 Command/P2P.hs (limited to 'Command') diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index e1af8bb7a..61cd543e6 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -12,6 +12,7 @@ import qualified Annex import qualified Logs.Remote import qualified Types.Remote as R import qualified Git +import qualified Git.Types as Git import qualified Annex.SpecialRemote import qualified Remote import qualified Types.Remote as Remote @@ -40,9 +41,7 @@ start (name:rest) = go =<< filter matchingname <$> Annex.fromRepo Git.remotes =<< Annex.SpecialRemote.findExisting name go (r:_) = startNormalRemote name r -type RemoteName = String - -startNormalRemote :: RemoteName -> Git.Repo -> CommandStart +startNormalRemote :: Git.RemoteName -> Git.Repo -> CommandStart startNormalRemote name r = do showStart "enableremote" name next $ next $ do @@ -51,7 +50,7 @@ startNormalRemote name r = do u <- getRepoUUID r' return $ u /= NoUUID -startSpecialRemote :: RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart +startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart startSpecialRemote name config Nothing = do m <- Annex.SpecialRemote.specialRemoteMap confm <- Logs.Remote.readRemoteLog diff --git a/Command/P2P.hs b/Command/P2P.hs new file mode 100644 index 000000000..ec6e4be96 --- /dev/null +++ b/Command/P2P.hs @@ -0,0 +1,61 @@ +{- git-annex command + - + - Copyright 2016 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.P2P where + +import Command +import Git.Types +import P2P.Address +import P2P.Auth +import Utility.AuthToken + +cmd :: Command +cmd = command "p2p" SectionSetup + "configure peer-2-peer links between repositories" + paramNothing (seek <$$> optParser) + +data P2POpts + = GenAddresses + | LinkRemote P2PAddressAuth RemoteName + +optParser :: CmdParamsDesc -> Parser P2POpts +optParser _ = genaddresses <|> linkremote + where + genaddresses = flag' GenAddresses + ( long "gen-addresses" + <> help "generate addresses that allow accessing this repository over P2P networks" + ) + linkremote = LinkRemote + <$> option readaddr + ( long "link" + <> metavar paramAddress + <> help "address of the peer to link with" + ) + <*> strOption + ( long "named" + <> metavar paramRemote + <> help "specify name to use for git remote" + ) + readaddr = eitherReader $ maybe (Left "address parse error") Right + . unformatP2PAddress + +seek :: P2POpts -> CommandSeek +seek GenAddresses = do + addrs <- loadP2PAddresses + if null addrs + then giveup "No P2P networks are currrently available." + else do + authtoken <- liftIO $ genAuthToken 128 + storeP2PAuthToken authtoken + -- Only addresses are output to stdout, to allow + -- scripting. + earlyWarning "These addresses allow access to this git-annex repository. Only share them with people you trust with that access, using trusted communication channels!" + liftIO $ putStr $ unlines $ + map formatP2PAddress $ + map (`P2PAddressAuth` authtoken) addrs +seek (LinkRemote addr name) = do + -- cgit v1.2.3