From 30d69f404ba102da94423836f86fbec2fb4adaf9 Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Tue, 7 Mar 2017 09:55:02 -0500 Subject: ghc-pkg: Consider .conf files when computing package db mtime We can no longer use the mtime of the containing directory since it now contains a lock file in addition to the .cache and .conf files. Fixes #13375. Test Plan: Validate on Windows Reviewers: austin, arybczak Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3289 --- utils/ghc-pkg/Main.hs | 85 +++++++++++++-------------------------------------- 1 file changed, 21 insertions(+), 64 deletions(-) (limited to 'utils/ghc-pkg') diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c5ecbf23e1..ed73c2960b 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -832,14 +832,15 @@ readParseDatabase verbosity mb_user_conf mode use_cache path Right fs | not use_cache -> ignore_cache (const $ return ()) | otherwise -> do - tdir <- getModificationTime path e_tcache <- tryIO $ getModificationTime cache case e_tcache of Left ex -> do whenReportCacheErrors $ if isDoesNotExistError ex then - when (verbosity >= Verbose) $ do + -- It's fine if the cache is not there as long as the + -- database is empty. + when (not $ null confs) $ do warn ("WARNING: cache does not exist: " ++ cache) warn ("ghc will fail to read this package db. " ++ recacheAdvice) @@ -848,21 +849,13 @@ readParseDatabase verbosity mb_user_conf mode use_cache path warn "ghc will fail to read this package db." ignore_cache (const $ return ()) Right tcache -> do - let compareTimestampToCache file = - when (verbosity >= Verbose) $ do - tFile <- getModificationTime file - compareTimestampToCache' file tFile - compareTimestampToCache' file tFile = do - let rel = case tcache `compare` tFile of - LT -> " (NEWER than cache)" - GT -> " (older than cache)" - EQ -> " (same as cache)" - warn ("Timestamp " ++ show tFile - ++ " for " ++ file ++ rel) when (verbosity >= Verbose) $ do warn ("Timestamp " ++ show tcache ++ " for " ++ cache) - compareTimestampToCache' path tdir - if tcache >= tdir + -- If any of the .conf files is newer than package.cache, we + -- assume that cache is out of date. + cache_outdated <- (`anyM` confs) $ \conf -> + (tcache <) <$> getModificationTime conf + if not cache_outdated then do when (verbosity > Normal) $ infoLn ("using cache: " ++ cache) @@ -873,18 +866,27 @@ readParseDatabase verbosity mb_user_conf mode use_cache path warn ("WARNING: cache is out of date: " ++ cache) warn ("ghc will see an old view of this " ++ "package db. " ++ recacheAdvice) - ignore_cache compareTimestampToCache + ignore_cache $ \file -> do + when (verbosity >= Verbose) $ do + tFile <- getModificationTime file + let rel = case tcache `compare` tFile of + LT -> " (NEWER than cache)" + GT -> " (older than cache)" + EQ -> " (same as cache)" + warn ("Timestamp " ++ show tFile + ++ " for " ++ file ++ rel) where + confs = map (path ) $ filter (".conf" `isSuffixOf`) fs + ignore_cache :: (FilePath -> IO ()) -> IO (PackageDB mode) ignore_cache checkTime = do -- If we're opening for modification, we need to acquire a -- lock even if we don't open the cache now, because we are -- going to modify it later. lock <- F.mapM (const $ GhcPkg.lockPackageDb cache) mode - let confs = filter (".conf" `isSuffixOf`) fs - doFile f = do checkTime f + let doFile f = do checkTime f parseSingletonPackageConf verbosity f - pkgs <- mapM doFile $ map (path ) confs + pkgs <- mapM doFile confs mkPackageDB pkgs lock -- We normally report cache errors for read-only commands, @@ -1215,16 +1217,6 @@ updateDBCache verbosity db = do then die $ filename ++ ": you don't have permission to modify this file" else ioError e - -- See Note [writeAtomic leaky abstraction] - -- Cross-platform "touch". This only works if filename is not empty, and - -- not open for writing already. - -- TODO. When the Win32 or directory packages have either a touchFile or a - -- setModificationTime function, use one of those. - withBinaryFile filename ReadWriteMode $ \handle -> do - c <- hGetChar handle - hSeek handle AbsoluteSeek 0 - hPutChar handle c - case packageDbLock db of GhcPkg.DbOpenReadWrite lock -> GhcPkg.unlockPackageDb lock @@ -2180,38 +2172,3 @@ removeFileSafe fn = -- absolute path. absolutePath :: FilePath -> IO FilePath absolutePath path = return . normalise . ( path) =<< getCurrentDirectory - - -{- Note [writeAtomic leaky abstraction] -GhcPkg.writePackageDb calls writeAtomic, which first writes to a temp file, -and then moves the tempfile to its final destination. This all happens in the -same directory (package.conf.d). -Moving a file doesn't change its modification time, but it *does* change the -modification time of the directory it is placed in. Since we compare the -modification time of the cache file to that of the directory it is in to -decide whether the cache is out-of-date, it will be instantly out-of-date -after creation, if the renaming takes longer than the smallest time difference -that the getModificationTime can measure. - -The solution we opt for is a "touch" of the cache file right after it is -created. This resets the modification time of the cache file and the directory -to the current time. - -Other possible solutions: - * backdate the modification time of the directory to the modification time - of the cachefile. This is what we used to do on posix platforms. An - observer of the directory would see the modification time of the directory - jump back in time. Not nice, although in practice probably not a problem. - Also note that a cross-platform implementation of setModificationTime is - currently not available. - * set the modification time of the cache file to the modification time of - the directory (instead of the curent time). This could also work, - given that we are the only ones writing to this directory. It would also - require a high-precision getModificationTime (lower precision times get - rounded down it seems), or the cache would still be out-of-date. - * change writeAtomic to create the tempfile outside of the target file's - directory. - * create the cachefile outside of the package.conf.d directory in the first - place. But there are tests and there might be tools that currently rely on - the package.conf.d/package.cache format. --} -- cgit v1.2.1