-- | This module is used by the push and put commands to apply the a bundle to a -- remote repository. By remote I do not necessarily mean a repository on another -- machine, it is just not the repository we're located in. 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 []