e880d0d22c
Only fsck and reinject and the test suite used the Backend, and they can look it up as needed from the Key. This simplifies the code and also speeds it up. There is a small behavior change here. Before, all commands would warn when acting on an annexed file with an unknown backend. Now, only fsck and reinject show that warning.
63 lines
1.5 KiB
Haskell
63 lines
1.5 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Reinject where
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import Logs.Location
|
|
import Annex.Content
|
|
import qualified Command.Fsck
|
|
import qualified Backend
|
|
|
|
def :: [Command]
|
|
def = [command "reinject" (paramPair "SRC" "DEST") seek
|
|
SectionUtility "sets content of annexed file"]
|
|
|
|
seek :: CommandSeek
|
|
seek = withWords start
|
|
|
|
start :: [FilePath] -> CommandStart
|
|
start (src:dest:[])
|
|
| src == dest = stop
|
|
| otherwise =
|
|
ifAnnexed src
|
|
(error $ "cannot used annexed file as src: " ++ src)
|
|
go
|
|
where
|
|
go = do
|
|
showStart "reinject" dest
|
|
next $ whenAnnexed (perform src) dest
|
|
start _ = error "specify a src file and a dest file"
|
|
|
|
perform :: FilePath -> FilePath -> Key -> CommandPerform
|
|
perform src dest key = do
|
|
{- Check the content before accepting it. -}
|
|
v <- Backend.getBackend dest key
|
|
case v of
|
|
Nothing -> stop
|
|
Just backend ->
|
|
ifM (Command.Fsck.checkKeySizeOr reject key src
|
|
<&&> Command.Fsck.checkBackendOr reject backend key src)
|
|
( do
|
|
unlessM move $ error "mv failed!"
|
|
next $ cleanup key
|
|
, error "not reinjecting"
|
|
)
|
|
where
|
|
-- the file might be on a different filesystem,
|
|
-- so mv is used rather than simply calling
|
|
-- moveToObjectDir; disk space is also
|
|
-- checked this way.
|
|
move = getViaTmp key $ \tmp ->
|
|
liftIO $ boolSystem "mv" [File src, File tmp]
|
|
reject = const $ return "wrong file?"
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
cleanup key = do
|
|
logStatus key InfoPresent
|
|
return True
|