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