finish git-annex enable-tor

Make it stash the address away for git-annex p2p to use later, rather
than outputting it. And, look up the UUID itself.
This commit is contained in:
Joey Hess 2016-11-29 17:30:27 -04:00
parent 398345cb26
commit 38425fdc39
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
6 changed files with 106 additions and 26 deletions

View file

@ -8,27 +8,28 @@
module Command.EnableTor where
import Command
import P2P.Address
import Utility.Tor
import Annex.UUID
-- This runs as root, so avoid making any commits or initializing
-- git-annex, as that would create root-owned files.
-- git-annex, or doing other things that create root-owned files.
cmd :: Command
cmd = noCommit $ dontCheck repoExists $
command "enable-tor" SectionSetup ""
"userid uuid" (withParams seek)
command "enable-tor" SectionSetup "enable tor hidden service"
"uid" (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: CmdParams -> CommandStart
start (suserid:uuid:[]) = case readish suserid of
Nothing -> error "Bad userid"
start :: [String] -> CommandStart
start ps = case readish =<< headMaybe ps of
Nothing -> giveup "Bad params"
Just userid -> do
(OnionAddress onionaddr, onionport) <- liftIO $
addHiddenService userid uuid
liftIO $ putStrLn $
"tor-annex::" ++
onionaddr ++ ":" ++
show onionport ++ " "
uuid <- getUUID
when (uuid == NoUUID) $
giveup "This can only be run in a git-annex repository."
(onionaddr, onionport) <- liftIO $
addHiddenService userid (fromUUID uuid)
storeP2PAddress $ TorAnnex onionaddr onionport
stop
start _ = error "Bad params"

View file

@ -15,6 +15,7 @@ module Creds (
getEnvCredPair,
writeCacheCreds,
readCacheCreds,
cacheCredsFile,
removeCreds,
includeCredsInfo,
) where

79
P2P/Address.hs Normal file
View file

@ -0,0 +1,79 @@
{- P2P protocol addresses
-
- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module P2P.Address where
import qualified Annex
import Annex.Common
import Git
import Creds
import Utility.AuthToken
import Utility.Tor
import qualified Data.Text as T
-- | A P2P address, without an AuthToken.
--
-- This is enough information to connect to the peer,
-- but not enough to authenticate with it.
data P2PAddress = TorAnnex OnionAddress OnionPort
deriving (Eq, Show)
-- | A P2P address, with an AuthToken
data P2PAddressAuth = P2PAddressAuth P2PAddress AuthToken
deriving (Eq, Show)
class FormatP2PAddress a where
formatP2PAddress :: a -> String
unformatP2PAddress :: String -> Maybe a
instance FormatP2PAddress P2PAddress where
formatP2PAddress (TorAnnex (OnionAddress onionaddr) onionport) =
"tor-annex::" ++ onionaddr ++ ":" ++ show onionport
unformatP2PAddress s
| "tor-annex::" `isPrefixOf` s = do
let s' = dropWhile (== ':') $ dropWhile (/= ':') s
let (onionaddr, ps) = separate (== ':') s'
onionport <- readish ps
return (TorAnnex (OnionAddress onionaddr) onionport)
| otherwise = Nothing
instance FormatP2PAddress P2PAddressAuth where
formatP2PAddress (P2PAddressAuth addr authtoken) =
formatP2PAddress addr ++ ":" ++ T.unpack (fromAuthToken authtoken)
unformatP2PAddress s = do
let (ra, rs) = separate (== ':') (reverse s)
addr <- unformatP2PAddress (reverse rs)
authtoken <- toAuthToken (T.pack $ reverse ra)
return (P2PAddressAuth addr authtoken)
loadP2PAddresses :: Annex [P2PAddress]
loadP2PAddresses = mapMaybe unformatP2PAddress . maybe [] lines
<$> readCacheCreds p2pAddressCredsFile
storeP2PAddress :: P2PAddress -> Annex ()
storeP2PAddress addr = do
addrs <- loadP2PAddresses
unless (addr `elem` addrs) $ do
let s = unlines $ map formatP2PAddress (addr:addrs)
let tmpnam = p2pAddressCredsFile ++ ".new"
writeCacheCreds s tmpnam
tmpf <- cacheCredsFile tmpnam
destf <- cacheCredsFile p2pAddressCredsFile
-- This may be run by root, so make the creds file
-- and directory have the same owner and group as
-- the git repository directory has.
st <- liftIO . getFileStatus =<< Annex.fromRepo repoLocation
let fixowner f = setOwnerAndGroup f (fileOwner st) (fileGroup st)
liftIO $ do
fixowner tmpf
fixowner (takeDirectory tmpf)
fixowner (takeDirectory (takeDirectory tmpf))
renameFile tmpf destf
p2pAddressCredsFile :: FilePath
p2pAddressCredsFile = "p2paddrs"

View file

@ -21,7 +21,7 @@ import qualified System.Random as R
type OnionPort = Int
newtype OnionAddress = OnionAddress String
deriving (Show)
deriving (Show, Eq)
type OnionSocket = FilePath
@ -57,7 +57,7 @@ addHiddenService uid ident = do
case filter (\(_, s) -> s == sockfile) portssocks of
((p, _s):_) -> waithiddenservice 1 p
_ -> do
highports <- R.getStdRandom highports
highports <- R.getStdRandom mkhighports
let newport = Prelude.head $
filter (`notElem` map fst portssocks) highports
writeFile torrc $ unlines $
@ -74,7 +74,7 @@ addHiddenService uid ident = do
, ("sefvice", [Param "tor", Param "reload"])
]
unless reloaded $
error "failed to reload tor, perhaps the tor service is not running"
giveup "failed to reload tor, perhaps the tor service is not running"
waithiddenservice 120 newport
where
parseportsock ("HiddenServicePort", l) = do
@ -85,12 +85,12 @@ addHiddenService uid ident = do
sockfile = hiddenServiceSocketFile uid ident
-- An infinite random list of high ports.
highports g =
mkhighports g =
let (g1, g2) = R.split g
in (R.randomRs (1025, 65534) g1, g2)
waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort)
waithiddenservice 0 _ = error "tor failed to create hidden service, perhaps the tor service is not running"
waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running"
waithiddenservice n p = do
v <- tryIO $ readFile $ hiddenServiceHostnameFile uid ident
case v of

View file

@ -4,20 +4,18 @@ git-annex enable-tor - enable tor hidden service
# SYNOPSIS
git annex enable-tor userid uuid
sudo git annex enable-tor $(id -u)
# DESCRIPTION
This plumbing-level command enables a tor hidden service for git-annex,
using the specified repository uuid and userid.
This command enables a tor hidden service for git-annex.
This command has to be run by root, since it modifies `/etc/tor/torrc`.
It has to be run by root, since it modifies `/etc/tor/torrc`.
Pass it your user id number, as output by `id -u`
After this command is run, `git annex remotedaemon` can be run to serve the
tor hidden service.
Use the `git-annex p2p --gen-address` command to give other users access
to your repository via the tor hidden service.
tor hidden service, and then `git-annex p2p --gen-address` can be run to
give other users access to your repository via the tor hidden service.
# SEE ALSO

View file

@ -904,6 +904,7 @@ Executable git-annex
Messages.Internal
Messages.JSON
Messages.Progress
P2P.Address
P2P.Auth
P2P.IO
P2P.Protocol