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