134 lines
4.4 KiB
Haskell
134 lines
4.4 KiB
Haskell
module GHCup.File where
|
|
|
|
import Data.ByteString hiding (putStrLn)
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Data.Char
|
|
import Data.Maybe
|
|
import HPath
|
|
import HPath.IO
|
|
import Streamly.ByteString
|
|
import Streamly
|
|
import System.Posix.FilePath hiding ( (</>) )
|
|
import Data.Foldable
|
|
import Control.Monad
|
|
import Control.Exception.Safe
|
|
import Data.Functor
|
|
import System.Posix.Files.ByteString
|
|
import System.Posix.IO.ByteString hiding (openFd)
|
|
import qualified System.Posix.Process.ByteString
|
|
as SPPB
|
|
import System.Posix.Types
|
|
|
|
import qualified Streamly.Internal.Memory.ArrayStream
|
|
as AS
|
|
import qualified Streamly.FileSystem.Handle as FH
|
|
import qualified Streamly.Internal.Data.Unfold as SU
|
|
import qualified Streamly.Prelude as S
|
|
import System.IO
|
|
import System.Exit
|
|
import qualified Streamly.Data.Fold as FL
|
|
import Data.ByteString.Builder
|
|
import Foreign.C.Error
|
|
import GHCup.Prelude
|
|
import Control.Monad.Trans.Maybe
|
|
import HPath.Internal
|
|
import System.Posix.FD
|
|
(
|
|
openFd
|
|
)
|
|
|
|
|
|
|
|
-- |Checks whether a file is executable. Follows symlinks.
|
|
--
|
|
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
|
|
--
|
|
-- Throws:
|
|
--
|
|
-- - `NoSuchThing` if the file does not exist
|
|
--
|
|
-- Note: calls `access`
|
|
isExecutable :: Path b -> IO Bool
|
|
isExecutable p = fileAccess (toFilePath p) False False True
|
|
|
|
|
|
readFd :: Fd -> IO L.ByteString
|
|
readFd fd = do
|
|
handle' <- fdToHandle fd
|
|
let stream =
|
|
(S.unfold (SU.finally hClose FH.readChunks) handle')
|
|
>>= arrayToByteString
|
|
toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream)
|
|
|
|
|
|
-- | Read the lines of a file into a stream. The stream holds
|
|
-- a file handle as a resource and will close it once the stream
|
|
-- terminates (either through exception or because it's drained).
|
|
readFileLines :: Path b -> IO (SerialT IO ByteString)
|
|
readFileLines p = do
|
|
stream <- readFileStream' p
|
|
pure
|
|
. (>>= arrayToByteString)
|
|
. AS.splitOn (fromIntegral $ ord '\n')
|
|
. (>>= byteStringToArray)
|
|
$ stream
|
|
where
|
|
readFileStream' :: Path b
|
|
-> IO (SerialT IO ByteString)
|
|
readFileStream' (MkPath fp) = do
|
|
fd <- openFd fp ReadOnly [] Nothing
|
|
handle' <- fdToHandle fd
|
|
let stream = (S.unfold (SU.finally (\x -> putStrLn "hClose" >> hClose x) FH.readChunks) handle') >>= arrayToByteString
|
|
pure stream
|
|
|
|
|
|
-- | Find the given executable by searching all *absolute* PATH components.
|
|
-- Relative paths in PATH are ignored.
|
|
--
|
|
-- This shouldn't throw IO exceptions, unless getting the environment variable
|
|
-- PATH does.
|
|
findExecutable :: RelC r => Path r -> IO (Maybe (Path Abs))
|
|
findExecutable ex = do
|
|
sPaths <- fmap catMaybes . (fmap . fmap) parseAbs $ getSearchPath
|
|
-- We don't want exceptions to mess up our result. If we can't
|
|
-- figure out if a file exists, then treat it as a negative result.
|
|
asum $ fmap (handleIOError (\_ -> pure Nothing)) $ fmap
|
|
-- asum for short-circuiting behavior
|
|
(\s -> (isExecutable (s </> ex) >>= guard) $> (Just (s </> ex)))
|
|
sPaths
|
|
|
|
|
|
findExecutablee :: RelC r => Path r -> IO (Maybe (Path Abs))
|
|
findExecutablee ex = do
|
|
sPaths <- mapMaybe parseAbs <$> getSearchPath
|
|
runMaybeT $ asum (MaybeT . eExists <$> sPaths)
|
|
where
|
|
eExists sp = let path = sp </> ex in handleIOError (pure $ pure Nothing) $ Just path <$ doesFileExist path
|
|
|
|
|
|
-- TODO: fd leak
|
|
-- | Execute the given command and collect the stdout and the exit code.
|
|
executeOut :: Path Fn -- ^ command as filename, e.g. 'ls'
|
|
-> [ByteString] -- ^ arguments to the command
|
|
-> IO (Maybe (L.ByteString, ExitCode)) -- ^ fst of the tuple is the stdout
|
|
executeOut path args = withFnPath path $ \fp -> do
|
|
(readE, writeE) <- createPipe
|
|
pid <- SPPB.forkProcess $ do
|
|
whileM_
|
|
(dupTo writeE stdOutput)
|
|
(\r ->
|
|
getErrno >>= \e -> pure $ r == fromIntegral (-1 :: Int) && e == eINTR
|
|
)
|
|
closeFd writeE
|
|
closeFd readE
|
|
SPPB.executeFile fp True args Nothing
|
|
|
|
closeFd writeE
|
|
|
|
-- readFd will take care of closing the fd
|
|
SPPB.getProcessStatus True True pid >>= \case
|
|
Just (SPPB.Exited es) -> do
|
|
out <- readFd readE
|
|
pure $ Just (out, es)
|
|
_ -> pure Nothing
|