summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs2
-rw-r--r--Remote/Git.hs2
-rw-r--r--Remote/Helper/Ssh.hs65
3 files changed, 67 insertions, 2 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 04cd49026..37f3e02e0 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -19,7 +19,7 @@ import qualified Git.Command
import qualified Git.Config
import qualified Git.Construct
import Config
-import Annex.Ssh
+import Remote.Helper.Ssh
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 7d034d242..796407449 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -13,7 +13,7 @@ import qualified Data.Map as M
import Common.Annex
import Utility.CopyFile
import Utility.RsyncFile
-import Annex.Ssh
+import Remote.Helper.Ssh
import Types.Remote
import qualified Git
import qualified Git.Command
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
new file mode 100644
index 000000000..7c5eeddb8
--- /dev/null
+++ b/Remote/Helper/Ssh.hs
@@ -0,0 +1,65 @@
+{- git-annex remote access with ssh
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Ssh where
+
+import Common
+import qualified Git
+import qualified Git.Url
+import Types
+import Config
+import Annex.UUID
+
+{- Generates parameters to ssh to a repository's host and run a command.
+ - Caller is responsible for doing any neccessary shellEscaping of the
+ - passed command. -}
+sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
+sshToRepo repo sshcmd = do
+ s <- getConfig repo "ssh-options" ""
+ let sshoptions = map Param (words s)
+ let sshport = case Git.Url.port repo of
+ Nothing -> []
+ Just p -> [Param "-p", Param (show p)]
+ let sshhost = Param $ Git.Url.hostuser repo
+ return $ sshoptions ++ sshport ++ [sshhost] ++ sshcmd
+
+{- Generates parameters to run a git-annex-shell command on a remote
+ - repository. -}
+git_annex_shell :: Git.Repo -> String -> [CommandParam] -> Annex (Maybe (FilePath, [CommandParam]))
+git_annex_shell r command params
+ | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
+ | Git.repoIsSsh r = do
+ uuid <- getRepoUUID r
+ sshparams <- sshToRepo r [Param $ sshcmd uuid ]
+ return $ Just ("ssh", sshparams)
+ | otherwise = return Nothing
+ where
+ dir = Git.workTree r
+ shellcmd = "git-annex-shell"
+ shellopts = Param command : File dir : params
+ sshcmd uuid = unwords $
+ shellcmd : map shellEscape (toCommand shellopts) ++
+ uuidcheck uuid
+ uuidcheck NoUUID = []
+ uuidcheck (UUID u) = ["--uuid", u]
+
+{- Uses a supplied function (such as boolSystem) to run a git-annex-shell
+ - command on a remote.
+ -
+ - Or, if the remote does not support running remote commands, returns
+ - a specified error value. -}
+onRemote
+ :: Git.Repo
+ -> (FilePath -> [CommandParam] -> IO a, a)
+ -> String
+ -> [CommandParam]
+ -> Annex a
+onRemote r (with, errorval) command params = do
+ s <- git_annex_shell r command params
+ case s of
+ Just (c, ps) -> liftIO $ with c ps
+ Nothing -> return errorval