From cab4ac247ca990a03537f7611b299efca8edaffe Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 5 Jul 2011 20:36:43 -0400
Subject: rename

---
 Remote/Bup.hs |  2 +-
 Remote/Git.hs |  2 +-
 Remote/Ssh.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 63 insertions(+), 2 deletions(-)
 create mode 100644 Remote/Ssh.hs

(limited to 'Remote')

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 11c0ec4da..5a44397f0 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -28,7 +28,7 @@ import Locations
 import Config
 import Utility
 import Messages
-import Ssh
+import Remote.Ssh
 import Remote.Special
 import Remote.Encryptable
 import Crypto
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 4a8f8ee92..fb8512382 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -24,7 +24,7 @@ import qualified Content
 import Messages
 import Utility.CopyFile
 import Utility.RsyncFile
-import Ssh
+import Remote.Ssh
 import Config
 
 remote :: RemoteType Annex
diff --git a/Remote/Ssh.hs b/Remote/Ssh.hs
new file mode 100644
index 000000000..0d4842a1a
--- /dev/null
+++ b/Remote/Ssh.hs
@@ -0,0 +1,61 @@
+{- git-annex remote access with ssh
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Ssh where
+
+import Control.Monad.State (liftIO)
+
+import qualified Git
+import Utility
+import Types
+import Config
+
+{- 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.urlPort repo of
+		Nothing -> []
+		Just p -> [Param "-p", Param (show p)]
+	let sshhost = Param $ Git.urlHostUser 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
+		sshparams <- sshToRepo r [Param sshcmd]
+		return $ Just ("ssh", sshparams)
+	| otherwise = return Nothing
+	where
+		dir = Git.workTree r
+		shellcmd = "git-annex-shell"
+		shellopts = (Param command):(File dir):params
+		sshcmd = shellcmd ++ " " ++ 
+			unwords (map shellEscape $ toCommand shellopts)
+
+{- 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
-- 
cgit v1.2.3