diff options
| -rw-r--r-- | Build/Mans.hs | 7 | ||||
| -rw-r--r-- | CHANGELOG | 2 | ||||
| -rw-r--r-- | CmdLine/GitRemoteTorAnnex.hs | 62 | ||||
| -rw-r--r-- | Command/EnableTor.hs | 8 | ||||
| -rw-r--r-- | Makefile | 3 | ||||
| -rw-r--r-- | Remote/Helper/P2P.hs | 11 | ||||
| -rw-r--r-- | Remote/Helper/P2P/IO.hs | 64 | ||||
| -rw-r--r-- | Remote/Helper/Tor.hs | 34 | ||||
| -rw-r--r-- | RemoteDaemon/Transport/Tor.hs | 6 | ||||
| -rw-r--r-- | Setup.hs | 8 | ||||
| -rw-r--r-- | Types/Creds.hs | 2 | ||||
| -rw-r--r-- | Utility/Tor.hs | 40 | ||||
| -rw-r--r-- | debian/control | 1 | ||||
| -rw-r--r-- | doc/git-annex-enable-tor.mdwn | 2 | ||||
| -rw-r--r-- | doc/git-remote-tor-annex.mdwn | 36 | ||||
| -rw-r--r-- | git-annex.cabal | 7 | ||||
| -rw-r--r-- | git-annex.hs | 22 |
17 files changed, 254 insertions, 61 deletions
diff --git a/Build/Mans.hs b/Build/Mans.hs index cf86d983d..2ea9b4197 100644 --- a/Build/Mans.hs +++ b/Build/Mans.hs @@ -50,8 +50,11 @@ buildMans = do 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" @@ -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. diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs new file mode 100644 index 000000000..bc001f42f --- /dev/null +++ b/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 diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs index 369ea7509..c581fa1d4 100644 --- a/Command/EnableTor.hs +++ b/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 onionsocket + show onionport ++ " " stop start _ = error "Bad params" @@ -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 diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs index 1e1519560..7e49968ee 100644 --- a/Remote/Helper/P2P.hs +++ b/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 - 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 diff --git a/Remote/Helper/P2P/IO.hs b/Remote/Helper/P2P/IO.hs index 6908fd68c..c6a80cdbf 100644 --- a/Remote/Helper/P2P/IO.hs +++ 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 - 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 @@ -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]) diff --git a/Remote/Helper/Tor.hs b/Remote/Helper/Tor.hs new file mode 100644 index 000000000..e91083362 --- /dev/null +++ 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 diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index da30bf944..e0922a766 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/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 - hSetBuffering h LineBuffering - hSetBinaryMode h False + h <- torHandle conn runNetProtoHandle h h r (serve u) hClose h - @@ -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 () -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 diff --git a/Types/Creds.hs b/Types/Creds.hs index ad1827bc9..6a9e1287f 100644 --- a/Types/Creds.hs +++ b/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 diff --git a/Utility/Tor.hs b/Utility/Tor.hs index b673c7105..eedee8c6b 100644 --- a/Utility/Tor.hs +++ b/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 --- 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 ++ [ "" @@ -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 diff --git a/debian/control b/debian/control index 07630dfa2..3196d8fcd 100644 --- a/debian/control +++ b/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, diff --git a/doc/git-annex-enable-tor.mdwn b/doc/git-annex-enable-tor.mdwn index 5355eef8b..ceaa4b121 100644 --- a/doc/git-annex-enable-tor.mdwn +++ b/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`. diff --git a/doc/git-remote-tor-annex.mdwn b/doc/git-remote-tor-annex.mdwn new file mode 100644 index 000000000..63b459ed8 --- /dev/null +++ b/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. diff --git a/git-annex.cabal b/git-annex.cabal index 7a0e34b3a..751bd4bd4 100644 --- a/git-annex.cabal +++ b/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 diff --git a/git-annex.hs b/git-annex.hs index ca8eecd2a..d5fab7f47 100644 --- a/git-annex.hs +++ b/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 - 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. |