Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/08bd3b0479856933019462858be1690ac0267405 >--------------------------------------------------------------- commit 08bd3b0479856933019462858be1690ac0267405 Author: Duncan Coutts <[email protected]> Date: Fri Aug 22 23:00:33 2008 +0000 Decompress the repo index atomically. So if decompression fails (eg if the index is corrupt) then the decompressed file does not get (partially) written. >--------------------------------------------------------------- cabal-install/Distribution/Client/Update.hs | 8 ++++++-- cabal-install/Distribution/Client/Utils.hs | 26 ++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/cabal-install/Distribution/Client/Update.hs b/cabal-install/Distribution/Client/Update.hs index cf8a1d9..1c42661 100644 --- a/cabal-install/Distribution/Client/Update.hs +++ b/cabal-install/Distribution/Client/Update.hs @@ -15,7 +15,11 @@ module Distribution.Client.Update ) where import Distribution.Client.Types + ( Repo(..), RemoteRepo(..), LocalRepo(..) ) import Distribution.Client.Fetch + ( downloadIndex ) +import qualified Distribution.Client.Utils as BS + ( writeFileAtomic ) import Distribution.Simple.Utils (notice) import Distribution.Verbosity (Verbosity) @@ -35,5 +39,5 @@ updateRepo verbosity repo = case repoKind repo of notice verbosity $ "Downloading package list from server '" ++ show (remoteRepoURI remoteRepo) ++ "'" indexPath <- downloadIndex verbosity remoteRepo (repoLocalDir repo) - BS.writeFile (dropExtension indexPath) . GZip.decompress - =<< BS.readFile indexPath + BS.writeFileAtomic (dropExtension indexPath) . GZip.decompress + =<< BS.readFile indexPath diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 3094f9b..30c68bf 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -2,6 +2,15 @@ module Distribution.Client.Utils where import Data.List ( sortBy, groupBy ) +import qualified Data.ByteString.Lazy as BS +import System.FilePath + ( (<.>), splitFileName ) +import System.IO + ( openBinaryTempFile, hClose ) +import System.Directory + ( removeFile, renameFile ) +import qualified Control.Exception as Exception + ( handle, throwIO ) -- | Generic merging utility. For sorted input lists this is a full outer join. -- @@ -31,3 +40,20 @@ duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp _ -> False moreThanOne (_:_:_) = True moreThanOne _ = False + +writeFileAtomic :: FilePath -> BS.ByteString -> IO () +writeFileAtomic targetFile content = do + (tmpFile, tmpHandle) <- openBinaryTempFile targetDir template + Exception.handle (\err -> do hClose tmpHandle + removeFile tmpFile + Exception.throwIO err) $ do + BS.hPut tmpHandle content + hClose tmpHandle + renameFile tmpFile targetFile + where + template = targetName <.> "tmp" + targetDir | null targetDir_ = "." + | otherwise = targetDir_ + --TODO: remove this when takeDirectory/splitFileName is fixed + -- to always return a valid dir + (targetDir_,targetName) = splitFileName targetFile _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
