git-annex/Command/LockContent.hs
Joey Hess f4103744c3
make sure that lockContentShared is always paired with an inAnnex check
lockContentShared had a screwy caveat that it didn't verify that the content
was present when locking it, but in the most common case, eg indirect mode,
it failed to lock when the content is not present.

That led to a few callers forgetting to check inAnnex when using it,
but the potential data loss was unlikely to be noticed because it only
affected direct mode I think.

Fix data loss bug when the local repository uses direct mode, and a
locally modified file is dropped from a remote repsitory. The bug
caused the modified file to be counted as a copy of the original file.
(This is not a severe bug because in such a situation, dropping
from the remote and then modifying the file is allowed and has the same
end result.)

And, in content locking over tor, when the remote repository is
in direct mode, it neglected to check that the content was actually
present when locking it. This could cause git annex drop to remove
the only copy of a file when it thought the tor remote had a copy.

So, make lockContentShared do its own inAnnex check. This could perhaps
be optimised for direct mode, to avoid the check then, since locking
the content necessarily verifies it exists there, but I have not bothered
with that.

This commit was sponsored by Jeff Goeke-Smith on Patreon.
2018-03-07 14:23:52 -04:00

41 lines
1 KiB
Haskell

{- git-annex-shell command
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.LockContent where
import Command
import Annex.Content
import Remote.Helper.Ssh (contentLockedMarker)
import Utility.SimpleProtocol
cmd :: Command
cmd = noCommit $
command "lockcontent" SectionPlumbing
"locks key's content in the annex, preventing it being dropped"
paramKey
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
-- First, lock the content, then print out "OK".
-- Wait for the caller to send a line before dropping the lock.
start :: [String] -> CommandStart
start [ks] = do
ok <- lockContentShared k (const locksuccess)
`catchNonAsync` (const $ return False)
liftIO $ if ok
then exitSuccess
else exitFailure
where
k = fromMaybe (giveup "bad key") (file2key ks)
locksuccess = liftIO $ do
putStrLn contentLockedMarker
hFlush stdout
_ <- getProtocolLine stdin
return True
start _ = giveup "Specify exactly 1 key."