Merge branch 'master' into concurrentprogress

Conflicts:
	Command/Fsck.hs
	Messages.hs
	Remote/Directory.hs
	Remote/Git.hs
	Remote/Helper/Special.hs
	Types/Remote.hs
	debian/changelog
	git-annex.cabal

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