diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Fsck.hs | 37 | ||||
| -rw-r--r-- | Command/Reinject.hs | 22 |
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 |