diff options
Diffstat (limited to 'Command/P2P.hs')
-rw-r--r-- | Command/P2P.hs | 81 |
1 files changed, 51 insertions, 30 deletions
diff --git a/Command/P2P.hs b/Command/P2P.hs index ec6e4be96..e2a7ab85d 100644 --- a/Command/P2P.hs +++ b/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) + ] |