implement p2p command

This commit is contained in:
Joey Hess 2016-11-30 14:35:24 -04:00
parent ac0cb5c2cc
commit bfc8305814
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
10 changed files with 110 additions and 33 deletions

View file

@ -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

61
Command/P2P.hs Normal file
View file

@ -0,0 +1,61 @@
{- git-annex command
-
- Copyright 2016 Joey Hess <id@joeyh.name>
-
- 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