diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/FileUtils.c | 18 | ||||
| -rw-r--r-- | src/FileUtils.hs | 48 |
2 files changed, 64 insertions, 2 deletions
diff --git a/src/FileUtils.c b/src/FileUtils.c new file mode 100644 index 0000000..3cf2997 --- /dev/null +++ b/src/FileUtils.c @@ -0,0 +1,18 @@ +#include <fcntl.h> +#include <sys/stat.h> +#include <unistd.h> + +int minici_fd_open_read( const char * from ) +{ + return open( from, O_RDONLY | O_CLOEXEC ); +} + +int minici_fd_create_write( const char * from, int fd_perms ) +{ + struct stat st; + mode_t mode = 0600; + if( fstat( fd_perms, & st ) == 0 ) + mode = st.st_mode; + + return open( from, O_CREAT | O_WRONLY | O_TRUNC | O_CLOEXEC, mode ); +} diff --git a/src/FileUtils.hs b/src/FileUtils.hs index d147b7c..a59548f 100644 --- a/src/FileUtils.hs +++ b/src/FileUtils.hs @@ -1,16 +1,60 @@ module FileUtils where import Control.Monad +import Control.Monad.Catch + +import Data.ByteString (useAsCString) +import Data.Text qualified as T +import Data.Text.Encoding + +import Foreign.C.Error +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr -import System.FilePath import System.Directory +import System.FilePath +import System.Posix.IO.ByteString +import System.Posix.Types + + +-- As of directory-1.3.9 and file-io-0.1.5, the provided copyFile creates a +-- temporary file without O_CLOEXEC, sometimes leaving the write descriptor +-- open in child processes. +safeCopyFile :: FilePath -> FilePath -> IO () +safeCopyFile from to = do + allocaBytes (fromIntegral bufferSize) $ \buf -> + useAsCString (encodeUtf8 $ T.pack from) $ \cfrom -> + useAsCString (encodeUtf8 $ T.pack to) $ \cto -> + bracket (throwErrnoPathIfMinus1 "open" from $ c_fd_open_read cfrom) closeFd $ \fromFd -> + bracket (throwErrnoPathIfMinus1 "open" to $ c_fd_create_write cto fromFd) closeFd $ \toFd -> do + let goRead = do + count <- throwErrnoIfMinus1Retry ("read " <> from) $ fdReadBuf fromFd buf bufferSize + when (count > 0) $ do + goWrite count 0 + goWrite count written + | written < count = do + written' <- throwErrnoIfMinus1Retry ("write " <> to) $ + fdWriteBuf toFd (buf `plusPtr` fromIntegral written) (count - written) + goWrite count (written + written') + | otherwise = do + goRead + goRead + where + bufferSize = 131072 + +-- Custom open(2) wrappers using O_CLOEXEC. The `cloexec` in `OpenFileFlags` is +-- available only since unix-2.8.0.0 +foreign import ccall "minici_fd_open_read" c_fd_open_read :: CString -> IO Fd +foreign import ccall "minici_fd_create_write" c_fd_create_write :: CString -> Fd -> IO Fd copyRecursive :: FilePath -> FilePath -> IO () copyRecursive from to = do doesDirectoryExist from >>= \case False -> do - copyFile from to + safeCopyFile from to True -> do createDirectory to content <- listDirectory from |