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