Commit cd81cd88 authored by Simon Marlow's avatar Simon Marlow
Browse files

Write the binary cache file atomically

Should fix an occasional build error of the form 
 ghc-pkg: too few bytes. Failed reading at byte position 8
parent 32578fc5
...@@ -10,7 +10,7 @@ ...@@ -10,7 +10,7 @@
module Main (main) where module Main (main) where
import Version ( version, targetOS, targetARCH ) import Version ( version, targetOS, targetARCH )
import Distribution.InstalledPackageInfo.Binary import Distribution.InstalledPackageInfo.Binary()
import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.ModuleName hiding (main) import Distribution.ModuleName hiding (main)
import Distribution.InstalledPackageInfo import Distribution.InstalledPackageInfo
...@@ -735,7 +735,7 @@ updateDBCache verbosity db = do ...@@ -735,7 +735,7 @@ updateDBCache verbosity db = do
let filename = location db </> cachefilename let filename = location db </> cachefilename
when (verbosity > Normal) $ when (verbosity > Normal) $
putStrLn ("writing cache " ++ filename) putStrLn ("writing cache " ++ filename)
writeBinPackageDB filename (map convertPackageInfoOut (packages db)) writeBinaryFileAtomic filename (map convertPackageInfoOut (packages db))
`catch` \e -> `catch` \e ->
if isPermissionError e if isPermissionError e
then die (filename ++ ": you don't have permission to modify this file") then die (filename ++ ": you don't have permission to modify this file")
...@@ -1548,12 +1548,20 @@ catchError io handler = io `Exception.catch` handler' ...@@ -1548,12 +1548,20 @@ catchError io handler = io `Exception.catch` handler'
where handler' (Exception.ErrorCall err) = handler err where handler' (Exception.ErrorCall err) = handler err
writeBinaryFileAtomic :: Bin.Binary a => FilePath -> a -> IO ()
writeBinaryFileAtomic targetFile obj =
withFileAtomic targetFile $ \h -> B.hPutStr h (Bin.encode obj)
writeFileAtomic :: FilePath -> String -> IO ()
writeFileAtomic targetFile content =
withFileAtomic targetFile $ \h -> hPutStr h content
-- copied from Cabal's Distribution.Simple.Utils, except that we want -- copied from Cabal's Distribution.Simple.Utils, except that we want
-- to use text files here, rather than binary files. -- to use text files here, rather than binary files.
writeFileAtomic :: FilePath -> String -> IO () withFileAtomic :: FilePath -> (Handle -> IO ()) -> IO ()
writeFileAtomic targetFile content = do withFileAtomic targetFile write_content = do
(newFile, newHandle) <- openNewFile targetDir template (newFile, newHandle) <- openNewFile targetDir template
do hPutStr newHandle content do write_content newHandle
hClose newHandle hClose newHandle
#if mingw32_HOST_OS || mingw32_TARGET_OS #if mingw32_HOST_OS || mingw32_TARGET_OS
renameFile newFile targetFile renameFile newFile targetFile
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment