summaryrefslogtreecommitdiff
path: root/Remotes.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-25 18:32:29 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-25 18:32:29 -0400
commitd0a9cdadafca1ee0da100a993b23e8a063f86bf8 (patch)
tree46d6955950bafc004fdc47c3db499e5e2a4849fb /Remotes.hs
parent8beed17168aab12bb4045b6d8635b37503d5099b (diff)
add dropkey subcommand and --quiet
Needed for better git annex move --from
Diffstat (limited to 'Remotes.hs')
-rw-r--r--Remotes.hs54
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"