diff options
Diffstat (limited to 'Remotes.hs')
| -rw-r--r-- | Remotes.hs | 54 |
1 files changed, 17 insertions, 37 deletions
diff --git a/Remotes.hs b/Remotes.hs index c9c65babe..985199e1c 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -8,11 +8,11 @@ module Remotes ( commandLineRemote, copyFromRemote, copyToRemote, - removeRemoteFile, - updateRemoteLogStatus + runCmd ) where -import Control.Exception +import IO (bracket_) +import Control.Exception hiding (bracket_) import Control.Monad.State (liftIO) import Control.Monad (filterM) import qualified Data.Map as Map @@ -20,9 +20,9 @@ import Data.String.Utils import Data.Either.Utils import System.Cmd.Utils import System.Directory +import System.Posix.Directory import List import Maybe -import IO (hPutStrLn) import Types import qualified GitRepo as Git @@ -221,39 +221,19 @@ copyToRemote r key = do sshlocation = (Git.urlHost r) ++ ":" ++ file file = error "TODO" -{- Removes a file from a remote. -} -removeRemoteFile :: Git.Repo -> FilePath -> Annex () -removeRemoteFile r file = do +{- Runs a command in a remote. -} +runCmd :: Git.Repo -> String -> [String] -> Annex Bool +runCmd r command params = do if (not $ Git.repoIsUrl r) - then liftIO $ removeFile file + then do + cwd <- liftIO $ getCurrentDirectory + liftIO $ bracket_ (changeWorkingDirectory (Git.workTree r)) + (\_ -> changeWorkingDirectory cwd) $ + boolSystem command params else if (Git.repoIsSsh r) then do - ok <- liftIO $ boolSystem "ssh" - [Git.urlHost r, "rm -f " ++ - (shellEscape file)] - if (ok) - then return () - else error "failed to remove file from remote" - else error "removing file from non-ssh repo not supported" - -{- Update's a remote's location log for a key, by merging the local - - location log into it. -} -updateRemoteLogStatus :: Git.Repo -> Key -> Annex () -updateRemoteLogStatus r key = do - -- To merge, just append data to the remote's - -- log. Since the log is timestamped, the presumably newer - -- information from the local will superscede the older - -- information in the remote's log. - -- TODO: remote log locking - let mergecmd = "cat >> " ++ (shellEscape $ logFile r key) ++ " && " ++ - "cd " ++ (shellEscape $ Git.workTree r) ++ " && " ++ - "git add " ++ (shellEscape $ stateLoc) - let shellcmd = if (not $ Git.repoIsUrl r) - then pOpen WriteToPipe "sh" ["-c", mergecmd] - else if (Git.repoIsSsh r) - then pOpen WriteToPipe "ssh" [Git.urlHost r, mergecmd] - else error "updating non-ssh repo not supported" - g <- Annex.gitRepo - liftIO $ shellcmd $ \h -> do - lines <- readLog $ logFile g key - hPutStrLn h $ unlines $ map show lines + liftIO $ boolSystem "ssh" [Git.urlHost r, + "cd " ++ (shellEscape $ Git.workTree r) ++ + " && " ++ command ++ " " ++ + unwords params] + else error "running command in non-ssh repo not supported" |