summaryrefslogtreecommitdiff
path: root/Ssh.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-04-09 14:26:32 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-04-09 14:26:32 -0400
commit8ad901a647a9c7cf179dc2dd73d121adc43a28fb (patch)
treef62b1ff88490f84e34cda0b4cd419be4261010fb /Ssh.hs
parent1e7ad2ee7c63c02c8f6b9df465576c8245bba8a6 (diff)
refactor
Diffstat (limited to 'Ssh.hs')
-rw-r--r--Ssh.hs35
1 files changed, 35 insertions, 0 deletions
diff --git a/Ssh.hs b/Ssh.hs
index 6d01a5642..0cf2919c2 100644
--- a/Ssh.hs
+++ b/Ssh.hs
@@ -7,6 +7,8 @@
module Ssh where
+import Control.Monad.State (liftIO)
+
import qualified GitRepo as Git
import Utility
import Types
@@ -24,3 +26,36 @@ sshToRepo repo sshcmd = do
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