Almost working, but there's a bug in the relaying.
Also, made tor hidden service setup pick a random port, to make it harder
to port scan.
This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
else return (Just dest)
isManSrc :: FilePath -> Bool
-isManSrc s = "git-annex" `isPrefixOf` (takeFileName s)
- && takeExtension s == ".mdwn"
+isManSrc s
+ | not (takeExtension s == ".mdwn") = False
+ | otherwise = "git-annex" `isPrefixOf` f || "git-remote-" `isPrefixOf` f
+ where
+ f = takeFileName s
srcToDest :: FilePath -> FilePath
srcToDest s = "man" </> progName s ++ ".1"
* enable-tor: New command, enables tor hidden service for P2P syncing.
* remotedaemon: Serve tor hidden service.
+ * Added git-remote-tor-annex, which allows git pull and push to the tor
+ hidden service.
* remotedaemon: Fork to background by default. Added --foreground switch
to enable old behavior.
--- /dev/null
+{- git-remote-tor-annex program
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.GitRemoteTorAnnex where
+
+import Common
+import qualified Annex
+import qualified Git.CurrentRepo
+import Remote.Helper.P2P
+import Remote.Helper.P2P.IO
+import Remote.Helper.Tor
+import Utility.Tor
+import Annex.UUID
+
+run :: [String] -> IO ()
+run (_remotename:address:[]) = forever $ do
+ -- gitremote-helpers protocol
+ l <- getLine
+ case l of
+ "capabilities" -> do
+ putStrLn "connect"
+ putStrLn ""
+ "connect git-upload-pack" -> go UploadPack
+ "connect git-receive-pack" -> go ReceivePack
+ _ -> error $ "git-remote-helpers protocol error at " ++ show l
+ where
+ (onionaddress, onionport)
+ | '/' `elem` address = parseAddressPort $
+ reverse $ takeWhile (/= '/') $ reverse address
+ | otherwise = parseAddressPort address
+ go service = do
+ putStrLn ""
+ hFlush stdout
+ connectService onionaddress onionport service >>= exitWith
+run (_remotename:[]) = giveup "remote address not configured"
+run _ = giveup "expected remote name and address parameters"
+
+parseAddressPort :: String -> (OnionAddress, OnionPort)
+parseAddressPort s =
+ let (a, sp) = separate (== ':') s
+ in case readish sp of
+ Nothing -> giveup "onion address must include port number"
+ Just p -> (OnionAddress a, p)
+
+connectService :: OnionAddress -> OnionPort -> Service -> IO ExitCode
+connectService address port service = do
+ state <- Annex.new =<< Git.CurrentRepo.get
+ Annex.eval state $ do
+ authtoken <- fromMaybe nullAuthToken
+ <$> getTorAuthToken address
+ myuuid <- getUUID
+ g <- Annex.gitRepo
+ h <- liftIO $ torHandle =<< connectHiddenService address port
+ runNetProtoHandle h h g $ do
+ v <- auth myuuid authtoken
+ case v of
+ Just _theiruuid -> connect service stdin stdout
+ Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ torAuthTokenEnv
start (suserid:uuid:[]) = case readish suserid of
Nothing -> error "Bad userid"
Just userid -> do
- (onionaddr, onionport, onionsocket) <- liftIO $
+ (OnionAddress onionaddr, onionport) <- liftIO $
addHiddenService userid uuid
- liftIO $ putStrLn $
+ liftIO $ putStrLn $
+ "tor-annex::" ++
onionaddr ++ ":" ++
- show onionport ++ " " ++
- show onionsocket
+ show onionport ++ " "
stop
start _ = error "Bad params"
install -d $(DESTDIR)$(PREFIX)/bin
install git-annex $(DESTDIR)$(PREFIX)/bin
ln -sf git-annex $(DESTDIR)$(PREFIX)/bin/git-annex-shell
+ ln -sf git-annex $(DESTDIR)$(PREFIX)/bin/git-remote-tor-annex
install-misc: Build/InstallDesktopFile
./Build/InstallDesktopFile $(PREFIX)/bin/git-annex || true
cp git-annex "$(LINUXSTANDALONE_DEST)/bin/"
strip "$(LINUXSTANDALONE_DEST)/bin/git-annex"
ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell"
+ ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-remote-tor-annex"
zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE
cp doc/logo_16x16.png doc/logo.svg $(LINUXSTANDALONE_DEST)
cp standalone/trustedkeys.gpg $(LINUXSTANDALONE_DEST)
cp git-annex "$(OSXAPP_BASE)"
strip "$(OSXAPP_BASE)/git-annex"
ln -sf git-annex "$(OSXAPP_BASE)/git-annex-shell"
+ ln -sf git-annex "$(OSXAPP_BASE)/git-remote-tor-annex"
gzcat standalone/licences.gz > $(OSXAPP_BASE)/LICENSE
cp $(OSXAPP_BASE)/LICENSE tmp/build-dmg/LICENSE.txt
cp standalone/trustedkeys.gpg $(OSXAPP_DEST)/Contents/MacOS
newtype AuthToken = AuthToken String
deriving (Show)
+mkAuthToken :: String -> Maybe AuthToken
+mkAuthToken = fmap AuthToken . headMaybe . lines
+
+nullAuthToken :: AuthToken
+nullAuthToken = AuthToken ""
+
newtype Offset = Offset Integer
deriving (Show)
data RelayData
= RelayData L.ByteString
| RelayMessage Message
+ deriving (Show)
newtype RelayHandle = RelayHandle Handle
return Nothing
relayCallback _ (RelayMessage (CONNECTDONE exitcode)) =
return (Just exitcode)
-relayCallback _ (RelayMessage _) = do
- sendMessage (ERROR "expected DATA or CONNECTDONE")
+relayCallback _ (RelayMessage m) = do
+ sendMessage $ ERROR $ "expected DATA or CONNECTDONE not " ++ unwords (Proto.formatMessage m)
return (Just (ExitFailure 1))
relayCallback _ (RelayData b) = do
let len = Len $ fromIntegral $ L.length b
import Git.Command
import Utility.SafeCommand
import Utility.SimpleProtocol
+import Utility.Exception
import Control.Monad
import Control.Monad.Free
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
-type RunProto = forall a m. MonadIO m => Proto a -> m a
+type RunProto = forall a m. (MonadIO m, MonadMask m) => Proto a -> m a
data S = S
{ repo :: Repo
-- Implementation of the protocol, communicating with a peer
-- over a Handle. No Local actions will be run.
-runNetProtoHandle :: MonadIO m => Handle -> Handle -> Repo -> Proto a -> m a
+runNetProtoHandle :: (MonadIO m, MonadMask m) => Handle -> Handle -> Repo -> Proto a -> m a
runNetProtoHandle i o r = go
where
go :: RunProto
go (Free (Net n)) = runNetHandle (S r i o) go n
go (Free (Local _)) = error "local actions not allowed"
-runNetHandle :: MonadIO m => S -> RunProto -> NetF (Proto a) -> m a
+runNetHandle :: (MonadIO m, MonadMask m) => S -> RunProto -> NetF (Proto a) -> m a
runNetHandle s runner f = case f of
SendMessage m next -> do
liftIO $ do
runner next
ReceiveMessage next -> do
l <- liftIO $ hGetLine (ihdl s)
+ -- liftIO $ hPutStrLn stderr ("< " ++ show l)
case parseMessage l of
Just m -> runner (next m)
Nothing -> runner $ do
- let e = ERROR "protocol parse error"
+ let e = ERROR $ "protocol parse error: " ++ show l
net $ sendMessage e
next e
SendBytes _len b next -> do
runner next
ReceiveBytes (Len n) next -> do
b <- liftIO $ L.hGet (ihdl s) (fromIntegral n)
+ --liftIO $ hPutStrLn stderr $ "!!!" ++ show (L.length b)
runner (next b)
CheckAuthToken u t next -> do
authed <- return True -- TODO XXX FIXME really check
runRelayService s runner service callback >>= runner . next
WriteRelay (RelayHandle h) b next -> do
liftIO $ do
- L.hPut h b
+ -- L.hPut h b
+ hPutStrLn h (show ("relay got:", b, L.length b))
hFlush h
runner next
drain v = do
d <- takeMVar v
+ liftIO $ hPutStrLn stderr (show d)
r <- runner $ net $ callback d
case r of
Nothing -> drain v
Just exitcode -> return exitcode
runRelayService
- :: MonadIO m
+ :: (MonadIO m, MonadMask m)
=> S
-> RunProto
-> Service
-> (RelayHandle -> RelayData -> Net (Maybe ExitCode))
-> m ExitCode
-runRelayService s runner service callback = do
- v <- liftIO newEmptyMVar
- (Just hin, Just hout, _, pid) <- liftIO $ createProcess serviceproc
- { std_out = CreatePipe
- , std_in = CreatePipe
- }
- _ <- liftIO $ forkIO $ readout v hout
- feeder <- liftIO $ forkIO $ feedin v
- _ <- liftIO $ forkIO $ putMVar v . Left =<< waitForProcess pid
- exitcode <- liftIO $ drain v hin
- liftIO $ killThread feeder
- return exitcode
+runRelayService s runner service callback = bracket setup cleanup go
where
cmd = case service of
UploadPack -> "upload-pack"
ReceivePack -> "receive-pack"
- serviceproc = gitCreateProcess [Param cmd, File (repoPath (repo s))] (repo s)
+
+ serviceproc = gitCreateProcess
+ [ Param cmd
+ , File (repoPath (repo s))
+ ] (repo s)
+
+ setup = do
+ v <- liftIO newEmptyMVar
+ (Just hin, Just hout, _, pid) <- liftIO $
+ createProcess serviceproc
+ { std_out = CreatePipe
+ , std_in = CreatePipe
+ }
+ feeder <- liftIO $ forkIO $ feedin v
+ return (v, feeder, hin, hout, pid)
+
+ cleanup (_, feeder, hin, hout, pid) = liftIO $ do
+ hClose hin
+ hClose hout
+ liftIO $ killThread feeder
+ void $ waitForProcess pid
+
+ go (v, _, hin, hout, pid) = do
+ _ <- liftIO $ forkIO $ readout v hout
+ _ <- liftIO $ forkIO $ putMVar v . Left =<< waitForProcess pid
+ liftIO $ drain v hin
drain v hin = do
d <- takeMVar v
case d of
- Left exitcode -> do
- hClose hin
- return exitcode
+ Left exitcode -> return exitcode
Right relaydata -> do
+ liftIO $ hPutStrLn stderr ("> " ++ show relaydata)
_ <- runner $ net $
callback (RelayHandle hin) relaydata
drain v hin
readout v hout = do
b <- B.hGetSome hout 65536
if B.null b
- then hClose hout
+ then return ()
else do
putMVar v $ Right $
RelayData (L.fromChunks [b])
--- /dev/null
+{- Helpers for tor remotes.
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Tor where
+
+import Annex.Common
+import Remote.Helper.P2P (mkAuthToken, AuthToken)
+import Creds
+import Utility.Tor
+import Utility.Env
+
+import Network.Socket
+
+getTorAuthToken :: OnionAddress -> Annex (Maybe AuthToken)
+getTorAuthToken (OnionAddress onionaddress) =
+ maybe Nothing mkAuthToken <$> getM id
+ [ liftIO $ getEnv torAuthTokenEnv
+ , readCacheCreds onionaddress
+ ]
+
+torAuthTokenEnv :: String
+torAuthTokenEnv = "GIT_ANNEX_TOR_AUTHTOKEN"
+
+torHandle :: Socket -> IO Handle
+torHandle s = do
+ h <- socketToHandle s ReadWriteMode
+ hSetBuffering h LineBuffering
+ hSetBinaryMode h False
+ fileEncoding h
+ return h
import RemoteDaemon.Common
import Utility.Tor
import Utility.FileMode
+import Remote.Helper.Tor
import Remote.Helper.P2P
import Remote.Helper.P2P.IO
import Annex.UUID
(conn, _) <- accept soc
forkIO $ do
debugM "remotedaemon" "handling a connection"
- h <- socketToHandle conn ReadWriteMode
- hSetBuffering h LineBuffering
- hSetBinaryMode h False
+ h <- torHandle conn
runNetProtoHandle h h r (serve u)
hClose h
-
myPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
myPostCopy _ flags pkg lbi = when (System.Info.os /= "mingw32") $ do
- installGitAnnexShell dest verbosity pkg lbi
+ installGitAnnexLinks dest verbosity pkg lbi
installManpages dest verbosity pkg lbi
installDesktopFile dest verbosity pkg lbi
where
dest = fromFlag $ copyDest flags
verbosity = fromFlag $ copyVerbosity flags
-installGitAnnexShell :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-installGitAnnexShell copyDest verbosity pkg lbi =
+installGitAnnexLinks :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
+installGitAnnexLinks copyDest verbosity pkg lbi = do
rawSystemExit verbosity "ln"
["-sf", "git-annex", dstBinDir </> "git-annex-shell"]
+ rawSystemExit verbosity "ln"
+ ["-sf", "git-annex", dstBinDir </> "git-remote-tor-annex"]
where
dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest
type CredPair = (Login, Password)
type Login = String
-type Password = String -- todo: use securemem
+type Password = String
import Utility.ThreadScheduler
import System.PosixCompat.Types
import Data.Char
+import Network.Socket
+import Network.Socks5
+import qualified Data.ByteString.UTF8 as BU8
+import qualified System.Random as R
type OnionPort = Int
-type OnionAddress = String
+newtype OnionAddress = OnionAddress String
type OnionSocket = FilePath
type UniqueIdent = String
+connectHiddenService :: OnionAddress -> OnionPort -> IO Socket
+connectHiddenService (OnionAddress address) port = do
+ soc <- socket AF_UNIX Stream defaultProtocol
+ connect soc (SockAddrUnix "/run/user/1000/1ecd1f64-3234-47ec-876c-47c4bd7f7407.sock")
+ return soc
+
+connectHiddenService' :: OnionAddress -> OnionPort -> IO Socket
+connectHiddenService' (OnionAddress address) port = do
+ (s, _) <- socksConnect torsockconf socksaddr
+ return s
+ where
+ torsocksport = 9050
+ torsockconf = defaultSocksConf "127.0.0.1" torsocksport
+ socksdomain = SocksAddrDomainName (BU8.fromString address)
+ socksaddr = SocksAddress socksdomain (fromIntegral port)
+
-- | Adds a hidden service connecting to localhost, using some kind
-- of unique identifier.
--
-- This will only work if run as root, and tor has to already be running.
--
--- Picks a port number for the hidden service that is not used by any
--- other hidden service (and is >= 1024). Returns the hidden service's
+-- Picks a random high port number for the hidden service that is not
+-- used by any other hidden service. Returns the hidden service's
-- onion address, port, and the unix socket file to use.
--
-- If there is already a hidden service for the specified unique
-- identifier, returns its information without making any changes.
-addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort, OnionSocket)
+addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
addHiddenService uid ident = do
ls <- lines <$> readFile torrc
let portssocks = mapMaybe (parseportsock . separate isSpace) ls
case filter (\(_, s) -> s == sockfile) portssocks of
((p, _s):_) -> waithiddenservice 1 p
_ -> do
+ highports <- R.getStdRandom highports
let newport = Prelude.head $
- filter (`notElem` map fst portssocks) [1024..]
+ filter (`notElem` map fst portssocks) highports
writeFile torrc $ unlines $
ls ++
[ ""
sockfile = socketFile uid ident
- waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort, OnionSocket)
+ -- An infinite random list of high ports.
+ highports 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 n p = do
v <- tryIO $ readFile $ hiddenServiceHostnameFile uid ident
case v of
Right s | ".onion\n" `isSuffixOf` s ->
- return (takeWhile (/= '\n') s, p, sockfile)
+ return (OnionAddress (takeWhile (/= '\n') s), p)
_ -> do
threadDelaySeconds (Seconds 1)
waithiddenservice (n-1) p
libghc-disk-free-space-dev,
libghc-mountpoints-dev,
libghc-magic-dev,
+ libghc-socks-dev,
lsof [linux-any],
ikiwiki,
libimage-magick-perl,
This plumbing-level command enables a tor hidden service for git-annex,
using the specified repository uuid and userid.
-It outputs to stdout a line of the form "address.onion:onionport socketfile"
+It outputs the address of the hidden service to stdout.
This command has to be run by root, since it modifies `/etc/tor/torrc`.
--- /dev/null
+# NAME
+
+git-remote-tor-annex - remote helper program to talk to git-annex over tor
+
+# SYNOPSIS
+
+git fetch tor-annex::address.onion:port
+
+git remote add tor tor-annex::address.onion:port
+
+# DESCRIPTION
+
+This is a git remote helper program that allows git to pull and push
+over tor(1), communicating with a tor hidden service.
+
+The tor hidden service probably requires an authtoken to use it.
+The authtoken can be provided in the environment variable
+`GIT_ANNEX_TOR_AUTHTOKEN`. Or, if there is a file in
+`.git/annex/creds/` matching the onion address of the hidden
+service, its first line is used as the authtoken.
+
+# SEE ALSO
+
+git-remote-helpers(1)
+
+[[git-annex]](1)
+
+[[git-annex-enable-tor]](1)
+
+[[git-annex-remotedaemon]](1)
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.
doc/git-annex-dropunused.mdwn
doc/git-annex-edit.mdwn
doc/git-annex-enableremote.mdwn
+ doc/git-annex-enable-tor.mdwn
doc/git-annex-examinekey.mdwn
doc/git-annex-expire.mdwn
doc/git-annex-find.mdwn
doc/git-annex-webapp.mdwn
doc/git-annex-whereis.mdwn
doc/git-annex-xmppgit.mdwn
+ doc/git-remote-tor-annex.mdwn
doc/logo.svg
doc/logo_16x16.png
Build/mdwn2man
aeson,
unordered-containers,
feed,
- regex-tdfa
+ regex-tdfa,
+ socks
CC-Options: -Wall
GHC-Options: -Wall -fno-warn-tabs
Extensions: PackageImports
CmdLine.GitAnnexShell.Fields
CmdLine.GlobalSetter
CmdLine.Option
+ CmdLine.GitRemoteTorAnnex
CmdLine.Seek
CmdLine.Usage
Command
Remote.Helper.ReadOnly
Remote.Helper.Special
Remote.Helper.Ssh
+ Remote.Helper.Tor
Remote.Hook
Remote.List
Remote.Rsync
{- git-annex main program dispatch
-
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
import qualified CmdLine.GitAnnex
import qualified CmdLine.GitAnnexShell
+import qualified CmdLine.GitRemoteTorAnnex
import qualified Test
#ifdef mingw32_HOST_OS
main :: IO ()
main = withSocketsDo $ do
ps <- getArgs
- run ps =<< getProgName
- where
- run ps n
- | isshell n = CmdLine.GitAnnexShell.run ps
- | otherwise =
#ifdef mingw32_HOST_OS
- do
- winEnv
- gitannex ps
-#else
- gitannex ps
+ winEnv
#endif
- gitannex = CmdLine.GitAnnex.run Test.optParser Test.runner
- isshell n = takeFileName n == "git-annex-shell"
+ run ps =<< getProgName
+ where
+ run ps n = case takeFileName n of
+ "git-annex-shell" -> CmdLine.GitAnnexShell.run ps
+ "git-remote-tor-annex" -> CmdLine.GitRemoteTorAnnex.run ps
+ _ -> CmdLine.GitAnnex.run Test.optParser Test.runner ps
#ifdef mingw32_HOST_OS
{- On Windows, if HOME is not set, probe it and set it.
projects / git-annex.git / commitdiff