implement p2p --link

This commit was sponsored by Riku Voipio.

Command/P2P.hs

@@ -8,10 +8,12 @@
 module Command.P2P where
 
 import Command
-import Git.Types
 import P2P.Address
 import P2P.Auth
 import Utility.AuthToken
+import Git.Types
+import qualified Git.Remote
+import qualified Git.Command
 
 cmd :: Command
 cmd = command "p2p" SectionSetup
@@ -20,7 +22,7 @@ cmd = command "p2p" SectionSetup
 
 data P2POpts
 	= GenAddresses
-	| LinkRemote P2PAddressAuth RemoteName
+	| LinkRemote RemoteName
 
 optParser :: CmdParamsDesc -> Parser P2POpts 
 optParser _ = genaddresses <|> linkremote
@@ -29,33 +31,52 @@ optParser _ = genaddresses <|> linkremote
 		( 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
+	linkremote = LinkRemote <$> strOption
+		( long "link"
+		<> metavar paramRemote
+		<> help "specify name to use for git remote"
+		)
 
 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
-	
+seek GenAddresses = genAddresses =<< loadP2PAddresses
+seek (LinkRemote name) = commandAction $
+	linkRemote (Git.Remote.makeLegalName name)
+
+-- Only addresses are output to stdout, to allow scripting.
+genAddresses :: [P2PAddress] -> Annex ()
+genAddresses [] = giveup "No P2P networks are currrently available."
+genAddresses addrs = do
+	authtoken <- liftIO $ genAuthToken 128
+	storeP2PAuthToken authtoken
+	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
+
+-- Address is read from stdin, to avoid leaking it in shell history.
+linkRemote :: RemoteName -> CommandStart
+linkRemote remotename = do
+	showStart "p2p link" remotename
+	next $ next prompt
+  where
+	prompt = do
+		liftIO $ putStrLn ""
+		liftIO $ putStr "Enter address: "
+		liftIO $ hFlush stdout
+		s <- liftIO getLine
+		if null s
+			then do
+				liftIO $ hPutStrLn stderr "Nothing entered, giving up."
+				return False
+			else case unformatP2PAddress s of
+				Nothing -> do
+					liftIO $ hPutStrLn stderr "Unable to parse that address, please check its format and try again."
+					prompt
+				Just addr -> setup addr
+	setup (P2PAddressAuth addr authtoken) = do
+		storeP2PRemoteAuthToken addr authtoken
+		inRepo $ Git.Command.runBool
+			[ Param "remote", Param "add"
+			, Param remotename
+			, Param (formatP2PAddress addr)
+			]