implement p2p command

2 files changed, 64 insertions, 4 deletions

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