Commit a534ec99 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Be more careful about closing files before they're deleted

Using withFile rather than readFile for reading temp files in the utils
that invoke curl and wget.

Add a dep on deepseq. This is not new since Cabal also depends on it.
parent 64f5c5b8
......@@ -27,6 +27,10 @@ import Network.Browser
import Control.Applicative
#endif
import qualified Control.Exception as Exception
import Control.Exception
( evaluate )
import Control.DeepSeq
( force )
import Control.Monad
( when, guard )
import qualified Data.ByteString.Lazy.Char8 as BS
......@@ -56,6 +60,8 @@ import System.FilePath
( (<.>) )
import System.Directory
( doesFileExist, renameFile )
import System.IO
( withFile, IOMode(ReadMode), hGetContents, hClose )
import System.IO.Error
( isDoesNotExistError )
import Distribution.Simple.Program
......@@ -70,7 +76,6 @@ import Distribution.Simple.Program.Run
( IOEncoding(..), getEffectiveEnvironment )
import Numeric (showHex)
import System.Directory (canonicalizePath)
import System.IO (hClose)
import System.FilePath (takeFileName, takeDirectory)
import System.Random (randomRIO)
import System.Exit (ExitCode(..))
......@@ -340,9 +345,10 @@ curlTransport prog =
resp <- getProgramInvocationOutput verbosity
(programInvocation prog args)
headers <- readFile tmpFile
(code, _err, etag') <- parseResponse uri resp headers
return (code, etag')
withFile tmpFile ReadMode $ \hnd -> do
headers <- hGetContents hnd
(code, _err, etag') <- parseResponse uri resp headers
evaluate $ force (code, etag')
posthttp = noPostYet
......@@ -387,8 +393,9 @@ curlTransport prog =
(code, err, _etag) <- parseResponse uri resp ""
return (code, err)
-- on success these curl involcations produces an output like "200"
-- on success these curl invocations produces an output like "200"
-- and on failure it has the server error response first
parseResponse :: URI -> String -> String -> IO (Int, String, Maybe ETag)
parseResponse uri resp headers =
let codeerr =
case reverse (lines resp) of
......@@ -450,8 +457,9 @@ wgetTransport prog =
"boundary=" ++ boundary ]
out <- runWGet verbosity (addUriAuth auth uri) args
(code, _etag) <- parseOutput uri out
resp <- readFile responseFile
return (code, resp)
withFile responseFile ReadMode $ \hnd -> do
resp <- hGetContents hnd
evaluate $ force (code, resp)
puthttpfile verbosity uri path auth headers =
withTempFile (takeDirectory path) "response" $ \responseFile responseHandle -> do
......@@ -466,8 +474,9 @@ wgetTransport prog =
out <- runWGet verbosity (addUriAuth auth uri) args
(code, _etag) <- parseOutput uri out
resp <- readFile responseFile
return (code, resp)
withFile responseFile ReadMode $ \hnd -> do
resp <- hGetContents hnd
evaluate $ force (code, resp)
addUriAuth Nothing uri = uri
addUriAuth (Just (user, pass)) uri = uri
......
......@@ -367,6 +367,7 @@ executable cabal
Cabal >= 1.25 && < 1.26,
containers >= 0.4 && < 0.6,
cryptohash-sha256 >= 0.11 && < 0.12,
deepseq >= 1.3 && < 1.5,
filepath >= 1.3 && < 1.5,
hashable >= 1.0 && < 2,
HTTP >= 4000.1.5 && < 4000.4,
......@@ -453,6 +454,7 @@ Test-Suite unit-tests
bytestring,
Cabal,
containers,
deepseq,
mtl,
pretty,
process,
......@@ -613,6 +615,7 @@ test-suite integration-tests2
Cabal,
containers,
cryptohash-sha256,
deepseq,
directory,
filepath,
hackage-security,
......
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