add recordStartTime and getStartTime

2 files changed, 56 insertions, 2 deletions

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 834ca8af6..508e76966 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -7,8 +7,6 @@
 
 module Command.Fsck where
 
-import System.Posix.Process (getProcessID)
-
 import Common.Annex
 import Command
 import qualified Annex
@@ -28,6 +26,12 @@ import Config
 import qualified Option
 import Types.Key
 
+import System.Posix.Process (getProcessID)
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Posix.Types (EpochTime)
+import System.Locale
+
 def :: [Command]
 def = [withOptions options $ command "fsck" paramPaths seek
 	"check for problems"]
@@ -319,6 +323,18 @@ badContentRemote remote key = do
 	return $ (if ok then "dropped from " else "failed to drop from ")
 		++ Remote.name remote
 
+{- To record the time that an annexed file was last fscked, without
+ - modifying its mtime, we set the timestamp of its parent directory.
+ - Each annexed file is the only thing in its directory, so this is fine.
+ -
+ - To record that the file was fscked, the directory's sticky bit is set.
+ - (None of the normal unix behaviors of the sticky bit should matter, so
+ - we can reuse this permission bit.)
+ -
+ - Note that this relies on the parent directory being deleted when a file
+ - is dropped. That way, if it's later added back, the fsck metadata
+ - won't still be present.
+ -}
 updateMetadata :: Key -> Annex Bool
 updateMetadata key = do
 	file <- inRepo $ gitAnnexLocation key
@@ -326,3 +342,36 @@ updateMetadata key = do
 	liftIO $ touchFile parent
 	liftIO $ setSticky parent
 	return True
+
+{- Records the start time of an interactive fsck.
+ -
+ - To guard against time stamp damange (for example, if an annex directory
+ - is copied without -a), the fsckstate file contains a time that should
+ - be identical to its modification time. -}
+recordStartTime :: Annex ()
+recordStartTime = do
+	f <- fromRepo gitAnnexFsckState
+	liftIO $ do
+		nukeFile f
+		h <- openFile f WriteMode
+		t <- modificationTime <$> getFileStatus f
+		hPutStr h $ showTime $ realToFrac t
+		hClose h
+	where
+		showTime :: POSIXTime -> String
+		showTime = show
+
+{- Gets the incremental fsck start time. -}
+getStartTime :: Annex (Maybe EpochTime)
+getStartTime = do
+	f <- fromRepo gitAnnexFsckState
+	liftIO $ catchDefaultIO Nothing $ do
+		timestamp <- modificationTime <$> getFileStatus f
+		t <- readishTime <$> readFile f
+		return $ if Just (realToFrac timestamp) == t
+			then Just timestamp
+			else Nothing
+	where
+		readishTime :: String -> Maybe POSIXTime
+		readishTime s = utcTimeToPOSIXSeconds <$>
+			parseTime defaultTimeLocale "%s%Qs" s
diff --git a/Locations.hs b/Locations.hs
index 397081cc4..98eabb172 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -18,6 +18,7 @@ module Locations (
 	gitAnnexBadDir,
 	gitAnnexBadLocation,
 	gitAnnexUnusedLog,
+	gitAnnexFsckState,
 	gitAnnexTransferDir,
 	gitAnnexJournalDir,
 	gitAnnexJournalLock,
@@ -130,6 +131,10 @@ gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key
 gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath
 gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
 
+{- .git/annex/fsckstate is used to store information about incremental fscks. -}
+gitAnnexFsckState :: Git.Repo -> FilePath
+gitAnnexFsckState r = gitAnnexDir r </> "fsckstate"
+
 {- .git/annex/transfer/ is used is used to record keys currently
  - being transferred, and other transfer bookkeeping info. -}
 gitAnnexTransferDir :: Git.Repo -> FilePath