module Darcs.RemoteApply ( remoteApply, applyAs ) where
import System.Exit ( ExitCode )
import Darcs.Flags ( DarcsFlag( ApplyAs, Debug ) )
import Darcs.Utils ( breakCommand )
import Darcs.URL ( isUrl, isSsh )
import Darcs.External
import Printer
remoteApply :: [DarcsFlag] -> String -> Doc -> IO ExitCode
remoteApply opts repodir bundle
= case applyAs opts of
Nothing -> if isSsh repodir
then applyViaSsh opts repodir bundle
else if isUrl repodir
then applyViaUrl opts repodir bundle
else applyViaLocal opts repodir bundle
Just un -> if isSsh repodir
then applyViaSshAndSudo opts repodir un bundle
else applyViaSudo un repodir bundle
applyAs :: [DarcsFlag] -> Maybe String
applyAs (ApplyAs user:_) = Just user
applyAs (_:fs) = applyAs fs
applyAs [] = Nothing
applyViaSudo :: String -> String -> Doc -> IO ExitCode
applyViaSudo user repo bundle =
darcsProgram >>= \darcs ->
pipeDoc "sudo" ["-u",user,darcs,"apply","--all","--repodir",repo] bundle
applyViaLocal :: [DarcsFlag] -> String -> Doc -> IO ExitCode
applyViaLocal opts repo bundle =
darcsProgram >>= \darcs ->
pipeDoc darcs ("apply":"--all":"--repodir":repo:applyopts opts) bundle
applyViaUrl :: [DarcsFlag] -> String -> Doc -> IO ExitCode
applyViaUrl opts repo bundle =
do maybeapply <- maybeURLCmd "APPLY" repo
case maybeapply of
Nothing -> applyViaLocal opts repo bundle
Just apply ->
do let (cmd, args) = breakCommand apply
pipeDoc cmd (args ++ [repo]) bundle
applyViaSsh :: [DarcsFlag] -> String -> Doc -> IO ExitCode
applyViaSsh opts repo bundle =
pipeDocSSH addr [remoteDarcsCmd opts++" apply --all "++unwords (applyopts opts)++
" --repodir '"++path++"'"] bundle
where (addr,':':path) = break (==':') repo
applyViaSshAndSudo :: [DarcsFlag] -> String -> String -> Doc -> IO ExitCode
applyViaSshAndSudo opts repo username bundle =
pipeDocSSH addr ["sudo -u "++username++" "++remoteDarcsCmd opts++
" apply --all --repodir '"++path++"'"] bundle
where (addr,':':path) = break (==':') repo
applyopts :: [DarcsFlag] -> [String]
applyopts opts = if Debug `elem` opts then ["--debug"] else []