snoyberg/keter
1
1
Fork 0
mirror of https://github.com/snoyberg/keter.git synced 2024-12-15 01:23:09 +03:00
Code Issues Projects Releases Wiki Activity

CloseOnExec for creating files

Browse Source 
This should solve the text file busy issue. The problem was that while
one green thread was writing a file to disk, another would already be
forking a process for executing a separate app. That new process would
retain a write FD to the file being created, which prevented that file
from eventually being executed.
This commit is contained in:
Michael Snoyman 2012-10-15 14:35:39 +02:00
parent cbd0f9d19e
commit bc095450b2
1 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Keter/App.hs
View File

@ -24,16 +24,18 @@ import Codec.Compression.GZip (decompress)
import qualified Filesystem.Path.CurrentOS as F import qualified Filesystem.Path.CurrentOS as F
import Data.Yaml import Data.Yaml
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import System.PosixCompat.Files
import qualified Network import qualified Network
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import Control.Exception (onException, throwIO) import Control.Exception (onException, throwIO, bracket)
import System.IO (hClose) import System.IO (hClose)
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.Conduit (($$), yield, runResourceT) import Data.Conduit (($$), yield)
import Data.Conduit.Binary (sinkFile)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Conduit.List as CL
import System.Posix.IO.ByteString (fdWriteBuf, closeFd, FdOption (CloseOnExec), setFdOption, createFile)
import Foreign.Ptr (castPtr)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
data Config = Config data Config = Config
{ configExec :: F.FilePath { configExec :: F.FilePath
@ -121,8 +123,16 @@ unpackTar dir =
case Tar.entryContent e of case Tar.entryContent e of
Tar.NormalFile lbs _ -> do Tar.NormalFile lbs _ -> do
createTree $ F.directory fp createTree $ F.directory fp
runResourceT $ mapM_ yield (L.toChunks lbs) $$ sinkFile (F.encodeString fp) let write fd bs = unsafeUseAsCStringLen bs $ \(ptr, len) -> do
setFileMode (F.encodeString fp) $ Tar.entryPermissions e _ <- fdWriteBuf fd (castPtr ptr) (fromIntegral len)
return ()
bracket
(do
fd <- createFile (F.encode fp) $ Tar.entryPermissions e
setFdOption fd CloseOnExec True
return fd)
closeFd
(\fd -> mapM_ yield (L.toChunks lbs) $$ CL.mapM_ (write fd))
_ -> return () _ -> return ()
start :: TempFolder start :: TempFolder