diff options
| -rw-r--r-- | Remote/Git.hs | 26 | ||||
| -rw-r--r-- | Remote/Helper/Messages.hs | 27 | ||||
| -rw-r--r-- | debian/changelog | 9 |
3 files changed, 40 insertions, 22 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index c2bd307ad..80c0579cc 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -364,7 +364,7 @@ dropKey r key lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r lockKey r key callback | not $ Git.repoIsUrl (repo r) = - guardUsable (repo r) cantlock $ do + guardUsable (repo r) failedlock $ do inorigrepo <- Annex.makeRunner -- Lock content from perspective of remote, -- and then run the callback in the original @@ -372,13 +372,17 @@ lockKey r key callback onLocal r $ Annex.Content.lockContentShared key $ liftIO . inorigrepo . callback | Git.repoIsSsh (repo r) = do + showLocking r Just (cmd, params) <- Ssh.git_annex_shell (repo r) "lockcontent" [Param $ key2file key] [] - (Just hin, Just hout, Nothing, p) <- liftIO $ createProcess $ - (proc cmd (toCommand params)) - { std_in = CreatePipe - , std_out = CreatePipe - } + (Just hin, Just hout, Nothing, p) <- liftIO $ + withFile devNull WriteMode $ \nullh -> + createProcess $ + (proc cmd (toCommand params)) + { std_in = CreatePipe + , std_out = CreatePipe + , std_err = UseHandle nullh + } -- Wait for either the process to exit, or for it to -- indicate the content is locked. v <- liftIO $ race @@ -393,21 +397,23 @@ lockKey r key callback let checkexited = not . isJust <$> getProcessExitCode p case v of Left _exited -> do + showNote "lockcontent failed" liftIO $ do hClose hin hClose hout - cantlock + failedlock Right l | l == Ssh.contentLockedMarker -> bracket_ noop signaldone (withVerifiedCopy LockedCopy r checkexited callback) | otherwise -> do + showNote "lockcontent failed" signaldone - cantlock - | otherwise = cantlock + failedlock + | otherwise = failedlock where - cantlock = error "can't lock content" + failedlock = error "can't lock content" {- Tries to copy a key's content from a remote's annex to a file. -} copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification) diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs index 377f2d231..6e72758fb 100644 --- a/Remote/Helper/Messages.hs +++ b/Remote/Helper/Messages.hs @@ -13,20 +13,23 @@ import Common.Annex import qualified Git import qualified Types.Remote as Remote -class Checkable a where - descCheckable :: a -> String +class Describable a where + describe :: a -> String -instance Checkable Git.Repo where - descCheckable = Git.repoDescribe +instance Describable Git.Repo where + describe = Git.repoDescribe -instance Checkable (Remote.RemoteA a) where - descCheckable = Remote.name +instance Describable (Remote.RemoteA a) where + describe = Remote.name -instance Checkable String where - descCheckable = id +instance Describable String where + describe = id -showChecking :: Checkable a => a -> Annex () -showChecking v = showAction $ "checking " ++ descCheckable v +showChecking :: Describable a => a -> Annex () +showChecking v = showAction $ "checking " ++ describe v -cantCheck :: Checkable a => a -> e -cantCheck v = error $ "unable to check " ++ descCheckable v +cantCheck :: Describable a => a -> e +cantCheck v = error $ "unable to check " ++ describe v + +showLocking :: Describable a => a -> Annex () +showLocking v = showAction $ "locking " ++ describe v diff --git a/debian/changelog b/debian/changelog index 81797bc4f..250e183a6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,15 @@ git-annex (5.20150931) UNRELEASED; urgency=medium all copies of its content being lost. * git-annex-shell: Added lockcontent command, to prevent dropping of a key's content. This is necessary due to the above bugfix. + * In some cases, the above bugfix changes what git-annex allows to be dropped: + - When a file is present in several special remotes, + but not in any accessible git repositories, dropping it from one of + the special remotes will now fail. Instead, the file has to be + moved from one of the special remotes to the git repository, and can + then safely be dropped from the git repository. + - If a git remote has too old a version of git-annex-shell installed, + git-annex won't trust it to hold onto a copy of a file when dropping + that file from some other remote. * Do verification of checksums of annex objects downloaded from remotes. * When annex objects are received into git repositories from other git repos, their checksums are verified then too. |