fix for Windows file timestamp timezone madness

On Windows, changing the time zone causes the apparent mtime of files to
change. This confuses git-annex, which natually thinks this means the files
have actually been modified (since THAT'S WHAT A MTIME IS FOR, BILL <sheesh>).

Work around this stupidity, by using the inode sentinal file to detect if
the timezone has changed, and calculate a TSDelta, which will be applied
when generating InodeCaches.

This should add no overhead at all on unix. Indeed, I sped up a few
things slightly in the refactoring.

Seems to basically work! But it has a big known problem:
If the timezone changes while the assistant (or a long-running command)
runs, it won't notice, since it only checks the inode cache once, and
so will use the old delta for all new inode caches it generates for new
files it's added. Which will result in them seeming changed the next time
it runs.

This commit was sponsored by Vincent Demeester.

Annex.hs

@@ -32,10 +32,6 @@ module Annex (
 	withCurrentState,
 ) where
 
-import "mtl" Control.Monad.Reader
-import Control.Monad.Catch
-import Control.Concurrent
-
 import Common
 import qualified Git
 import qualified Git.Config
@@ -62,11 +58,16 @@ import Types.LockPool
 import Types.MetaData
 import Types.DesktopNotify
 import Types.CleanupActions
-import qualified Data.Map as M
-import qualified Data.Set as S
 #ifdef WITH_QUVI
 import Utility.Quvi (QuviVersion)
 #endif
+import Utility.InodeCache
+
+import "mtl" Control.Monad.Reader
+import Control.Monad.Catch
+import Control.Concurrent
+import qualified Data.Map as M
+import qualified Data.Set as S
 
 {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.
  - This allows modifying the state in an exception-safe fashion.
@@ -120,7 +121,7 @@ data AnnexState = AnnexState
 	, fields :: M.Map String String
 	, modmeta :: [ModMeta]
 	, cleanup :: M.Map CleanupAction (Annex ())
-	, inodeschanged :: Maybe Bool
+	, sentinalstatus :: Maybe SentinalStatus
 	, useragent :: Maybe String
 	, errcounter :: Integer
 	, unusedkeys :: Maybe (S.Set Key)
@@ -165,7 +166,7 @@ newState c r = AnnexState
 	, fields = M.empty
 	, modmeta = []
 	, cleanup = M.empty
-	, inodeschanged = Nothing
+	, sentinalstatus = Nothing
 	, useragent = Nothing
 	, errcounter = 0
 	, unusedkeys = Nothing

Annex/Content/Direct.hs

@@ -1,10 +1,12 @@
 {- git-annex file content managing for direct mode
  -
- - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Annex.Content.Direct (
 	associatedFiles,
 	associatedFilesRelative,
@@ -27,6 +29,8 @@ module Annex.Content.Direct (
 	inodesChanged,
 	createInodeSentinalFile,
 	addContentWhenNotPresent,
+	withTSDelta,
+	getTSDelta,
 ) where
 
 import Common.Annex
@@ -136,7 +140,7 @@ recordedInodeCache key = withInodeCacheFile key $ \f ->
  -}
 updateInodeCache :: Key -> FilePath -> Annex ()
 updateInodeCache key file = maybe noop (addInodeCache key)
-	=<< liftIO (genInodeCache file)
+	=<< withTSDelta (liftIO . genInodeCache file)
 
 {- Adds another inode to the cache for a key. -}
 addInodeCache :: Key -> InodeCache -> Annex ()
@@ -164,16 +168,16 @@ withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key)
 {- Checks if a InodeCache matches the current version of a file. -}
 sameInodeCache :: FilePath -> [InodeCache] -> Annex Bool
 sameInodeCache _ [] = return False
-sameInodeCache file old = go =<< liftIO (genInodeCache file)
+sameInodeCache file old = go =<< withTSDelta (liftIO . genInodeCache file)
   where
 	go Nothing = return False
 	go (Just curr) = elemInodeCaches curr old
 
 {- Checks if a FileStatus matches the recorded InodeCache of a file. -}
 sameFileStatus :: Key -> FileStatus -> Annex Bool
-sameFileStatus key status = do
+sameFileStatus key status = withTSDelta $ \delta -> do
 	old <- recordedInodeCache key
-	let curr = toInodeCache status
+	let curr = toInodeCache delta status
 	case (old, curr) of
 		(_, Just c) -> elemInodeCaches c old
 		([], Nothing) -> return True
@@ -217,40 +221,43 @@ addContentWhenNotPresent key contentfile associatedfile = do
  - inodes have changed.
  -}
 inodesChanged :: Annex Bool
-inodesChanged = maybe calc return =<< Annex.getState Annex.inodeschanged
+inodesChanged = sentinalInodesChanged <$> sentinalStatus
+
+withTSDelta :: (TSDelta -> Annex a) -> Annex a
+withTSDelta a = a =<< getTSDelta
+
+getTSDelta :: Annex TSDelta
+#ifdef mingw32_HOST_OS
+getTSDelta = sentinalTSDelta <$> sentinalStatus
+#else
+getTSDelta = pure noTSDelta -- optimisation
+#endif
+
+sentinalStatus :: Annex SentinalStatus
+sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus
   where
-	calc = do
+	check = do
-		scache <- liftIO . genInodeCache
+		sc <- liftIO . checkSentinalFile =<< annexSentinalFile
-			=<< fromRepo gitAnnexInodeSentinal
+		Annex.changeState $ \s -> s { Annex.sentinalstatus = Just sc }
-		scached <- readInodeSentinalFile
+		return sc
-		let changed = case (scache, scached) of
-			(Just c1, Just c2) -> not $ compareStrong c1 c2
-			_ -> True
-		Annex.changeState $ \s -> s { Annex.inodeschanged = Just changed }
-		return changed
-
-readInodeSentinalFile :: Annex (Maybe InodeCache)
-readInodeSentinalFile = do
-	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
-	liftIO $ catchDefaultIO Nothing $
-		readInodeCache <$> readFile sentinalcachefile
-
-writeInodeSentinalFile :: Annex ()
-writeInodeSentinalFile = do
-	sentinalfile <- fromRepo gitAnnexInodeSentinal
-	createAnnexDirectory (parentDir sentinalfile)
-	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
-	liftIO $ writeFile sentinalfile ""
-	liftIO $ maybe noop (writeFile sentinalcachefile . showInodeCache)
-		=<< genInodeCache sentinalfile
 
 {- The sentinal file is only created when first initializing a repository.
  - If there are any annexed objects in the repository already, creating
  - the file would invalidate their inode caches. -}
 createInodeSentinalFile :: Annex ()
-createInodeSentinalFile =
+createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do
-	unlessM (alreadyexists <||> hasobjects)
+	s <- annexSentinalFile
-		writeInodeSentinalFile
+	createAnnexDirectory (parentDir (sentinalFile s))
+	liftIO $ writeSentinalFile s
   where
-	alreadyexists = isJust <$> readInodeSentinalFile
+	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile
 	hasobjects = liftIO . doesDirectoryExist =<< fromRepo gitAnnexObjectDir
+
+annexSentinalFile :: Annex SentinalFile
+annexSentinalFile = do
+	sentinalfile <- fromRepo gitAnnexInodeSentinal
+	sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
+	return $ SentinalFile
+		{ sentinalFile = sentinalfile
+		, sentinalCacheFile = sentinalcachefile
+		}

Annex/Direct.hs

@@ -53,11 +53,11 @@ stageDirect = do
 	{- Determine what kind of modified or deleted file this is, as
 	 - efficiently as we can, by getting any key that's associated
 	 - with it in git, as well as its stat info. -}
-	go (file, Just sha, Just mode) = do
+	go (file, Just sha, Just mode) = withTSDelta $ \delta -> do
 		shakey <- catKey sha mode
 		mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
 		filekey <- isAnnexLink file
-		case (shakey, filekey, mstat, toInodeCache =<< mstat) of
+		case (shakey, filekey, mstat, toInodeCache delta =<< mstat) of
 			(_, Just key, _, _)
 				| shakey == filekey -> noop
 				{- A changed symlink. -}

Assistant/Threads/Committer.hs

@@ -313,10 +313,11 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 	adddirect toadd = do
 		ct <- liftAnnex compareInodeCachesWith
 		m <- liftAnnex $ removedKeysMap ct cs
+		delta <- liftAnnex getTSDelta
 		if M.null m
 			then forM toadd add
 			else forM toadd $ \c -> do
-				mcache <- liftIO $ genInodeCache $ changeFile c
+				mcache <- liftIO $ genInodeCache (changeFile c) delta
 				case mcache of
 					Nothing -> add c
 					Just cache ->

Command/Add.hs

@@ -102,7 +102,7 @@ lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDo
 
 lockDown' :: FilePath -> Annex (Either IOException KeySource)
 lockDown' file = ifM crippledFileSystem
-	( liftIO $ tryIO nohardlink
+	( withTSDelta $ liftIO . tryIO . nohardlink
 	, tryAnnexIO $ do
 		tmp <- fromRepo gitAnnexTmpMiscDir
 		createAnnexDirectory tmp
@@ -122,22 +122,22 @@ lockDown' file = ifM crippledFileSystem
   	go tmp = do
 		unlessM isDirect $
 			freezeContent file
-		liftIO $ do
+		withTSDelta $ \delta -> liftIO $ do
 			(tmpfile, h) <- openTempFile tmp $
 				relatedTemplate $ takeFileName file
 			hClose h
 			nukeFile tmpfile
-			withhardlink tmpfile `catchIO` const nohardlink
+			withhardlink delta tmpfile `catchIO` const (nohardlink delta)
-  	nohardlink = do
+  	nohardlink delta = do
-		cache <- genInodeCache file
+		cache <- genInodeCache file delta
 		return KeySource
 			{ keyFilename = file
 			, contentLocation = file
 			, inodeCache = cache
 			}
-	withhardlink tmpfile = do
+	withhardlink delta tmpfile = do
 		createLink file tmpfile
-		cache <- genInodeCache tmpfile
+		cache <- genInodeCache tmpfile delta
 		return KeySource
 			{ keyFilename = file
 			, contentLocation = tmpfile
@@ -151,11 +151,11 @@ lockDown' file = ifM crippledFileSystem
  -}
 ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache)
 ingest Nothing = return (Nothing, Nothing)
-ingest (Just source) = do
+ingest (Just source) = withTSDelta $ \delta -> do
 	backend <- chooseBackend $ keyFilename source
 	k <- genKey source backend
 	ms <- liftIO $ catchMaybeIO $ getFileStatus $ contentLocation source
-	let mcache = toInodeCache =<< ms
+	let mcache = toInodeCache delta =<< ms
 	case (mcache, inodeCache source) of
 		(_, Nothing) -> go k mcache ms
 		(Just newc, Just c) | compareStrong c newc -> go k mcache ms

Utility/InodeCache.hs

@@ -6,19 +6,33 @@
  - License: BSD-2-clause
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Utility.InodeCache (
 	InodeCache,
 	InodeComparisonType(..),
+
 	compareStrong,
 	compareWeak,
 	compareBy,
+
 	readInodeCache,
 	showInodeCache,
 	genInodeCache,
 	toInodeCache,
+
 	InodeCacheKey,
 	inodeCacheToKey,
 	inodeCacheToMtime,
+
+	SentinalFile(..),
+	SentinalStatus(..),
+	TSDelta,
+	noTSDelta,
+	writeSentinalFile,
+	checkSentinalFile,
+	sentinalFileExists,
+
 	prop_read_show_inodecache
 ) where
 
@@ -32,7 +46,6 @@ data InodeCachePrim = InodeCachePrim FileID FileOffset EpochTime
 newtype InodeCache = InodeCache InodeCachePrim
 	deriving (Show)
 
-
 {- Inode caches can be compared in two different ways, either weakly
  - or strongly. -}
 data InodeComparisonType = Weakly | Strongly
@@ -92,17 +105,88 @@ readInodeCache s = case words s of
 		in InodeCache <$> prim
 	_ -> Nothing
 
-genInodeCache :: FilePath -> IO (Maybe InodeCache)
+genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)
-genInodeCache f = catchDefaultIO Nothing $ toInodeCache <$> getFileStatus f
+genInodeCache f delta = catchDefaultIO Nothing $
+	toInodeCache delta <$> getFileStatus f
 
-toInodeCache :: FileStatus -> Maybe InodeCache
+toInodeCache :: TSDelta -> FileStatus -> Maybe InodeCache
-toInodeCache s
+toInodeCache (TSDelta delta) s
 	| isRegularFile s = Just $ InodeCache $ InodeCachePrim
 		(fileID s)
 		(fileSize s)
-		(modificationTime s)
+		(modificationTime s + delta)
 	| otherwise = Nothing
 
+{- Some filesystem get new random inodes each time they are mounted.
+ - To detect this and other problems, a sentinal file can be created.
+ - Its InodeCache at the time of its creation is written to the cache file,
+ - so changes can later be detected. -}
+data SentinalFile = SentinalFile
+	{ sentinalFile :: FilePath
+	, sentinalCacheFile :: FilePath
+	}
+	deriving (Show)
+
+{- On Windows, the mtime of a file appears to change when the time zone is
+ - changed. To deal with this, a TSDelta can be used; the delta is added to
+ - the mtime when generating an InodeCache. The current delta can be found
+ - by looking at the SentinalFile. -}
+newtype TSDelta = TSDelta EpochTime
+	deriving (Show)
+
+noTSDelta :: TSDelta
+noTSDelta = TSDelta 0
+
+writeSentinalFile :: SentinalFile -> IO ()
+writeSentinalFile s = do
+	writeFile (sentinalFile s) ""
+	maybe noop (writeFile (sentinalCacheFile s) . showInodeCache)
+		=<< genInodeCache (sentinalFile s) noTSDelta
+
+data SentinalStatus = SentinalStatus
+	{ sentinalInodesChanged :: Bool
+	, sentinalTSDelta :: TSDelta
+	} 
+	deriving (Show)
+
+{- Checks if the InodeCache of the sentinal file is the same
+ - as it was when it was originally created.
+ -
+ - On Windows, there's no change even when there is a nonzero
+ - TSDelta between the original and current InodeCaches.
+ -
+ - If the sential does not exist, returns a dummy value indicating
+ - that it's apparently changed.
+ -}
+checkSentinalFile :: SentinalFile -> IO SentinalStatus
+checkSentinalFile s = do
+	mold <- loadoldcache
+	case mold of
+		Nothing -> return dummy
+		(Just old) -> do
+			mnew <- gennewcache
+			case mnew of
+				Nothing -> return dummy
+				Just new -> return $ calc old new
+  where
+	loadoldcache = catchDefaultIO Nothing $
+		readInodeCache <$> readFile (sentinalCacheFile s)
+	gennewcache = genInodeCache (sentinalFile s) noTSDelta
+	calc (InodeCache (InodeCachePrim inode1 size1 mtime1)) (InodeCache (InodeCachePrim inode2 size2 mtime2)) =
+		SentinalStatus (not unchanged) tsdelta
+	  where
+#ifdef mingw32_HOST_OS
+	  	unchanged = inode1 == inode2 && size1 == size2
+		tsdelta = TSDelta (mtime1 - mtime2)
+#else
+		unchanged = inode1 == inode2 && size1 == size2 && mtime1 == mtime2
+		tsdelta = noTSDelta
+#endif
+	dummy = SentinalStatus True noTSDelta
+
+sentinalFileExists :: SentinalFile -> IO Bool
+sentinalFileExists s = allM doesFileExist [sentinalCacheFile s, sentinalFile s]
+
 instance Arbitrary InodeCache where
 	arbitrary =
 		let prim = InodeCachePrim