1{-# LANGUAGE CPP #-}
2
3{-|
4This module makes the operations exported by @System.Posix.Files@
5available on all platforms. On POSIX systems it re-exports operations from
6@System.Posix.Files@. On other platforms it emulates the operations as far
7as possible.
8
9/NOTE: the portable implementations are not well tested, in some cases
10functions are only stubs./
11-}
12module System.PosixCompat.Files (
13    -- * File modes
14    -- FileMode exported by System.Posix.Types
15      unionFileModes
16    , intersectFileModes
17    , nullFileMode
18    , ownerReadMode
19    , ownerWriteMode
20    , ownerExecuteMode
21    , ownerModes
22    , groupReadMode
23    , groupWriteMode
24    , groupExecuteMode
25    , groupModes
26    , otherReadMode
27    , otherWriteMode
28    , otherExecuteMode
29    , otherModes
30    , setUserIDMode
31    , setGroupIDMode
32    , stdFileMode
33    , accessModes
34
35    -- ** Setting file modes
36    , setFileMode
37    , setFdMode
38    , setFileCreationMask
39
40    -- ** Checking file existence and permissions
41    , fileAccess
42    , fileExist
43
44    -- * File status
45    , FileStatus
46    -- ** Obtaining file status
47    , getFileStatus
48    , getFdStatus
49    , getSymbolicLinkStatus
50    -- ** Querying file status
51    , deviceID
52    , fileID
53    , fileMode
54    , linkCount
55    , fileOwner
56    , fileGroup
57    , specialDeviceID
58    , fileSize
59    , accessTime
60    , modificationTime
61    , statusChangeTime
62    , isBlockDevice
63    , isCharacterDevice
64    , isNamedPipe
65    , isRegularFile
66    , isDirectory
67    , isSymbolicLink
68    , isSocket
69
70    -- * Creation
71    , createNamedPipe
72    , createDevice
73
74    -- * Hard links
75    , createLink
76    , removeLink
77
78    -- * Symbolic links
79    , createSymbolicLink
80    , readSymbolicLink
81
82    -- * Renaming files
83    , rename
84
85    -- * Changing file ownership
86    , setOwnerAndGroup
87    , setFdOwnerAndGroup
88    , setSymbolicLinkOwnerAndGroup
89
90    -- * Changing file timestamps
91    , setFileTimes
92    , touchFile
93
94    -- * Setting file sizes
95    , setFileSize
96    , setFdSize
97
98    -- * Find system-specific limits for a file
99    , PathVar(..)
100    , getPathVar
101    , getFdPathVar
102    ) where
103
104#ifndef mingw32_HOST_OS
105
106#include "HsUnixCompat.h"
107
108import System.Posix.Files
109
110#if NEED_setSymbolicLinkOwnerAndGroup
111import System.PosixCompat.Types
112
113setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
114setSymbolicLinkOwnerAndGroup _ _ _ = return ()
115#endif
116
117#else /* Portable implementation */
118
119import Control.Exception (bracket)
120import Control.Monad (liftM, liftM2)
121import Data.Bits ((.|.), (.&.))
122import Data.Int (Int64)
123import Foreign.C.Types (CTime(..))
124import Prelude hiding (read)
125import System.Directory (Permissions, emptyPermissions)
126import System.Directory (getPermissions, setPermissions)
127import System.Directory (readable, setOwnerReadable)
128import System.Directory (writable, setOwnerWritable)
129import System.Directory (executable, setOwnerExecutable)
130import System.Directory (searchable, setOwnerSearchable)
131import System.Directory (doesFileExist, doesDirectoryExist)
132import System.Directory (getModificationTime, renameFile)
133import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose)
134import System.IO.Error
135import System.PosixCompat.Types
136import System.Win32.File hiding (getFileType)
137import System.Win32.HardLink (createHardLink)
138import System.Win32.Time (FILETIME(..), getFileTime, setFileTime)
139
140import System.PosixCompat.Internal.Time (
141      getClockTime, clockTimeToEpochTime
142    , modificationTimeToEpochTime
143    )
144
145#ifdef __GLASGOW_HASKELL__
146import GHC.IO.Handle.FD (fdToHandle)
147#endif
148
149
150unsupported :: String -> IO a
151unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
152  where
153    x = "System.PosixCompat.Files." ++ f ++ ": not supported"
154
155-- -----------------------------------------------------------------------------
156-- POSIX file modes
157
158nullFileMode     :: FileMode
159nullFileMode     = 0o000000
160
161ownerReadMode    :: FileMode
162ownerWriteMode   :: FileMode
163ownerExecuteMode :: FileMode
164groupReadMode    :: FileMode
165groupWriteMode   :: FileMode
166groupExecuteMode :: FileMode
167otherReadMode    :: FileMode
168otherWriteMode   :: FileMode
169otherExecuteMode :: FileMode
170setUserIDMode    :: FileMode
171setGroupIDMode   :: FileMode
172
173ownerReadMode    = 0o000400
174ownerWriteMode   = 0o000200
175ownerExecuteMode = 0o000100
176groupReadMode    = 0o000040
177groupWriteMode   = 0o000020
178groupExecuteMode = 0o000010
179otherReadMode    = 0o000004
180otherWriteMode   = 0o000002
181otherExecuteMode = 0o000001
182setUserIDMode    = 0o004000
183setGroupIDMode   = 0o002000
184
185stdFileMode      :: FileMode
186ownerModes       :: FileMode
187groupModes       :: FileMode
188otherModes       :: FileMode
189accessModes      :: FileMode
190
191stdFileMode = ownerReadMode  .|. ownerWriteMode .|.
192              groupReadMode  .|. groupWriteMode .|.
193              otherReadMode  .|. otherWriteMode
194ownerModes  = ownerReadMode  .|. ownerWriteMode .|. ownerExecuteMode
195groupModes  = groupReadMode  .|. groupWriteMode .|. groupExecuteMode
196otherModes  = otherReadMode  .|. otherWriteMode .|. otherExecuteMode
197accessModes = ownerModes .|. groupModes .|. otherModes
198
199unionFileModes :: FileMode -> FileMode -> FileMode
200unionFileModes m1 m2 = m1 .|. m2
201
202intersectFileModes :: FileMode -> FileMode -> FileMode
203intersectFileModes m1 m2 = m1 .&. m2
204
205fileTypeModes :: FileMode
206fileTypeModes = 0o0170000
207
208blockSpecialMode     :: FileMode
209characterSpecialMode :: FileMode
210namedPipeMode        :: FileMode
211regularFileMode      :: FileMode
212directoryMode        :: FileMode
213symbolicLinkMode     :: FileMode
214socketMode           :: FileMode
215
216blockSpecialMode     = 0o0060000
217characterSpecialMode = 0o0020000
218namedPipeMode        = 0o0010000
219regularFileMode      = 0o0100000
220directoryMode        = 0o0040000
221symbolicLinkMode     = 0o0120000
222socketMode           = 0o0140000
223
224
225setFileMode :: FilePath -> FileMode -> IO ()
226setFileMode name m = setPermissions name $ modeToPerms m
227
228
229setFdMode :: Fd -> FileMode -> IO ()
230setFdMode _ _ = unsupported "setFdMode"
231
232-- | The portable implementation does nothing and returns 'nullFileMode'.
233setFileCreationMask :: FileMode -> IO FileMode
234setFileCreationMask _ = return nullFileMode
235
236modeToPerms :: FileMode -> Permissions
237
238#ifdef DIRECTORY_1_0
239modeToPerms m = Permissions
240    { readable   = m .&. ownerReadMode    /= 0
241    , writable   = m .&. ownerWriteMode   /= 0
242    , executable = m .&. ownerExecuteMode /= 0
243    , searchable = m .&. ownerExecuteMode /= 0 }
244#else
245modeToPerms m =
246    setOwnerReadable   (m .&. ownerReadMode    /= 0) $
247    setOwnerWritable   (m .&. ownerWriteMode   /= 0) $
248    setOwnerExecutable (m .&. ownerExecuteMode /= 0) $
249    setOwnerSearchable (m .&. ownerExecuteMode /= 0) $
250    emptyPermissions
251#endif
252
253-- -----------------------------------------------------------------------------
254-- access()
255
256fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
257fileAccess name read write exec =
258    do perm <- getPermissions name
259       return $ (not read  || readable perm)
260             && (not write || writable perm)
261             && (not exec  || executable perm || searchable perm)
262
263fileExist :: FilePath -> IO Bool
264fileExist name = liftM2 (||) (doesFileExist name) (doesDirectoryExist name)
265
266-- -----------------------------------------------------------------------------
267-- stat() support
268
269data FileStatus = FileStatus
270    { deviceID         :: DeviceID
271    , fileID           :: FileID
272    , fileMode         :: FileMode
273    , linkCount        :: LinkCount
274    , fileOwner        :: UserID
275    , fileGroup        :: GroupID
276    , specialDeviceID  :: DeviceID
277    , fileSize         :: FileOffset
278    , accessTime       :: EpochTime
279    , modificationTime :: EpochTime
280    , statusChangeTime :: EpochTime
281    }
282
283isBlockDevice :: FileStatus -> Bool
284isBlockDevice stat =
285    (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode
286
287isCharacterDevice :: FileStatus -> Bool
288isCharacterDevice stat =
289    (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode
290
291isNamedPipe :: FileStatus -> Bool
292isNamedPipe stat =
293    (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode
294
295isRegularFile :: FileStatus -> Bool
296isRegularFile stat =
297    (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode
298
299isDirectory :: FileStatus -> Bool
300isDirectory stat =
301    (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode
302
303isSymbolicLink :: FileStatus -> Bool
304isSymbolicLink stat =
305    (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode
306
307isSocket :: FileStatus -> Bool
308isSocket stat =
309    (fileMode stat `intersectFileModes` fileTypeModes) == socketMode
310
311getFileStatus :: FilePath -> IO FileStatus
312getFileStatus path = do
313    perm  <- liftM permsToMode (getPermissions path)
314    typ   <- getFileType path
315    size  <- if typ == regularFileMode then getFileSize path else return 0
316    mtime <- liftM modificationTimeToEpochTime (getModificationTime path)
317    info  <- bracket openPath closeHandle getFileInformationByHandle
318    return $ FileStatus
319             { deviceID         = fromIntegral (bhfiVolumeSerialNumber info)
320             , fileID           = fromIntegral (bhfiFileIndex info)
321             , fileMode         = typ .|. perm
322             , linkCount        = fromIntegral (bhfiNumberOfLinks info)
323             , fileOwner        = 0
324             , fileGroup        = 0
325             , specialDeviceID  = 0
326             , fileSize         = size
327             , accessTime       = mtime
328             , modificationTime = mtime
329             , statusChangeTime = mtime }
330  where
331    openPath = createFile path
332                 gENERIC_READ
333                 (fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE)
334                 Nothing
335                 oPEN_EXISTING
336                 (sECURITY_ANONYMOUS .|. fILE_FLAG_BACKUP_SEMANTICS)
337                 Nothing
338
339permsToMode :: Permissions -> FileMode
340permsToMode perms = r .|. w .|. x
341  where
342    r = f (readable perms) (ownerReadMode .|. groupReadMode .|. otherReadMode)
343    w = f (writable perms) (ownerWriteMode .|. groupWriteMode .|. otherWriteMode)
344    x = f (executable perms || searchable perms)
345          (ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode)
346    f True m  = m
347    f False _ = nullFileMode
348
349getFileType :: FilePath -> IO FileMode
350getFileType path =
351    do f <- doesFileExist path
352       if f then return regularFileMode
353            else do d <- doesDirectoryExist path
354                    if d then return directoryMode
355                         else unsupported "Unknown file type."
356
357getFileSize :: FilePath -> IO FileOffset
358getFileSize path =
359    bracket (openFile path ReadMode) hClose (liftM fromIntegral . hFileSize)
360
361getFdStatus :: Fd -> IO FileStatus
362getFdStatus _ = unsupported "getFdStatus"
363
364getSymbolicLinkStatus :: FilePath -> IO FileStatus
365getSymbolicLinkStatus path = getFileStatus path
366
367createNamedPipe :: FilePath -> FileMode -> IO ()
368createNamedPipe _ _ = unsupported "createNamedPipe"
369
370createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
371createDevice _ _ _ = unsupported "createDevice"
372
373-- -----------------------------------------------------------------------------
374-- Hard links
375
376createLink :: FilePath -> FilePath -> IO ()
377createLink = createHardLink
378
379removeLink :: FilePath -> IO ()
380removeLink _ = unsupported "removeLink"
381
382-- -----------------------------------------------------------------------------
383-- Symbolic Links
384
385createSymbolicLink :: FilePath -> FilePath -> IO ()
386createSymbolicLink _ _ = unsupported "createSymbolicLink"
387
388readSymbolicLink :: FilePath -> IO FilePath
389readSymbolicLink _ = unsupported "readSymbolicLink"
390
391-- -----------------------------------------------------------------------------
392-- Renaming
393
394rename :: FilePath -> FilePath -> IO ()
395#if MIN_VERSION_Win32(2, 6, 0)
396rename name1 name2 = moveFileEx name1 (Just name2) mOVEFILE_REPLACE_EXISTING
397#else
398rename name1 name2 = moveFileEx name1 name2 mOVEFILE_REPLACE_EXISTING
399#endif
400
401-- -----------------------------------------------------------------------------
402-- chown()
403
404-- | The portable implementation does nothing.
405setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
406setOwnerAndGroup _ _ _ = return ()
407
408-- | The portable implementation does nothing.
409setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
410setFdOwnerAndGroup _ _ _ = return ()
411
412-- | The portable implementation does nothing.
413setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
414setSymbolicLinkOwnerAndGroup _ _ _ = return ()
415
416-- -----------------------------------------------------------------------------
417-- utime()
418
419setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
420setFileTimes file atime mtime =
421  bracket openFileHandle closeHandle $ \handle -> do
422    (creationTime, _, _) <- getFileTime handle
423    setFileTime
424      handle
425      creationTime
426      (epochTimeToFileTime atime)
427      (epochTimeToFileTime mtime)
428  where
429    openFileHandle = createFile file
430                       gENERIC_WRITE
431                       fILE_SHARE_NONE
432                       Nothing
433                       oPEN_EXISTING
434                       fILE_ATTRIBUTE_NORMAL
435                       Nothing
436
437    -- based on https://support.microsoft.com/en-us/kb/167296
438    epochTimeToFileTime (CTime t) = FILETIME (fromIntegral ll)
439      where
440        ll :: Int64
441        ll = fromIntegral t * 10000000 + 116444736000000000
442
443touchFile :: FilePath -> IO ()
444touchFile name =
445    do t <- liftM clockTimeToEpochTime getClockTime
446       setFileTimes name t t
447
448-- -----------------------------------------------------------------------------
449-- Setting file sizes
450
451setFileSize :: FilePath -> FileOffset -> IO ()
452setFileSize file off =
453    bracket (openFile file WriteMode) (hClose)
454            (\h -> hSetFileSize h (fromIntegral off))
455
456setFdSize :: Fd -> FileOffset -> IO ()
457#ifdef __GLASGOW_HASKELL__
458setFdSize (Fd fd) off =
459    do h <- fdToHandle (fromIntegral fd)
460       hSetFileSize h (fromIntegral off)
461#else
462setFdSize fd off = unsupported "setFdSize"
463#endif
464
465-- -----------------------------------------------------------------------------
466-- pathconf()/fpathconf() support
467
468data PathVar
469  = FileSizeBits                  -- _PC_FILESIZEBITS
470  | LinkLimit                     -- _PC_LINK_MAX
471  | InputLineLimit                -- _PC_MAX_CANON
472  | InputQueueLimit               -- _PC_MAX_INPUT
473  | FileNameLimit                 -- _PC_NAME_MAX
474  | PathNameLimit                 -- _PC_PATH_MAX
475  | PipeBufferLimit               -- _PC_PIPE_BUF
476
477  -- These are described as optional in POSIX:
478                                  -- _PC_ALLOC_SIZE_MIN
479                                  -- _PC_REC_INCR_XFER_SIZE
480                                  -- _PC_REC_MAX_XFER_SIZE
481                                  -- _PC_REC_MIN_XFER_SIZE
482                                  -- _PC_REC_XFER_ALIGN
483  | SymbolicLinkLimit             -- _PC_SYMLINK_MAX
484  | SetOwnerAndGroupIsRestricted  -- _PC_CHOWN_RESTRICTED
485  | FileNamesAreNotTruncated      -- _PC_NO_TRUNC
486  | VDisableChar                  -- _PC_VDISABLE
487  | AsyncIOAvailable              -- _PC_ASYNC_IO
488  | PrioIOAvailable               -- _PC_PRIO_IO
489  | SyncIOAvailable               -- _PC_SYNC_IO
490
491getPathVar :: FilePath -> PathVar -> IO Limit
492getPathVar _ _ = unsupported "getPathVar"
493
494getFdPathVar :: Fd -> PathVar -> IO Limit
495getFdPathVar _ _ = unsupported "getFdPathVar"
496
497#endif
498