1#if __GLASGOW_HASKELL__ >= 709
2{-# LANGUAGE Safe #-}
3#else
4{-# LANGUAGE Trustworthy #-}
5#endif
6{-# LANGUAGE CApiFFI #-}
7
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  System.Posix.Files
11-- Copyright   :  (c) The University of Glasgow 2002
12-- License     :  BSD-style (see the file libraries/base/LICENSE)
13--
14-- Maintainer  :  libraries@haskell.org
15-- Stability   :  provisional
16-- Portability :  non-portable (requires POSIX)
17--
18-- Functions defined by the POSIX standards for manipulating and querying the
19-- file system. Names of underlying POSIX functions are indicated whenever
20-- possible. A more complete documentation of the POSIX functions together
21-- with a more detailed description of different error conditions are usually
22-- available in the system's manual pages or from
23-- <http://www.unix.org/version3/online.html> (free registration required).
24--
25-- When a function that calls an underlying POSIX function fails, the errno
26-- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
27-- For a list of which errno codes may be generated, consult the POSIX
28-- documentation for the underlying function.
29--
30-----------------------------------------------------------------------------
31
32#include "HsUnix.h"
33
34module System.Posix.Files (
35    -- * File modes
36    -- FileMode exported by System.Posix.Types
37    unionFileModes, intersectFileModes,
38    nullFileMode,
39    ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
40    groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
41    otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
42    setUserIDMode, setGroupIDMode,
43    stdFileMode,   accessModes,
44    fileTypeModes,
45    blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
46    directoryMode, symbolicLinkMode, socketMode,
47
48    -- ** Setting file modes
49    setFileMode, setFdMode, setFileCreationMask,
50
51    -- ** Checking file existence and permissions
52    fileAccess, fileExist,
53
54    -- * File status
55    FileStatus,
56    -- ** Obtaining file status
57    getFileStatus, getFdStatus, getSymbolicLinkStatus,
58    -- ** Querying file status
59    deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
60    specialDeviceID, fileSize, accessTime, modificationTime,
61    statusChangeTime,
62    accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
63    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
64    isDirectory, isSymbolicLink, isSocket,
65
66    -- * Creation
67    createNamedPipe,
68    createDevice,
69
70    -- * Hard links
71    createLink, removeLink,
72
73    -- * Symbolic links
74    createSymbolicLink, readSymbolicLink,
75
76    -- * Renaming files
77    rename,
78
79    -- * Changing file ownership
80    setOwnerAndGroup,  setFdOwnerAndGroup,
81#if HAVE_LCHOWN
82    setSymbolicLinkOwnerAndGroup,
83#endif
84
85    -- * Changing file timestamps
86    setFileTimes, setFileTimesHiRes,
87    setFdTimesHiRes, setSymbolicLinkTimesHiRes,
88    touchFile, touchFd, touchSymbolicLink,
89
90    -- * Setting file sizes
91    setFileSize, setFdSize,
92
93    -- * Find system-specific limits for a file
94    PathVar(..), getPathVar, getFdPathVar,
95  ) where
96
97
98import Foreign
99import Foreign.C
100
101import System.Posix.Types
102import System.Posix.Files.Common
103import System.Posix.Error
104import System.Posix.Internals
105
106import Data.Time.Clock.POSIX (POSIXTime)
107
108-- -----------------------------------------------------------------------------
109-- chmod()
110
111-- | @setFileMode path mode@ changes permission of the file given by @path@
112-- to @mode@. This operation may fail with 'throwErrnoPathIfMinus1_' if @path@
113-- doesn't exist or if the effective user ID of the current process is not that
114-- of the file's owner.
115--
116-- Note: calls @chmod@.
117setFileMode :: FilePath -> FileMode -> IO ()
118setFileMode name m =
119  withFilePath name $ \s -> do
120    throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
121
122-- -----------------------------------------------------------------------------
123-- access()
124
125-- | @fileAccess name read write exec@ checks if the file (or other file system
126-- object) @name@ can be accessed for reading, writing and\/or executing. To
127-- check a permission set the corresponding argument to 'True'.
128--
129-- Note: calls @access@.
130fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
131fileAccess name readOK writeOK execOK = access name flags
132  where
133   flags   = read_f .|. write_f .|. exec_f
134   read_f  = if readOK  then (#const R_OK) else 0
135   write_f = if writeOK then (#const W_OK) else 0
136   exec_f  = if execOK  then (#const X_OK) else 0
137
138-- | Checks for the existence of the file.
139--
140-- Note: calls @access@.
141fileExist :: FilePath -> IO Bool
142fileExist name =
143  withFilePath name $ \s -> do
144    r <- c_access s (#const F_OK)
145    if (r == 0)
146        then return True
147        else do err <- getErrno
148                if (err == eNOENT)
149                   then return False
150                   else throwErrnoPath "fileExist" name
151
152access :: FilePath -> CMode -> IO Bool
153access name flags =
154  withFilePath name $ \s -> do
155    r <- c_access s (fromIntegral flags)
156    if (r == 0)
157        then return True
158        else do err <- getErrno
159                if (err == eACCES || err == eROFS || err == eTXTBSY ||
160                    err == ePERM)
161                   then return False
162                   else throwErrnoPath "fileAccess" name
163
164
165-- | @getFileStatus path@ calls gets the @FileStatus@ information (user ID,
166-- size, access times, etc.) for the file @path@.
167--
168-- Note: calls @stat@.
169getFileStatus :: FilePath -> IO FileStatus
170getFileStatus path = do
171  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
172  withForeignPtr fp $ \p ->
173    withFilePath path $ \s ->
174      throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
175  return (FileStatus fp)
176
177-- | Acts as 'getFileStatus' except when the 'FilePath' refers to a symbolic
178-- link. In that case the @FileStatus@ information of the symbolic link itself
179-- is returned instead of that of the file it points to.
180--
181-- Note: calls @lstat@.
182getSymbolicLinkStatus :: FilePath -> IO FileStatus
183getSymbolicLinkStatus path = do
184  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
185  withForeignPtr fp $ \p ->
186    withFilePath path $ \s ->
187      throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p)
188  return (FileStatus fp)
189
190foreign import capi unsafe "HsUnix.h lstat"
191  c_lstat :: CString -> Ptr CStat -> IO CInt
192
193-- | @createNamedPipe fifo mode@
194-- creates a new named pipe, @fifo@, with permissions based on
195-- @mode@. May fail with 'throwErrnoPathIfMinus1_' if a file named @name@
196-- already exists or if the effective user ID of the current process doesn't
197-- have permission to create the pipe.
198--
199-- Note: calls @mkfifo@.
200createNamedPipe :: FilePath -> FileMode -> IO ()
201createNamedPipe name mode = do
202  withFilePath name $ \s ->
203    throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)
204
205-- | @createDevice path mode dev@ creates either a regular or a special file
206-- depending on the value of @mode@ (and @dev@).  @mode@ will normally be either
207-- 'blockSpecialMode' or 'characterSpecialMode'.  May fail with
208-- 'throwErrnoPathIfMinus1_' if a file named @name@ already exists or if the
209-- effective user ID of the current process doesn't have permission to create
210-- the file.
211--
212-- Note: calls @mknod@.
213createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
214createDevice path mode dev =
215  withFilePath path $ \s ->
216    throwErrnoPathIfMinus1_ "createDevice" path (c_mknod s mode dev)
217
218foreign import capi unsafe "HsUnix.h mknod"
219  c_mknod :: CString -> CMode -> CDev -> IO CInt
220
221-- -----------------------------------------------------------------------------
222-- Hard links
223
224-- | @createLink old new@ creates a new path, @new@, linked to an existing file,
225-- @old@.
226--
227-- Note: calls @link@.
228createLink :: FilePath -> FilePath -> IO ()
229createLink name1 name2 =
230  withFilePath name1 $ \s1 ->
231  withFilePath name2 $ \s2 ->
232  throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2)
233
234-- | @removeLink path@ removes the link named @path@.
235--
236-- Note: calls @unlink@.
237removeLink :: FilePath -> IO ()
238removeLink name =
239  withFilePath name $ \s ->
240  throwErrnoPathIfMinus1_ "removeLink" name (c_unlink s)
241
242-- -----------------------------------------------------------------------------
243-- Symbolic Links
244
245-- | @createSymbolicLink file1 file2@ creates a symbolic link named @file2@
246-- which points to the file @file1@.
247--
248-- Symbolic links are interpreted at run-time as if the contents of the link
249-- had been substituted into the path being followed to find a file or directory.
250--
251-- Note: calls @symlink@.
252createSymbolicLink :: FilePath -> FilePath -> IO ()
253createSymbolicLink file1 file2 =
254  withFilePath file1 $ \s1 ->
255  withFilePath file2 $ \s2 ->
256  throwErrnoPathIfMinus1_ "createSymbolicLink" file2 (c_symlink s1 s2)
257
258foreign import ccall unsafe "symlink"
259  c_symlink :: CString -> CString -> IO CInt
260
261-- ToDo: should really use SYMLINK_MAX, but not everyone supports it yet,
262-- and it seems that the intention is that SYMLINK_MAX is no larger than
263-- PATH_MAX.
264#if !defined(PATH_MAX)
265-- PATH_MAX is not defined on systems with unlimited path length.
266-- Ugly.  Fix this.
267#define PATH_MAX 4096
268#endif
269
270-- | Reads the @FilePath@ pointed to by the symbolic link and returns it.
271--
272-- Note: calls @readlink@.
273readSymbolicLink :: FilePath -> IO FilePath
274readSymbolicLink file =
275  allocaArray0 (#const PATH_MAX) $ \buf -> do
276    withFilePath file $ \s -> do
277      len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
278        c_readlink s buf (#const PATH_MAX)
279      peekFilePathLen (buf,fromIntegral len)
280
281foreign import ccall unsafe "readlink"
282  c_readlink :: CString -> CString -> CSize -> IO CInt
283
284-- -----------------------------------------------------------------------------
285-- Renaming files
286
287-- | @rename old new@ renames a file or directory from @old@ to @new@.
288--
289-- Note: calls @rename@.
290rename :: FilePath -> FilePath -> IO ()
291rename name1 name2 =
292  withFilePath name1 $ \s1 ->
293  withFilePath name2 $ \s2 ->
294  throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2)
295
296foreign import ccall unsafe "rename"
297   c_rename :: CString -> CString -> IO CInt
298
299-- -----------------------------------------------------------------------------
300-- chown()
301
302-- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to
303-- @uid@ and @gid@, respectively.
304--
305-- If @uid@ or @gid@ is specified as -1, then that ID is not changed.
306--
307-- Note: calls @chown@.
308setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
309setOwnerAndGroup name uid gid = do
310  withFilePath name $ \s ->
311    throwErrnoPathIfMinus1_ "setOwnerAndGroup" name (c_chown s uid gid)
312
313foreign import ccall unsafe "chown"
314  c_chown :: CString -> CUid -> CGid -> IO CInt
315
316#if HAVE_LCHOWN
317-- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus
318-- changes permissions on the link itself).
319--
320-- Note: calls @lchown@.
321setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
322setSymbolicLinkOwnerAndGroup name uid gid = do
323  withFilePath name $ \s ->
324    throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name
325        (c_lchown s uid gid)
326
327foreign import ccall unsafe "lchown"
328  c_lchown :: CString -> CUid -> CGid -> IO CInt
329#endif
330
331-- -----------------------------------------------------------------------------
332-- Setting file times
333
334-- | @setFileTimes path atime mtime@ sets the access and modification times
335-- associated with file @path@ to @atime@ and @mtime@, respectively.
336--
337-- Note: calls @utime@.
338setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
339setFileTimes name atime mtime = do
340  withFilePath name $ \s ->
341   allocaBytes (#const sizeof(struct utimbuf)) $ \p -> do
342     (#poke struct utimbuf, actime)  p atime
343     (#poke struct utimbuf, modtime) p mtime
344     throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p)
345
346-- | Like 'setFileTimes' but timestamps can have sub-second resolution.
347--
348-- Note: calls @utimensat@ or @utimes@.
349--
350-- @since 2.7.0.0
351setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
352#ifdef HAVE_UTIMENSAT
353setFileTimesHiRes name atime mtime =
354  withFilePath name $ \s ->
355    withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
356      throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
357        c_utimensat (#const AT_FDCWD) s times 0
358#else
359setFileTimesHiRes name atime mtime =
360  withFilePath name $ \s ->
361    withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
362      throwErrnoPathIfMinus1_ "setFileTimesHiRes" name (c_utimes s times)
363#endif
364
365-- | Like 'setFileTimesHiRes' but does not follow symbolic links.
366-- This operation is not supported on all platforms. On these platforms,
367-- this function will raise an exception.
368--
369-- Note: calls @utimensat@ or @lutimes@.
370--
371-- @since 2.7.0.0
372setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
373#if HAVE_UTIMENSAT
374setSymbolicLinkTimesHiRes name atime mtime =
375  withFilePath name $ \s ->
376    withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
377      throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
378        c_utimensat (#const AT_FDCWD) s times (#const AT_SYMLINK_NOFOLLOW)
379#elif HAVE_LUTIMES
380setSymbolicLinkTimesHiRes name atime mtime =
381  withFilePath name $ \s ->
382    withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
383      throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
384        c_lutimes s times
385#else
386setSymbolicLinkTimesHiRes =
387  error "setSymbolicLinkTimesHiRes: not available on this platform"
388#endif
389
390-- | @touchFile path@ sets the access and modification times associated with
391-- file @path@ to the current time.
392--
393-- Note: calls @utime@.
394touchFile :: FilePath -> IO ()
395touchFile name = do
396  withFilePath name $ \s ->
397   throwErrnoPathIfMinus1_ "touchFile" name (c_utime s nullPtr)
398
399-- | Like 'touchFile' but does not follow symbolic links.
400-- This operation is not supported on all platforms. On these platforms,
401-- this function will raise an exception.
402--
403-- Note: calls @lutimes@.
404--
405-- @since 2.7.0.0
406touchSymbolicLink :: FilePath -> IO ()
407#if HAVE_LUTIMES
408touchSymbolicLink name =
409  withFilePath name $ \s ->
410    throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)
411#else
412touchSymbolicLink =
413  error "touchSymbolicLink: not available on this platform"
414#endif
415
416-- -----------------------------------------------------------------------------
417-- Setting file sizes
418
419-- | Truncates the file down to the specified length. If the file was larger
420-- than the given length before this operation was performed the extra is lost.
421--
422-- Note: calls @truncate@.
423setFileSize :: FilePath -> FileOffset -> IO ()
424setFileSize file off =
425  withFilePath file $ \s ->
426    throwErrnoPathIfMinus1_ "setFileSize" file (c_truncate s off)
427
428foreign import capi unsafe "HsUnix.h truncate"
429  c_truncate :: CString -> COff -> IO CInt
430
431-- -----------------------------------------------------------------------------
432-- pathconf()/fpathconf() support
433
434-- | @getPathVar var path@ obtains the dynamic value of the requested
435-- configurable file limit or option associated with file or directory @path@.
436-- For defined file limits, @getPathVar@ returns the associated
437-- value.  For defined file options, the result of @getPathVar@
438-- is undefined, but not failure.
439--
440-- Note: calls @pathconf@.
441getPathVar :: FilePath -> PathVar -> IO Limit
442getPathVar name v = do
443  withFilePath name $ \ nameP ->
444    throwErrnoPathIfMinus1 "getPathVar" name $
445      c_pathconf nameP (pathVarConst v)
446
447foreign import ccall unsafe "pathconf"
448  c_pathconf :: CString -> CInt -> IO CLong
449