summaryrefslogtreecommitdiff
path: root/Command/Fsck.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Command/Fsck.hs')
-rw-r--r--Command/Fsck.hs76
1 files changed, 50 insertions, 26 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 54f20f5e8..8414b5b26 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -24,21 +24,21 @@ import Annex.Link
import Logs.Location
import Logs.Trust
import Logs.Activity
-import Config.NumCopies
+import Logs.TimeStamp
+import Annex.NumCopies
import Annex.UUID
import Utility.DataUnits
import Config
import Types.Key
import Types.CleanupActions
import Utility.HumanTime
+import Utility.CopyFile
import Git.FilePath
import Utility.PID
import qualified Database.Fsck as FsckDb
import Data.Time.Clock.POSIX
-import Data.Time
import System.Posix.Types (EpochTime)
-import System.Locale
cmd :: [Command]
cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
@@ -75,7 +75,7 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start from i)
ps
withFsckDb i FsckDb.closeDb
- recordActivity Fsck u
+ void $ tryIO $ recordActivity Fsck u
start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
start from inc file key = do
@@ -111,14 +111,15 @@ performRemote key file backend numcopies remote =
dispatch (Left err) = do
showNote err
return False
- dispatch (Right True) = withtmp $ \tmpfile ->
- ifM (getfile tmpfile)
- ( go True (Just tmpfile)
- , do
+ dispatch (Right True) = withtmp $ \tmpfile -> do
+ r <- getfile tmpfile
+ case r of
+ Nothing -> go True Nothing
+ Just True -> go True (Just tmpfile)
+ Just False -> do
warning "failed to download file from remote"
void $ go True Nothing
return False
- )
dispatch (Right False) = go False Nothing
go present localcopy = check
[ verifyLocationLogRemote key file remote present
@@ -134,14 +135,17 @@ performRemote key file backend numcopies remote =
let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
cleanup
cleanup `after` a tmp
- getfile tmp =
- ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
- ( return True
+ getfile tmp = ifM (checkDiskSpace (Just tmp) key 0)
+ ( ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
+ ( return (Just True)
, ifM (Annex.getState Annex.fast)
- ( return False
- , Remote.retrieveKeyFile remote key (Just file) tmp dummymeter
+ ( return Nothing
+ , Just <$>
+ Remote.retrieveKeyFile remote key Nothing tmp dummymeter
)
)
+ , return (Just False)
+ )
dummymeter _ = noop
startKey :: Incremental -> Key -> NumCopies -> CommandStart
@@ -273,7 +277,7 @@ checkKeySize key = ifM isDirect
checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
checkKeySizeRemote _ _ Nothing = return True
checkKeySizeRemote key remote (Just file) =
- checkKeySizeOr (badContentRemote remote) key file
+ checkKeySizeOr (badContentRemote remote file) key file
checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> Annex Bool
checkKeySizeOr bad key file = case Types.Key.keySize key of
@@ -318,7 +322,7 @@ checkBackend backend key mfile = go =<< isDirect
checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
checkBackendRemote backend key remote = maybe (return True) go
where
- go = checkBackendOr (badContentRemote remote) backend key
+ go file = checkBackendOr (badContentRemote remote file) backend key file
checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
checkBackendOr bad backend key file =
@@ -380,13 +384,36 @@ badContentDirect file key = do
logStatus key InfoMissing
return "left in place for you to examine"
-badContentRemote :: Remote -> Key -> Annex String
-badContentRemote remote key = do
- ok <- Remote.removeKey remote key
- when ok $
+{- Bad content is dropped from the remote. We have downloaded a copy
+ - from the remote to a temp file already (in some cases, it's just a
+ - symlink to a file in the remote). To avoid any further data loss,
+ - that temp file is moved to the bad content directory unless
+ - the local annex has a copy of the content. -}
+badContentRemote :: Remote -> FilePath -> Key -> Annex String
+badContentRemote remote localcopy key = do
+ bad <- fromRepo gitAnnexBadDir
+ let destbad = bad </> key2file key
+ movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
+ ( return False
+ , do
+ createAnnexDirectory (parentDir destbad)
+ liftIO $ catchDefaultIO False $
+ ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy)
+ ( copyFileExternal CopyTimeStamps localcopy destbad
+ , do
+ moveFile localcopy destbad
+ return True
+ )
+ )
+
+ dropped <- Remote.removeKey remote key
+ when dropped $
Remote.logStatus remote key InfoMissing
- return $ (if ok then "dropped from " else "failed to drop from ")
- ++ Remote.name remote
+ return $ case (movedbad, dropped) of
+ (True, True) -> "moved from " ++ Remote.name remote ++
+ " to " ++ destbad
+ (False, True) -> "dropped from " ++ Remote.name remote
+ (_, False) -> "failed to drop from" ++ Remote.name remote
runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart
runFsck inc file key a = ifM (needFsck inc key)
@@ -448,14 +475,11 @@ getStartTime u = do
liftIO $ catchDefaultIO Nothing $ do
timestamp <- modificationTime <$> getFileStatus f
let fromstatus = Just (realToFrac timestamp)
- fromfile <- readishTime <$> readFile f
+ fromfile <- parsePOSIXTime <$> readFile f
return $ if matchingtimestamp fromfile fromstatus
then Just timestamp
else Nothing
where
- readishTime :: String -> Maybe POSIXTime
- readishTime s = utcTimeToPOSIXSeconds <$>
- parseTime defaultTimeLocale "%s%Qs" s
matchingtimestamp fromfile fromstatus =
#ifndef mingw32_HOST_OS
fromfile == fromstatus