refactor
This commit is contained in:
parent
1e7ad2ee7c
commit
8ad901a647
3 changed files with 37 additions and 37 deletions
|
@ -16,7 +16,6 @@ import Data.List.Utils
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified GitRepo as Git
|
import qualified GitRepo as Git
|
||||||
import qualified Remote.Git
|
|
||||||
import Messages
|
import Messages
|
||||||
import Types
|
import Types
|
||||||
import Utility
|
import Utility
|
||||||
|
@ -203,7 +202,7 @@ tryScan r
|
||||||
Git.hConfigRead r
|
Git.hConfigRead r
|
||||||
|
|
||||||
configlist =
|
configlist =
|
||||||
Remote.Git.onRemote r (pipedconfig, Nothing) "configlist" []
|
onRemote r (pipedconfig, Nothing) "configlist" []
|
||||||
manualconfiglist = do
|
manualconfiglist = do
|
||||||
let sshcmd =
|
let sshcmd =
|
||||||
"cd " ++ shellEscape(Git.workTree r) ++ " && " ++
|
"cd " ++ shellEscape(Git.workTree r) ++ " && " ++
|
||||||
|
|
|
@ -5,10 +5,7 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Remote.Git (
|
module Remote.Git (remote) where
|
||||||
remote,
|
|
||||||
onRemote
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Exception.Extensible
|
import Control.Exception.Extensible
|
||||||
import Control.Monad.State (liftIO)
|
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,
|
-- goes, so the source/dest parameter can be a dummy value,
|
||||||
-- that just enables remote rsync mode.
|
-- that just enables remote rsync mode.
|
||||||
dummy = Param ":"
|
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)
|
|
||||||
|
|
35
Ssh.hs
35
Ssh.hs
|
@ -7,6 +7,8 @@
|
||||||
|
|
||||||
module Ssh where
|
module Ssh where
|
||||||
|
|
||||||
|
import Control.Monad.State (liftIO)
|
||||||
|
|
||||||
import qualified GitRepo as Git
|
import qualified GitRepo as Git
|
||||||
import Utility
|
import Utility
|
||||||
import Types
|
import Types
|
||||||
|
@ -24,3 +26,36 @@ sshToRepo repo sshcmd = do
|
||||||
Just p -> [Param "-p", Param (show p)]
|
Just p -> [Param "-p", Param (show p)]
|
||||||
let sshhost = Param $ Git.urlHostUser repo
|
let sshhost = Param $ Git.urlHostUser repo
|
||||||
return $ sshoptions ++ sshport ++ [sshhost] ++ sshcmd
|
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
|
||||||
|
|
Loading…
Reference in a new issue