{-# OPTIONS_GHC -optc-D__HUGS__ #-}
{-# INCLUDE "HsUnix.h" #-}
{-# LINE 1 "Files.hsc" #-}
{-# OPTIONS -fffi #-}
{-# LINE 2 "Files.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Files
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX file support
--
-----------------------------------------------------------------------------

module System.Posix.Files (
    -- * File modes
    -- FileMode exported by System.Posix.Types
    unionFileModes, intersectFileModes,
    nullFileMode,
    ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
    groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
    otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
    setUserIDMode, setGroupIDMode,
    stdFileMode,   accessModes,

    -- ** Setting file modes
    setFileMode, setFdMode, setFileCreationMask,

    -- ** Checking file existence and permissions
    fileAccess, fileExist,

    -- * File status
    FileStatus,
    -- ** Obtaining file status
    getFileStatus, getFdStatus, getSymbolicLinkStatus,
    -- ** Querying file status
    deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
    specialDeviceID, fileSize, accessTime, modificationTime,
    statusChangeTime,
    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
    isDirectory, isSymbolicLink, isSocket,

    -- * Creation
    createNamedPipe, 
    createDevice,

    -- * Hard links
    createLink, removeLink,

    -- * Symbolic links
    createSymbolicLink, readSymbolicLink,

    -- * Renaming files
    rename,

    -- * Changing file ownership
    setOwnerAndGroup,  setFdOwnerAndGroup,

{-# LINE 60 "Files.hsc" #-}
    setSymbolicLinkOwnerAndGroup,

{-# LINE 62 "Files.hsc" #-}

    -- * Changing file timestamps
    setFileTimes, touchFile,

    -- * Setting file sizes
    setFileSize, setFdSize,

    -- * Find system-specific limits for a file
    PathVar(..), getPathVar, getFdPathVar,
  ) where

{-# LINE 74 "Files.hsc" #-}

import System.Posix.Error
import System.Posix.Types
import System.IO.Unsafe
import Data.Bits
import System.Posix.Internals
import Foreign
import Foreign.C

-- -----------------------------------------------------------------------------
-- POSIX file modes

-- The abstract type 'FileMode', constants and operators for
-- manipulating the file modes defined by POSIX.

nullFileMode :: FileMode
nullFileMode = 0

ownerReadMode :: FileMode
ownerReadMode = (256)
{-# LINE 94 "Files.hsc" #-}

ownerWriteMode :: FileMode
ownerWriteMode = (128)
{-# LINE 97 "Files.hsc" #-}

ownerExecuteMode :: FileMode
ownerExecuteMode = (64)
{-# LINE 100 "Files.hsc" #-}

groupReadMode :: FileMode
groupReadMode = (32)
{-# LINE 103 "Files.hsc" #-}

groupWriteMode :: FileMode
groupWriteMode = (16)
{-# LINE 106 "Files.hsc" #-}

groupExecuteMode :: FileMode
groupExecuteMode = (8)
{-# LINE 109 "Files.hsc" #-}

otherReadMode :: FileMode
otherReadMode = (4)
{-# LINE 112 "Files.hsc" #-}

otherWriteMode :: FileMode
otherWriteMode = (2)
{-# LINE 115 "Files.hsc" #-}

otherExecuteMode :: FileMode
otherExecuteMode = (1)
{-# LINE 118 "Files.hsc" #-}

setUserIDMode :: FileMode
setUserIDMode = (2048)
{-# LINE 121 "Files.hsc" #-}

setGroupIDMode :: FileMode
setGroupIDMode = (1024)
{-# LINE 124 "Files.hsc" #-}

stdFileMode :: FileMode
stdFileMode = ownerReadMode  .|. ownerWriteMode .|. 
	      groupReadMode  .|. groupWriteMode .|. 
	      otherReadMode  .|. otherWriteMode

ownerModes :: FileMode
ownerModes = (448)
{-# LINE 132 "Files.hsc" #-}

groupModes :: FileMode
groupModes = (56)
{-# LINE 135 "Files.hsc" #-}

otherModes :: FileMode
otherModes = (7)
{-# LINE 138 "Files.hsc" #-}

accessModes :: FileMode
accessModes = ownerModes .|. groupModes .|. otherModes

unionFileModes :: FileMode -> FileMode -> FileMode
unionFileModes m1 m2 = m1 .|. m2

intersectFileModes :: FileMode -> FileMode -> FileMode
intersectFileModes m1 m2 = m1 .&. m2

-- Not exported:
fileTypeModes :: FileMode
fileTypeModes = (61440)
{-# LINE 151 "Files.hsc" #-}

blockSpecialMode :: FileMode
blockSpecialMode = (24576)
{-# LINE 154 "Files.hsc" #-}

characterSpecialMode :: FileMode
characterSpecialMode = (8192)
{-# LINE 157 "Files.hsc" #-}

namedPipeMode :: FileMode
namedPipeMode = (4096)
{-# LINE 160 "Files.hsc" #-}

regularFileMode :: FileMode
regularFileMode = (32768)
{-# LINE 163 "Files.hsc" #-}

directoryMode :: FileMode
directoryMode = (16384)
{-# LINE 166 "Files.hsc" #-}

symbolicLinkMode :: FileMode
symbolicLinkMode = (40960)
{-# LINE 169 "Files.hsc" #-}

socketMode :: FileMode
socketMode = (49152)
{-# LINE 172 "Files.hsc" #-}

setFileMode :: FilePath -> FileMode -> IO ()
setFileMode name m =
  withCString name $ \s -> do
    throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)

setFdMode :: Fd -> FileMode -> IO ()
setFdMode fd m =
  throwErrnoIfMinus1_ "setFdMode" (c_fchmod fd m)

foreign import ccall unsafe "fchmod" 
  c_fchmod :: Fd -> CMode -> IO CInt

setFileCreationMask :: FileMode -> IO FileMode
setFileCreationMask mask = c_umask mask

-- -----------------------------------------------------------------------------
-- access()

fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess name read write exec = access name flags
  where
   flags   = read_f .|. write_f .|. exec_f
   read_f  = if read  then (4) else 0
{-# LINE 196 "Files.hsc" #-}
   write_f = if write then (2) else 0
{-# LINE 197 "Files.hsc" #-}
   exec_f  = if exec  then (1) else 0
{-# LINE 198 "Files.hsc" #-}

fileExist :: FilePath -> IO Bool
fileExist name = 
  withCString name $ \s -> do
    r <- c_access s (0)
{-# LINE 203 "Files.hsc" #-}
    if (r == 0)
	then return True
	else do err <- getErrno
	        if (err == eNOENT)
		   then return False
		   else throwErrnoPath "fileExist" name

access :: FilePath -> CMode -> IO Bool
access name flags = 
  withCString name $ \s -> do
    r <- c_access s flags
    if (r == 0)
	then return True
	else do err <- getErrno
	        if (err == eACCES)
		   then return False
		   else throwErrnoPath "fileAccess" name

-- -----------------------------------------------------------------------------
-- stat() support

newtype FileStatus = FileStatus (ForeignPtr CStat)

deviceID         :: FileStatus -> DeviceID
fileID           :: FileStatus -> FileID
fileMode         :: FileStatus -> FileMode
linkCount        :: FileStatus -> LinkCount
fileOwner        :: FileStatus -> UserID
fileGroup        :: FileStatus -> GroupID
specialDeviceID  :: FileStatus -> DeviceID
fileSize         :: FileStatus -> FileOffset
accessTime       :: FileStatus -> EpochTime
modificationTime :: FileStatus -> EpochTime
statusChangeTime :: FileStatus -> EpochTime

deviceID (FileStatus stat) = 
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 0))
{-# LINE 240 "Files.hsc" #-}
fileID (FileStatus stat) = 
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 4))
{-# LINE 242 "Files.hsc" #-}
fileMode (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 8))
{-# LINE 244 "Files.hsc" #-}
linkCount (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 10))
{-# LINE 246 "Files.hsc" #-}
fileOwner (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 12))
{-# LINE 248 "Files.hsc" #-}
fileGroup (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 16))
{-# LINE 250 "Files.hsc" #-}
specialDeviceID (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 20))
{-# LINE 252 "Files.hsc" #-}
fileSize (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 72))
{-# LINE 254 "Files.hsc" #-}
accessTime (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 24))
{-# LINE 256 "Files.hsc" #-}
modificationTime (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 40))
{-# LINE 258 "Files.hsc" #-}
statusChangeTime (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ ((\hsc_ptr -> peekByteOff hsc_ptr 56))
{-# LINE 260 "Files.hsc" #-}

isBlockDevice     :: FileStatus -> Bool
isCharacterDevice :: FileStatus -> Bool
isNamedPipe       :: FileStatus -> Bool
isRegularFile     :: FileStatus -> Bool
isDirectory       :: FileStatus -> Bool
isSymbolicLink    :: FileStatus -> Bool
isSocket          :: FileStatus -> Bool

isBlockDevice stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode
isCharacterDevice stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode
isNamedPipe stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode
isRegularFile stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode
isDirectory stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode
isSymbolicLink stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode
isSocket stat = 
  (fileMode stat `intersectFileModes` fileTypeModes) == socketMode

getFileStatus :: FilePath -> IO FileStatus
getFileStatus path = do
  fp <- mallocForeignPtrBytes (120) 
{-# LINE 287 "Files.hsc" #-}
  withForeignPtr fp $ \p ->
    withCString path $ \s -> 
      throwErrnoPathIfMinus1_ "getFileStatus" path (c_stat s p)
  return (FileStatus fp)

getFdStatus :: Fd -> IO FileStatus
getFdStatus (Fd fd) = do
  fp <- mallocForeignPtrBytes (120) 
{-# LINE 295 "Files.hsc" #-}
  withForeignPtr fp $ \p ->
    throwErrnoIfMinus1_ "getFdStatus" (c_fstat fd p)
  return (FileStatus fp)

getSymbolicLinkStatus :: FilePath -> IO FileStatus
getSymbolicLinkStatus path = do
  fp <- mallocForeignPtrBytes (120) 
{-# LINE 302 "Files.hsc" #-}
  withForeignPtr fp $ \p ->
    withCString path $ \s -> 
      throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p)
  return (FileStatus fp)

foreign import ccall unsafe "lstat" 
  c_lstat :: CString -> Ptr CStat -> IO CInt

createNamedPipe :: FilePath -> FileMode -> IO ()
createNamedPipe name mode = do
  withCString name $ \s -> 
    throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)

createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
createDevice path mode dev =
  withCString path $ \s ->
    throwErrnoPathIfMinus1_ "createDevice" path (c_mknod s mode dev)

foreign import ccall unsafe "mknod" 
  c_mknod :: CString -> CMode -> CDev -> IO CInt

-- -----------------------------------------------------------------------------
-- Hard links

createLink :: FilePath -> FilePath -> IO ()
createLink name1 name2 =
  withCString name1 $ \s1 ->
  withCString name2 $ \s2 ->
  throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2)

removeLink :: FilePath -> IO ()
removeLink name =
  withCString name $ \s ->
  throwErrnoPathIfMinus1_ "removeLink" name (c_unlink s)

-- -----------------------------------------------------------------------------
-- Symbolic Links

createSymbolicLink :: FilePath -> FilePath -> IO ()
createSymbolicLink file1 file2 =
  withCString file1 $ \s1 ->
  withCString file2 $ \s2 ->
  throwErrnoPathIfMinus1_ "createSymbolicLink" file1 (c_symlink s1 s2)

foreign import ccall unsafe "symlink"
  c_symlink :: CString -> CString -> IO CInt

-- ToDo: should really use SYMLINK_MAX, but not everyone supports it yet,
-- and it seems that the intention is that SYMLINK_MAX is no larger than
-- PATH_MAX.
readSymbolicLink :: FilePath -> IO FilePath
readSymbolicLink file =
  allocaArray0 (1024) $ \buf -> do
{-# LINE 355 "Files.hsc" #-}
    withCString file $ \s -> do
      len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $ 
	c_readlink s buf (1024)
{-# LINE 358 "Files.hsc" #-}
      peekCStringLen (buf,fromIntegral len)

foreign import ccall unsafe "readlink"
  c_readlink :: CString -> CString -> CInt -> IO CInt

-- -----------------------------------------------------------------------------
-- Renaming files

rename :: FilePath -> FilePath -> IO ()
rename name1 name2 =
  withCString name1 $ \s1 ->
  withCString name2 $ \s2 ->
  throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2)

-- -----------------------------------------------------------------------------
-- chmod()

setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
setOwnerAndGroup name uid gid = do
  withCString name $ \s ->
    throwErrnoPathIfMinus1_ "setOwnerAndGroup" name (c_chown s uid gid)

foreign import ccall unsafe "chown"
  c_chown :: CString -> CUid -> CGid -> IO CInt

setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
setFdOwnerAndGroup (Fd fd) uid gid = 
  throwErrnoIfMinus1_ "setFdOwnerAndGroup" (c_fchown fd uid gid)

foreign import ccall unsafe "fchown"
  c_fchown :: CInt -> CUid -> CGid -> IO CInt

{-# LINE 391 "Files.hsc" #-}
setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
setSymbolicLinkOwnerAndGroup name uid gid = do
  withCString name $ \s ->
    throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name
	(c_lchown s uid gid)

foreign import ccall unsafe "lchown"
  c_lchown :: CString -> CUid -> CGid -> IO CInt

{-# LINE 400 "Files.hsc" #-}

-- -----------------------------------------------------------------------------
-- utime()

setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
setFileTimes name atime mtime = do
  withCString name $ \s ->
   allocaBytes (16) $ \p -> do
{-# LINE 408 "Files.hsc" #-}
     ((\hsc_ptr -> pokeByteOff hsc_ptr 0))  p atime
{-# LINE 409 "Files.hsc" #-}
     ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p mtime
{-# LINE 410 "Files.hsc" #-}
     throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p)

touchFile :: FilePath -> IO ()
touchFile name = do
  withCString name $ \s ->
   throwErrnoPathIfMinus1_ "touchFile" name (c_utime s nullPtr)

-- -----------------------------------------------------------------------------
-- Setting file sizes

setFileSize :: FilePath -> FileOffset -> IO ()
setFileSize file off = 
  withCString file $ \s ->
    throwErrnoPathIfMinus1_ "setFileSize" file (c_truncate s off)

foreign import ccall unsafe "truncate"
  c_truncate :: CString -> COff -> IO CInt

setFdSize :: Fd -> FileOffset -> IO ()
setFdSize (Fd fd) off =
  throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd off)

-- -----------------------------------------------------------------------------
-- pathconf()/fpathconf() support

data PathVar
  = FileSizeBits		  {- _PC_FILESIZEBITS     -}
  | LinkLimit                     {- _PC_LINK_MAX         -}
  | InputLineLimit                {- _PC_MAX_CANON        -}
  | InputQueueLimit               {- _PC_MAX_INPUT        -}
  | FileNameLimit                 {- _PC_NAME_MAX         -}
  | PathNameLimit                 {- _PC_PATH_MAX         -}
  | PipeBufferLimit               {- _PC_PIPE_BUF         -}
				  -- These are described as optional in POSIX:
  				  {- _PC_ALLOC_SIZE_MIN     -}
  				  {- _PC_REC_INCR_XFER_SIZE -}
  				  {- _PC_REC_MAX_XFER_SIZE  -}
  				  {- _PC_REC_MIN_XFER_SIZE  -}
 				  {- _PC_REC_XFER_ALIGN     -}
  | SymbolicLinkLimit		  {- _PC_SYMLINK_MAX      -}
  | SetOwnerAndGroupIsRestricted  {- _PC_CHOWN_RESTRICTED -}
  | FileNamesAreNotTruncated      {- _PC_NO_TRUNC         -}
  | VDisableChar		  {- _PC_VDISABLE         -}
  | AsyncIOAvailable		  {- _PC_ASYNC_IO         -}
  | PrioIOAvailable		  {- _PC_PRIO_IO          -}
  | SyncIOAvailable		  {- _PC_SYNC_IO          -}

pathVarConst :: PathVar -> CInt
pathVarConst v = case v of
	LinkLimit     			-> (1)
{-# LINE 460 "Files.hsc" #-}
	InputLineLimit			-> (2)
{-# LINE 461 "Files.hsc" #-}
	InputQueueLimit			-> (3)
{-# LINE 462 "Files.hsc" #-}
	FileNameLimit			-> (4)
{-# LINE 463 "Files.hsc" #-}
	PathNameLimit			-> (5)
{-# LINE 464 "Files.hsc" #-}
	PipeBufferLimit			-> (6)
{-# LINE 465 "Files.hsc" #-}
	SetOwnerAndGroupIsRestricted	-> (7)
{-# LINE 466 "Files.hsc" #-}
	FileNamesAreNotTruncated	-> (8)
{-# LINE 467 "Files.hsc" #-}
	VDisableChar			-> (9)
{-# LINE 468 "Files.hsc" #-}

{-# LINE 470 "Files.hsc" #-}
	SyncIOAvailable		-> (55)
{-# LINE 471 "Files.hsc" #-}

{-# LINE 474 "Files.hsc" #-}

{-# LINE 476 "Files.hsc" #-}
	AsyncIOAvailable	-> (53)
{-# LINE 477 "Files.hsc" #-}

{-# LINE 480 "Files.hsc" #-}

{-# LINE 482 "Files.hsc" #-}
	PrioIOAvailable		-> (54)
{-# LINE 483 "Files.hsc" #-}

{-# LINE 486 "Files.hsc" #-}

{-# LINE 488 "Files.hsc" #-}
	FileSizeBits		-> (12)
{-# LINE 489 "Files.hsc" #-}

{-# LINE 492 "Files.hsc" #-}

{-# LINE 494 "Files.hsc" #-}
	SymbolicLinkLimit	-> (18)
{-# LINE 495 "Files.hsc" #-}

{-# LINE 498 "Files.hsc" #-}

getPathVar :: FilePath -> PathVar -> IO Limit
getPathVar name v = do
  withCString name $ \ nameP -> 
    throwErrnoPathIfMinus1 "getPathVar" name $ 
      c_pathconf nameP (pathVarConst v)

foreign import ccall unsafe "pathconf" 
  c_pathconf :: CString -> CInt -> IO CLong

getFdPathVar :: Fd -> PathVar -> IO Limit
getFdPathVar fd v =
    throwErrnoIfMinus1 "getFdPathVar" $ 
      c_fpathconf fd (pathVarConst v)

foreign import ccall unsafe "fpathconf" 
  c_fpathconf :: Fd -> CInt -> IO CLong
