diff options
author | Joey Hess <joey@kitenet.net> | 2012-01-10 15:29:10 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-01-10 15:29:10 -0400 |
commit | 16e7178f207b0472346c06f30aa210cebe373c36 (patch) | |
tree | 1d9f91d5ef3f5a72adf4e0df0b38d362649a2200 /Annex/Ssh.hs | |
parent | 07cacbeee95b377e1bf4111e4d4b30190956c585 (diff) |
reorg
Diffstat (limited to 'Annex/Ssh.hs')
-rw-r--r-- | Annex/Ssh.hs | 65 |
1 files changed, 0 insertions, 65 deletions
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs deleted file mode 100644 index 81e488b41..000000000 --- a/Annex/Ssh.hs +++ /dev/null @@ -1,65 +0,0 @@ -{- git-annex remote access with ssh - - - - Copyright 2011 Joey Hess <joey@kitenet.net> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Annex.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 |