Added git-remote-tor-annex, which allows git pull and push to the tor hidden service.

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.

Build/Mans.hs

@@ -50,8 +50,11 @@ buildMans = do
 			else return (Just dest)
 
 isManSrc :: FilePath -> Bool
-isManSrc s = "git-annex" `isPrefixOf` (takeFileName s)
+isManSrc s
-	&& takeExtension s == ".mdwn"
+	| 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"

CHANGELOG

@@ -2,6 +2,8 @@ git-annex (6.20161119) UNRELEASED; urgency=medium
 
   * 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.
 

CmdLine/GitRemoteTorAnnex.hs

@@ -0,0 +1,62 @@
+{- 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

Command/EnableTor.hs

@@ -24,11 +24,11 @@ start :: CmdParams -> CommandStart
 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 onionport ++ " "
-			show onionsocket
 		stop
 start _ = error "Bad params"

Makefile

@@ -55,6 +55,7 @@ install-bins: build
 	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
@@ -133,6 +134,7 @@ linuxstandalone-nobuild: Build/Standalone Build/LinuxMkLibs
 	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)
@@ -194,6 +196,7 @@ osxapp: Build/Standalone Build/OSXMkLibs
 	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

Remote/Helper/P2P.hs

@@ -26,6 +26,12 @@ import qualified Data.ByteString.Lazy as L
 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)
 
@@ -157,6 +163,7 @@ type Net = Free NetF
 data RelayData
 	= RelayData L.ByteString
 	| RelayMessage Message
+	deriving (Show)
 
 newtype RelayHandle = RelayHandle Handle
 
@@ -400,8 +407,8 @@ relayCallback hout (RelayMessage (DATA len)) = do
 	return Nothing
 relayCallback _ (RelayMessage (CONNECTDONE exitcode)) =
 	return (Just exitcode)
-relayCallback _ (RelayMessage _) = do
+relayCallback _ (RelayMessage m) = do
-	sendMessage (ERROR "expected DATA or CONNECTDONE")
+	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

Remote/Helper/P2P/IO.hs

@@ -19,6 +19,7 @@ import Git
 import Git.Command
 import Utility.SafeCommand
 import Utility.SimpleProtocol
+import Utility.Exception
 
 import Control.Monad
 import Control.Monad.Free
@@ -30,7 +31,7 @@ import Control.Concurrent
 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
@@ -40,7 +41,7 @@ data S = S
 
 -- 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
@@ -48,7 +49,7 @@ runNetProtoHandle i o r = go
 	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
@@ -57,10 +58,11 @@ runNetHandle s runner f = case f of
 		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
@@ -70,6 +72,7 @@ runNetHandle s runner f = case f of
 		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
@@ -80,7 +83,8 @@ runNetHandle s runner f = case f of
 		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
 
@@ -112,43 +116,57 @@ runRelay runner (RelayHandle hout) callback = do
 
 	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
+runRelayService s runner service callback = bracket setup cleanup go
-	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
   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
+			Left exitcode -> return exitcode
-				hClose hin
-				return exitcode
 			Right relaydata -> do
+				liftIO $ hPutStrLn stderr ("> " ++ show relaydata)
 				_ <- runner $ net $
 					callback (RelayHandle hin) relaydata
 				drain v hin
@@ -156,7 +174,7 @@ runRelayService s runner service callback = do
 	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])

Remote/Helper/Tor.hs

@@ -0,0 +1,34 @@
+{- 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

RemoteDaemon/Transport/Tor.hs

@@ -12,6 +12,7 @@ import RemoteDaemon.Types
 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
@@ -43,9 +44,6 @@ server th@(TransportHandle (LocalRepo r) _) = do
 		(conn, _) <- accept soc
 		forkIO $ do
 			debugM "remotedaemon" "handling a connection"
-			h <- socketToHandle conn ReadWriteMode
+			h <- torHandle conn
-			hSetBuffering h LineBuffering
-			hSetBinaryMode h False
 			runNetProtoHandle h h r (serve u)
 			hClose h
-

Setup.hs

@@ -33,17 +33,19 @@ main = defaultMainWithHooks simpleUserHooks
 
 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 ()
+installGitAnnexLinks :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-installGitAnnexShell copyDest verbosity pkg lbi =
+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
 

Types/Creds.hs

@@ -11,4 +11,4 @@ type Creds = String -- can be any data that contains credentials
 
 type CredPair = (Login, Password)
 type Login = String
-type Password = String -- todo: use securemem
+type Password = String

Utility/Tor.hs

@@ -11,32 +11,53 @@ import Common
 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
+-- Picks a random high port number for the hidden service that is not
--- other hidden service (and is >= 1024). Returns the hidden service's
+-- 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 ++
 				[ ""
@@ -61,13 +82,18 @@ addHiddenService uid ident = do
 	
 	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

debian/control

@@ -77,6 +77,7 @@ Build-Depends:
 	libghc-disk-free-space-dev,
 	libghc-mountpoints-dev,
 	libghc-magic-dev,
+	libghc-socks-dev,
 	lsof [linux-any],
 	ikiwiki,
 	libimage-magick-perl,

doc/git-annex-enable-tor.mdwn

@@ -10,7 +10,7 @@ git annex enable-tor userid uuid
 
 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`.
 

doc/git-remote-tor-annex.mdwn

@@ -0,0 +1,36 @@
+# 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.

git-annex.cabal

@@ -59,6 +59,7 @@ Extra-Source-Files:
   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
@@ -136,6 +137,7 @@ Extra-Source-Files:
   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
@@ -365,7 +367,8 @@ Executable git-annex
    aeson,
    unordered-containers,
    feed,
-   regex-tdfa
+   regex-tdfa,
+   socks
   CC-Options: -Wall
   GHC-Options: -Wall -fno-warn-tabs
   Extensions: PackageImports
@@ -700,6 +703,7 @@ Executable git-annex
     CmdLine.GitAnnexShell.Fields
     CmdLine.GlobalSetter
     CmdLine.Option
+    CmdLine.GitRemoteTorAnnex
     CmdLine.Seek
     CmdLine.Usage
     Command
@@ -924,6 +928,7 @@ Executable git-annex
     Remote.Helper.ReadOnly
     Remote.Helper.Special
     Remote.Helper.Ssh
+    Remote.Helper.Tor
     Remote.Hook
     Remote.List
     Remote.Rsync

git-annex.hs

@@ -1,6 +1,6 @@
 {- 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.
  -}
@@ -13,6 +13,7 @@ import Network.Socket (withSocketsDo)
 
 import qualified CmdLine.GitAnnex
 import qualified CmdLine.GitAnnexShell
+import qualified CmdLine.GitRemoteTorAnnex
 import qualified Test
 
 #ifdef mingw32_HOST_OS
@@ -23,20 +24,15 @@ import Utility.Env
 main :: IO ()
 main = withSocketsDo $ do
 	ps <- getArgs
+#ifdef mingw32_HOST_OS
+	winEnv
+#endif
 	run ps =<< getProgName
   where
-	run ps n
+	run ps n = case takeFileName n of
-		| isshell n = CmdLine.GitAnnexShell.run ps
+		"git-annex-shell" -> CmdLine.GitAnnexShell.run ps
-		| otherwise =
+		"git-remote-tor-annex" -> CmdLine.GitRemoteTorAnnex.run ps
-#ifdef mingw32_HOST_OS
+		_  -> CmdLine.GitAnnex.run Test.optParser Test.runner ps
-			do
-				winEnv
-				gitannex ps
-#else
-			gitannex ps
-#endif
-	gitannex = CmdLine.GitAnnex.run Test.optParser Test.runner
-	isshell n = takeFileName n == "git-annex-shell"
 
 #ifdef mingw32_HOST_OS
 {- On Windows, if HOME is not set, probe it and set it.