module Darcs.RemoteApply ( remote_apply, apply_as ) where
import System.Exit ( ExitCode )
import Darcs.Flags ( DarcsFlag( ApplyAs, Debug ) )
import Darcs.Utils ( breakCommand )
import Darcs.URL ( is_url, is_ssh )
import Darcs.External
import Printer
remote_apply :: [DarcsFlag] -> String -> Doc -> IO ExitCode
remote_apply opts repodir bundle
= case apply_as opts of
Nothing -> if is_ssh repodir
then apply_via_ssh opts repodir bundle
else if is_url repodir
then apply_via_url opts repodir bundle
else apply_via_local opts repodir bundle
Just un -> if is_ssh repodir
then apply_via_ssh_and_sudo repodir un bundle
else apply_via_sudo un repodir bundle
apply_as :: [DarcsFlag] -> Maybe String
apply_as (ApplyAs user:_) = Just user
apply_as (_:fs) = apply_as fs
apply_as [] = Nothing
apply_via_sudo :: String -> String -> Doc -> IO ExitCode
apply_via_sudo user repo bundle =
pipeDoc "sudo" ["-u",user,"darcs","apply","--all","--repodir",repo] bundle
apply_via_local :: [DarcsFlag] -> String -> Doc -> IO ExitCode
apply_via_local opts repo bundle =
pipeDoc "darcs" ("apply":"--all":"--repodir":repo:applyopts opts) bundle
apply_via_url :: [DarcsFlag] -> String -> Doc -> IO ExitCode
apply_via_url opts repo bundle =
do maybeapply <- maybeURLCmd "APPLY" repo
case maybeapply of
Nothing -> apply_via_local opts repo bundle
Just apply ->
do let (cmd, args) = breakCommand apply
pipeDoc cmd (args ++ [repo]) bundle
apply_via_ssh :: [DarcsFlag] -> String -> Doc -> IO ExitCode
apply_via_ssh opts repo bundle =
pipeDocSSH addr ["darcs apply --all "++unwords (applyopts opts)++" --repodir '"++path++"'"] bundle
where (addr,':':path) = break (==':') repo
apply_via_ssh_and_sudo :: String -> String -> Doc -> IO ExitCode
apply_via_ssh_and_sudo repo username bundle =
pipeDocSSH addr ["sudo -u "++username++
" darcs apply --all --repodir '"++path++"'"] bundle
where (addr,':':path) = break (==':') repo
applyopts :: [DarcsFlag] -> [String]
applyopts opts = if Debug `elem` opts then ["--debug"] else []