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
+	linkremote = LinkRemote <$> strOption
-		<$> option readaddr
+		( long "link"
-			( long "link"
+		<> metavar paramRemote
-			<> metavar paramAddress
+		<> help "specify name to use for git remote"
-			<> 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
+seek GenAddresses = genAddresses =<< loadP2PAddresses
-	addrs <- loadP2PAddresses
+seek (LinkRemote name) = commandAction $
-	if null addrs
+	linkRemote (Git.Remote.makeLegalName name)
-		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
 
+-- 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)
+			]

P2P/Auth.hs

@@ -9,7 +9,9 @@ module P2P.Auth where
 
 import Annex.Common
 import Creds
+import P2P.Address
 import Utility.AuthToken
+import Utility.Tor
 
 import qualified Data.Text as T
 
@@ -24,6 +26,7 @@ loadP2PAuthTokens' = mapMaybe toAuthToken
         . fromMaybe []
         <$> readCacheCreds p2pAuthCredsFile
 
+-- | Stores an AuthToken, making it be accepted by this repository.
 storeP2PAuthToken :: AuthToken -> Annex ()
 storeP2PAuthToken t = do
 	ts <- loadP2PAuthTokens'
@@ -33,3 +36,20 @@ storeP2PAuthToken t = do
 
 p2pAuthCredsFile :: FilePath
 p2pAuthCredsFile = "p2pauth"
+
+-- | Loads the AuthToken to use when connecting with a given P2P address.
+loadP2PRemoteAuthToken :: P2PAddress -> Annex (Maybe AuthToken)
+loadP2PRemoteAuthToken addr = maybe Nothing (toAuthToken . T.pack)
+	<$> readCacheCreds (addressCredsFile addr)
+
+-- | Stores the AuthToken o use when connecting with a given P2P address.
+storeP2PRemoteAuthToken :: P2PAddress -> AuthToken -> Annex ()
+storeP2PRemoteAuthToken addr t = writeCacheCreds
+	(T.unpack $ fromAuthToken t)
+	(addressCredsFile addr)
+
+addressCredsFile :: P2PAddress -> FilePath
+-- We can omit the port and just use the onion address for the creds file,
+-- because any given tor hidden service runs on a single port and has a
+-- unique onion address.
+addressCredsFile (TorAnnex (OnionAddress onionaddr) _port) = onionaddr

doc/git-annex-p2p.mdwn

@@ -22,11 +22,13 @@ services.
   over the available P2P networks. The address or addresses is output to
   stdout.
 
-* `--link address --named remotename`
+* `--link remotename`
 
   Sets up a git remote with the specified remotename that is accessed over
-  a P2P network. The address is one generated in the remote repository using
+  a P2P network. 
-  `git annex p2p --gen-address`
+  
+  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.
 
 # SEE ALSO
 

doc/tips/peer_to_peer_network_with_tor.mdwn

@@ -42,16 +42,17 @@ repository:
 	sudo git annex enable-tor
 	git annex remotedaemon
 
-Now, tell the new peer about the address of the first peer:
+Now, tell the new peer about the address of the first peer.
+This will make a git remote named "peer1", which connects,
+through Tor, to the repository on the other peer.
 
-	git annex p2p --link tor-annnex::eeaytkuhaupbarfi.onion:4412:7f53c5b65b8957ef626fd461ceaae8056e3dbc459ae715e4 --named peer1
+	git annex p2p --link peer1
 
-(Of course, you should paste in the address you generated earlier, 
+That command will prompt for an address; paste in the address that was
-not the example one shown above.)
+generated on the first peer, and then press Enter.
 
-Now this git-annex repository will have a remote named "peer1"
+Now you can run any commands you normally would to sync with the
-which connects, through Tor, to the repository on the other peer.
+peer1 remote:
-You can run any commands you normally would to sync with that remote:
 
 	git annex sync --content peer1