Ticket #5013: Files.hsc

File Files.hsc, 13.3 KB (added by maeder, 15 months ago)

patched

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