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