diff options
| -rw-r--r-- | Command/Map.hs | 3 | ||||
| -rw-r--r-- | Remote/Git.hs | 36 | ||||
| -rw-r--r-- | Ssh.hs | 35 |
3 files changed, 37 insertions, 37 deletions
diff --git a/Command/Map.hs b/Command/Map.hs index dc3acb56e..2325c87e1 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -16,7 +16,6 @@ import Data.List.Utils import Command import qualified Annex import qualified GitRepo as Git -import qualified Remote.Git import Messages import Types import Utility @@ -203,7 +202,7 @@ tryScan r Git.hConfigRead r configlist = - Remote.Git.onRemote r (pipedconfig, Nothing) "configlist" [] + onRemote r (pipedconfig, Nothing) "configlist" [] manualconfiglist = do let sshcmd = "cd " ++ shellEscape(Git.workTree r) ++ " && " ++ diff --git a/Remote/Git.hs b/Remote/Git.hs index c315d457d..7724df79a 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -5,10 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.Git ( - remote, - onRemote -) where +module Remote.Git (remote) where import Control.Exception.Extensible import Control.Monad.State (liftIO) @@ -194,34 +191,3 @@ rsyncParams r sending key file = do -- goes, so the source/dest parameter can be a dummy value, -- that just enables remote rsync mode. dummy = Param ":" - -{- Uses a supplied function 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 - -{- Generates parameters to run a git-annex-shell command on a remote. -} -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) @@ -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 |