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