summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Fsck.hs37
-rw-r--r--Command/Reinject.hs22
2 files changed, 31 insertions, 28 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 89ba0eef8..1e49fd4d3 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -209,17 +209,17 @@ checkKeySize :: Key -> Annex Bool
checkKeySize key = do
file <- inRepo $ gitAnnexLocation key
ifM (liftIO $ doesFileExist file)
- ( checkKeySize' key file badContent
+ ( checkKeySizeOr badContent key file
, return True
)
checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
checkKeySizeRemote _ _ Nothing = return True
-checkKeySizeRemote key remote (Just file) = checkKeySize' key file
- (badContentRemote remote)
+checkKeySizeRemote key remote (Just file) =
+ checkKeySizeOr (badContentRemote remote) key file
-checkKeySize' :: Key -> FilePath -> (Key -> Annex String) -> Annex Bool
-checkKeySize' key file bad = case Types.Key.keySize key of
+checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> Annex Bool
+checkKeySizeOr bad key file = case Types.Key.keySize key of
Nothing -> return True
Just size -> do
size' <- fromIntegral . fileSize
@@ -242,22 +242,23 @@ checkKeySize' key file bad = case Types.Key.keySize key of
checkBackend :: Backend -> Key -> Annex Bool
checkBackend backend key = do
file <- inRepo (gitAnnexLocation key)
- checkBackend' backend key (Just file) badContent
+ checkBackendOr badContent backend key file
checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
-checkBackendRemote backend key remote localcopy =
- checkBackend' backend key localcopy (badContentRemote remote)
+checkBackendRemote backend key remote = maybe (return True) go
+ where
+ go = checkBackendOr (badContentRemote remote) backend key
-checkBackend' :: Backend -> Key -> Maybe FilePath -> (Key -> Annex String) -> Annex Bool
-checkBackend' _ _ Nothing _ = return True
-checkBackend' backend key (Just file) bad = case Types.Backend.fsckKey backend of
- Nothing -> return True
- Just a -> do
- ok <- a key file
- unless ok $ do
- msg <- bad key
- warning $ "Bad file content; " ++ msg
- return ok
+checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
+checkBackendOr bad backend key file =
+ case Types.Backend.fsckKey backend of
+ Nothing -> return True
+ Just a -> do
+ ok <- a key file
+ unless ok $ do
+ msg <- bad key
+ warning $ "Bad file content; " ++ msg
+ return ok
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do
diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index bb277af2c..112b7fadf 100644
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -35,8 +35,14 @@ start _ = error "specify a src file and a dest file"
perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
perform src _dest (key, backend) = do
- unlessM move $ error "mv failed!"
- next $ cleanup 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
@@ -44,13 +50,9 @@ perform src _dest (key, backend) = do
-- checked this way.
move = getViaTmp key $ \tmp ->
liftIO $ boolSystem "mv" [File src, File tmp]
+ reject = const $ return "wrong file?"
-cleanup :: Key -> Backend -> CommandCleanup
-cleanup key backend = do
+cleanup :: Key -> CommandCleanup
+cleanup key = do
logStatus key InfoPresent
-
- -- fsck the new content
- size_ok <- Command.Fsck.checkKeySize key
- backend_ok <- Command.Fsck.checkBackend backend key
-
- return $ size_ok && backend_ok
+ return True