1{-# LANGUAGE CApiFFI #-} 2{-# LANGUAGE NondecreasingIndentation #-} 3#if __GLASGOW_HASKELL__ >= 709 4{-# LANGUAGE Safe #-} 5#else 6{-# LANGUAGE Trustworthy #-} 7#endif 8 9----------------------------------------------------------------------------- 10-- | 11-- Module : System.Posix.Directory 12-- Copyright : (c) The University of Glasgow 2002 13-- License : BSD-style (see the file libraries/base/LICENSE) 14-- 15-- Maintainer : libraries@haskell.org 16-- Stability : provisional 17-- Portability : non-portable (requires POSIX) 18-- 19-- String-based POSIX directory support 20-- 21----------------------------------------------------------------------------- 22 23#include "HsUnix.h" 24 25-- hack copied from System.Posix.Files 26#if !defined(PATH_MAX) 27# define PATH_MAX 4096 28#endif 29 30module System.Posix.Directory ( 31 -- * Creating and removing directories 32 createDirectory, removeDirectory, 33 34 -- * Reading directories 35 DirStream, 36 openDirStream, 37 readDirStream, 38 rewindDirStream, 39 closeDirStream, 40 DirStreamOffset, 41#ifdef HAVE_TELLDIR 42 tellDirStream, 43#endif 44#ifdef HAVE_SEEKDIR 45 seekDirStream, 46#endif 47 48 -- * The working dirctory 49 getWorkingDirectory, 50 changeWorkingDirectory, 51 changeWorkingDirectoryFd, 52 ) where 53 54import System.IO.Error 55import System.Posix.Error 56import System.Posix.Types 57import Foreign 58import Foreign.C 59 60import System.Posix.Directory.Common 61import System.Posix.Internals (withFilePath, peekFilePath) 62 63-- | @createDirectory dir mode@ calls @mkdir@ to 64-- create a new directory, @dir@, with permissions based on 65-- @mode@. 66createDirectory :: FilePath -> FileMode -> IO () 67createDirectory name mode = 68 withFilePath name $ \s -> 69 throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode) 70 -- POSIX doesn't allow mkdir() to return EINTR, but it does on 71 -- OS X (#5184), so we need the Retry variant here. 72 73foreign import ccall unsafe "mkdir" 74 c_mkdir :: CString -> CMode -> IO CInt 75 76-- | @openDirStream dir@ calls @opendir@ to obtain a 77-- directory stream for @dir@. 78openDirStream :: FilePath -> IO DirStream 79openDirStream name = 80 withFilePath name $ \s -> do 81 dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s 82 return (DirStream dirp) 83 84foreign import capi unsafe "HsUnix.h opendir" 85 c_opendir :: CString -> IO (Ptr CDir) 86 87-- | @readDirStream dp@ calls @readdir@ to obtain the 88-- next directory entry (@struct dirent@) for the open directory 89-- stream @dp@, and returns the @d_name@ member of that 90-- structure. 91readDirStream :: DirStream -> IO FilePath 92readDirStream (DirStream dirp) = 93 alloca $ \ptr_dEnt -> loop ptr_dEnt 94 where 95 loop ptr_dEnt = do 96 resetErrno 97 r <- c_readdir dirp ptr_dEnt 98 if (r == 0) 99 then do dEnt <- peek ptr_dEnt 100 if (dEnt == nullPtr) 101 then return [] 102 else do 103 entry <- (d_name dEnt >>= peekFilePath) 104 c_freeDirEnt dEnt 105 return entry 106 else do errno <- getErrno 107 if (errno == eINTR) then loop ptr_dEnt else do 108 let (Errno eo) = errno 109 if (eo == 0) 110 then return [] 111 else throwErrno "readDirStream" 112 113-- traversing directories 114foreign import ccall unsafe "__hscore_readdir" 115 c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt 116 117foreign import ccall unsafe "__hscore_free_dirent" 118 c_freeDirEnt :: Ptr CDirent -> IO () 119 120foreign import ccall unsafe "__hscore_d_name" 121 d_name :: Ptr CDirent -> IO CString 122 123 124-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name 125-- of the current working directory. 126getWorkingDirectory :: IO FilePath 127getWorkingDirectory = go (#const PATH_MAX) 128 where 129 go bytes = do 130 r <- allocaBytes bytes $ \buf -> do 131 buf' <- c_getcwd buf (fromIntegral bytes) 132 if buf' /= nullPtr 133 then do s <- peekFilePath buf 134 return (Just s) 135 else do errno <- getErrno 136 if errno == eRANGE 137 -- we use Nothing to indicate that we should 138 -- try again with a bigger buffer 139 then return Nothing 140 else throwErrno "getWorkingDirectory" 141 maybe (go (2 * bytes)) return r 142 143foreign import ccall unsafe "getcwd" 144 c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar) 145 146-- | @changeWorkingDirectory dir@ calls @chdir@ to change 147-- the current working directory to @dir@. 148changeWorkingDirectory :: FilePath -> IO () 149changeWorkingDirectory path = 150 modifyIOError (`ioeSetFileName` path) $ 151 withFilePath path $ \s -> 152 throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s) 153 154foreign import ccall unsafe "chdir" 155 c_chdir :: CString -> IO CInt 156 157removeDirectory :: FilePath -> IO () 158removeDirectory path = 159 modifyIOError (`ioeSetFileName` path) $ 160 withFilePath path $ \s -> 161 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s) 162 163foreign import ccall unsafe "rmdir" 164 c_rmdir :: CString -> IO CInt 165