diff options
Diffstat (limited to 'Command/Reinject.hs')
-rw-r--r-- | Command/Reinject.hs | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/Command/Reinject.hs b/Command/Reinject.hs new file mode 100644 index 000000000..c49af0060 --- /dev/null +++ b/Command/Reinject.hs @@ -0,0 +1,58 @@ +{- 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 + +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, Backend) -> CommandPerform +perform src _dest (key, backend) = + {- Check the content before accepting it. -} + 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 |