diff --git a/Commands.hs b/Commands.hs index 9c35c22e18..cf05164636 100644 --- a/Commands.hs +++ b/Commands.hs @@ -367,25 +367,28 @@ moveToPerform file key = do remote <- Remotes.commandLineRemote isthere <- Remotes.inAnnex remote key case isthere of - Left err -> error (show err) - Right False -> moveit remote key - Right True -> removeit remote key - where - moveit remote key = do - Remotes.copyToRemote remote key - removeit remote key - removeit remote key = do - error "TODO: drop key from local" - return $ Just $ moveToCleanup remote key + Left err -> do + showNote $ show err + return Nothing + Right False -> do + ok <- Remotes.copyToRemote remote key + if (ok) + then return $ Just $ moveToCleanup remote key + else return Nothing -- failed + Right True -> return $ Just $ moveToCleanup remote key moveToCleanup :: Git.Repo -> Key -> Annex Bool moveToCleanup remote key = do - -- Update local location log; key is present there and missing here. - logStatus key ValueMissing - u <- getUUID remote - liftIO $ logChange remote key u ValuePresent - -- Propigate location log to remote. - error "TODO: update remote locationlog" - return True + -- cleanup on the local side is the same as done for the drop subcommand + ok <- dropCleanup key + if (not ok) + then return False + else do + -- Record that the key is present on the remote. + u <- getUUID remote + liftIO $ logChange remote key u ValuePresent + -- Propigate location log to remote. + error "TODO: update remote locationlog" + return True {- Moves the content of an annexed file from another repository to the current - repository and updates locationlog information on both. @@ -403,22 +406,28 @@ moveFromPerform file key = do isthere <- Remotes.inAnnex remote key ishere <- inAnnex key case (ishere, isthere) of - (_, Left err) -> error (show err) - (_, Right False) -> return Nothing -- not in remote; fail - (False, Right True) -> moveit remote key - (True, Right True) -> removeit remote key - where - moveit remote key = do + (_, Left err) -> do + showNote $ show err + return Nothing + (_, Right False) -> do + showNote $ "not present in " ++ (Git.repoDescribe remote) + return Nothing + (False, Right True) -> do + -- copy content from remote ok <- getViaTmp key (Remotes.copyFromRemote remote key) if (ok) - then removeit remote key + then return $ Just $ moveFromCleanup remote key else return Nothing -- fail - removeit remote key = do - error $ "TODO remove" ++ file - return $ Just moveFromCleanup -moveFromCleanup :: Annex Bool -moveFromCleanup = do - error "update location logs" + (True, Right True) -> do + -- the content is already here, just remove from remote + return $ Just $ moveFromCleanup remote key +moveFromCleanup :: Git.Repo -> Key -> Annex Bool +moveFromCleanup remote key = do + Remotes.removeRemoteFile remote $ annexLocation remote key + -- Record that the key is not on the remote. + u <- getUUID remote + liftIO $ logChange remote key u ValueMissing + Remotes.updateRemoteLogStatus remote key return True -- helpers diff --git a/LocationLog.hs b/LocationLog.hs index 785b3330db..9ec71ce232 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -19,7 +19,9 @@ module LocationLog ( LogStatus(..), logChange, - keyLocations + keyLocations, + logFile, + readLog ) where import Data.Time.Clock.POSIX diff --git a/Locations.hs b/Locations.hs index 18d416eb4a..92918a7e0c 100644 --- a/Locations.hs +++ b/Locations.hs @@ -28,6 +28,9 @@ gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc - - - That allows deriving the key and backend by looking at the symlink to it. + - + - Note that even if the repo is a bare repo, the annex is put in a .git + - sub -} annexLocation :: Git.Repo -> Key -> FilePath annexLocation r key = diff --git a/Remotes.hs b/Remotes.hs index aec38a363e..67ebd75f97 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -7,7 +7,9 @@ module Remotes ( inAnnex, commandLineRemote, copyFromRemote, - copyToRemote + copyToRemote, + removeRemoteFile, + updateRemoteLogStatus ) where import Control.Exception @@ -16,8 +18,11 @@ import Control.Monad (filterM) import qualified Data.Map as Map import Data.String.Utils import Data.Either.Utils +import System.Cmd.Utils +import System.Directory import List import Maybe +import IO (hPutStrLn) import Types import qualified GitRepo as Git @@ -223,3 +228,40 @@ copyToRemote r key = do location g = annexLocation g key sshlocation = (Git.urlHost r) ++ ":" ++ file file = error "TODO" + +{- Removes a file from a remote. -} +removeRemoteFile :: Git.Repo -> FilePath -> Annex () +removeRemoteFile r file = do + if (not $ Git.repoIsUrl r) + then liftIO $ removeFile file + 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 $ gitStateDir r) + 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