Common.hsc 21.1 KB
Newer Older
1
#ifdef __GLASGOW_HASKELL__
2
3
4
5
6
7
8
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Files.Common
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
bos's avatar
bos committed
9
--
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- Functions defined by the POSIX standards for manipulating and querying the
-- file system. Names of underlying POSIX functions are indicated whenever
-- possible. A more complete documentation of the POSIX functions together
-- with a more detailed description of different error conditions are usually
-- available in the system's manual pages or from
-- <http://www.unix.org/version3/online.html> (free registration required).
--
-- When a function that calls an underlying POSIX function fails, the errno
-- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
-- For a list of which errno codes may be generated, consult the POSIX
-- documentation for the underlying function.
--
-----------------------------------------------------------------------------

#include "HsUnix.h"

module System.Posix.Files.Common (
    -- * 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,
    fileTypeModes,
    blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
    directoryMode, symbolicLinkMode, socketMode,

    -- ** Setting file modes
    setFdMode, setFileCreationMask,

    -- * File status
    FileStatus(..),
    -- ** Obtaining file status
    getFdStatus,
    -- ** Querying file status
    deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
    specialDeviceID, fileSize, accessTime, modificationTime,
    statusChangeTime,
55
    accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
56
    setFdTimesHiRes, touchFd,
57
58
59
60
61
62
63
64
65
66
67
    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
    isDirectory, isSymbolicLink, isSocket,

    -- * Setting file sizes
    setFdSize,

    -- * Changing file ownership
    setFdOwnerAndGroup,

    -- * Find system-specific limits for a file
    PathVar(..), getFdPathVar, pathVarConst,
68
69
70
71
72
73
74
75
76
77
78
79
80

    -- * Low level types and functions
#ifdef HAVE_UTIMENSAT
    CTimeSpec(..),
    toCTimeSpec,
    c_utimensat,
#endif
    CTimeVal(..),
    toCTimeVal,
    c_utimes,
#ifdef HAVE_LUTIMES
    c_lutimes,
#endif
81
82
83
84
85
  ) where

import System.Posix.Types
import System.IO.Unsafe
import Data.Bits
86
import Data.Int
87
import Data.Ratio
88
import Data.Time.Clock.POSIX (POSIXTime)
89
90
import System.Posix.Internals
import Foreign.C
91
import Foreign.ForeignPtr
92
93
94
#if defined(HAVE_FUTIMES) || defined(HAVE_FUTIMENS)
import Foreign.Marshal (withArray)
#endif
95
96
import Foreign.Ptr
import Foreign.Storable
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

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

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

-- | No permissions.
nullFileMode :: FileMode
nullFileMode = 0

-- | Owner has read permission.
ownerReadMode :: FileMode
ownerReadMode = (#const S_IRUSR)

-- | Owner has write permission.
ownerWriteMode :: FileMode
ownerWriteMode = (#const S_IWUSR)

-- | Owner has execute permission.
ownerExecuteMode :: FileMode
ownerExecuteMode = (#const S_IXUSR)

-- | Group has read permission.
groupReadMode :: FileMode
groupReadMode = (#const S_IRGRP)

-- | Group has write permission.
groupWriteMode :: FileMode
groupWriteMode = (#const S_IWGRP)

-- | Group has execute permission.
groupExecuteMode :: FileMode
groupExecuteMode = (#const S_IXGRP)

-- | Others have read permission.
otherReadMode :: FileMode
otherReadMode = (#const S_IROTH)

-- | Others have write permission.
otherWriteMode :: FileMode
otherWriteMode = (#const S_IWOTH)

-- | Others have execute permission.
otherExecuteMode :: FileMode
otherExecuteMode = (#const S_IXOTH)

-- | Set user ID on execution.
setUserIDMode :: FileMode
setUserIDMode = (#const S_ISUID)

-- | Set group ID on execution.
setGroupIDMode :: FileMode
setGroupIDMode = (#const S_ISGID)

-- | Owner, group and others have read and write permission.
stdFileMode :: FileMode
bos's avatar
bos committed
154
stdFileMode = ownerReadMode  .|. ownerWriteMode .|.
155
156
              groupReadMode  .|. groupWriteMode .|.
              otherReadMode  .|. otherWriteMode
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215

-- | Owner has read, write and execute permission.
ownerModes :: FileMode
ownerModes = (#const S_IRWXU)

-- | Group has read, write and execute permission.
groupModes :: FileMode
groupModes = (#const S_IRWXG)

-- | Others have read, write and execute permission.
otherModes :: FileMode
otherModes = (#const S_IRWXO)

-- | Owner, group and others have read, write and execute permission.
accessModes :: FileMode
accessModes = ownerModes .|. groupModes .|. otherModes

-- | Combines the two file modes into one that contains modes that appear in
-- either.
unionFileModes :: FileMode -> FileMode -> FileMode
unionFileModes m1 m2 = m1 .|. m2

-- | Combines two file modes into one that only contains modes that appear in
-- both.
intersectFileModes :: FileMode -> FileMode -> FileMode
intersectFileModes m1 m2 = m1 .&. m2

fileTypeModes :: FileMode
fileTypeModes = (#const S_IFMT)

blockSpecialMode :: FileMode
blockSpecialMode = (#const S_IFBLK)

characterSpecialMode :: FileMode
characterSpecialMode = (#const S_IFCHR)

namedPipeMode :: FileMode
namedPipeMode = (#const S_IFIFO)

regularFileMode :: FileMode
regularFileMode = (#const S_IFREG)

directoryMode :: FileMode
directoryMode = (#const S_IFDIR)

symbolicLinkMode :: FileMode
symbolicLinkMode = (#const S_IFLNK)

socketMode :: FileMode
socketMode = (#const S_IFSOCK)

-- | @setFdMode fd mode@ acts like 'setFileMode' but uses a file descriptor
-- @fd@ instead of a 'FilePath'.
--
-- Note: calls @fchmod@.
setFdMode :: Fd -> FileMode -> IO ()
setFdMode (Fd fd) m =
  throwErrnoIfMinus1_ "setFdMode" (c_fchmod fd m)

bos's avatar
bos committed
216
foreign import ccall unsafe "fchmod"
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
  c_fchmod :: CInt -> CMode -> IO CInt

-- | @setFileCreationMask mode@ sets the file mode creation mask to @mode@.
-- Modes set by this operation are subtracted from files and directories upon
-- creation. The previous file creation mask is returned.
--
-- Note: calls @umask@.
setFileCreationMask :: FileMode -> IO FileMode
setFileCreationMask mask = c_umask mask

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

-- | POSIX defines operations to get information, such as owner, permissions,
-- size and access times, about a file. This information is represented by the
-- 'FileStatus' type.
--
-- Note: see @chmod@.
newtype FileStatus = FileStatus (ForeignPtr CStat)

-- | ID of the device on which this file resides.
deviceID         :: FileStatus -> DeviceID
-- | inode number
fileID           :: FileStatus -> FileID
-- | File mode (such as permissions).
fileMode         :: FileStatus -> FileMode
-- | Number of hard links to this file.
linkCount        :: FileStatus -> LinkCount
-- | ID of owner.
fileOwner        :: FileStatus -> UserID
-- | ID of group.
fileGroup        :: FileStatus -> GroupID
-- | Describes the device that this file represents.
specialDeviceID  :: FileStatus -> DeviceID
-- | Size of the file in bytes. If this file is a symbolic link the size is
-- the length of the pathname it contains.
fileSize         :: FileStatus -> FileOffset
-- | Time of last access.
accessTime       :: FileStatus -> EpochTime
256
257
-- | Time of last access in sub-second resolution.
accessTimeHiRes  :: FileStatus -> POSIXTime
258
259
-- | Time of last modification.
modificationTime :: FileStatus -> EpochTime
260
261
-- | Time of last modification in sub-second resolution.
modificationTimeHiRes :: FileStatus -> POSIXTime
262
263
-- | Time of last status change (i.e. owner, group, link count, mode, etc.).
statusChangeTime :: FileStatus -> EpochTime
264
265
-- | Time of last status change (i.e. owner, group, link count, mode, etc.) in sub-second resolution.
statusChangeTimeHiRes :: FileStatus -> POSIXTime
266

bos's avatar
bos committed
267
deviceID (FileStatus stat) =
268
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_dev)
bos's avatar
bos committed
269
fileID (FileStatus stat) =
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_ino)
fileMode (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_mode)
linkCount (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_nlink)
fileOwner (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_uid)
fileGroup (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_gid)
specialDeviceID (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_rdev)
fileSize (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_size)
accessTime (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_atime)
modificationTime (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_mtime)
statusChangeTime (FileStatus stat) =
  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_ctime)

290
accessTimeHiRes (FileStatus stat) =
pcapriotti's avatar
pcapriotti committed
291
292
  unsafePerformIO $ withForeignPtr stat $ \stat_ptr -> do
    sec  <- (#peek struct stat, st_atime) stat_ptr :: IO EpochTime
293
#ifdef HAVE_STRUCT_STAT_ST_ATIM
pcapriotti's avatar
pcapriotti committed
294
295
    nsec <- (#peek struct stat, st_atim.tv_nsec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
296
#elif HAVE_STRUCT_STAT_ST_ATIMESPEC
pcapriotti's avatar
pcapriotti committed
297
298
    nsec <- (#peek struct stat, st_atimespec.tv_nsec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
299
#elif HAVE_STRUCT_STAT_ST_ATIMENSEC
pcapriotti's avatar
pcapriotti committed
300
301
    nsec <- (#peek struct stat, st_atimensec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
302
#elif HAVE_STRUCT_STAT_ST_ATIME_N
pcapriotti's avatar
pcapriotti committed
303
304
    nsec <- (#peek struct stat, st_atime_n) stat_ptr :: IO (#type int)
    let frac = toInteger nsec % 10^(9::Int)
305
#elif HAVE_STRUCT_STAT_ST_UATIME
pcapriotti's avatar
pcapriotti committed
306
307
    usec <- (#peek struct stat, st_uatime) stat_ptr :: IO (#type int)
    let frac = toInteger usec % 10^(6::Int)
308
309
310
311
312
313
#else
    let frac = 0
#endif
    return $ fromRational $ toRational sec + frac

modificationTimeHiRes (FileStatus stat) =
pcapriotti's avatar
pcapriotti committed
314
315
  unsafePerformIO $ withForeignPtr stat $ \stat_ptr -> do
    sec  <- (#peek struct stat, st_mtime) stat_ptr :: IO EpochTime
316
#ifdef HAVE_STRUCT_STAT_ST_MTIM
pcapriotti's avatar
pcapriotti committed
317
318
    nsec <- (#peek struct stat, st_mtim.tv_nsec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
319
#elif HAVE_STRUCT_STAT_ST_MTIMESPEC
pcapriotti's avatar
pcapriotti committed
320
321
    nsec <- (#peek struct stat, st_mtimespec.tv_nsec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
322
#elif HAVE_STRUCT_STAT_ST_MTIMENSEC
pcapriotti's avatar
pcapriotti committed
323
324
    nsec <- (#peek struct stat, st_mtimensec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
325
#elif HAVE_STRUCT_STAT_ST_MTIME_N
pcapriotti's avatar
pcapriotti committed
326
327
    nsec <- (#peek struct stat, st_mtime_n) stat_ptr :: IO (#type int)
    let frac = toInteger nsec % 10^(9::Int)
328
#elif HAVE_STRUCT_STAT_ST_UMTIME
pcapriotti's avatar
pcapriotti committed
329
330
    usec <- (#peek struct stat, st_umtime) stat_ptr :: IO (#type int)
    let frac = toInteger usec % 10^(6::Int)
331
332
333
334
335
336
#else
    let frac = 0
#endif
    return $ fromRational $ toRational sec + frac

statusChangeTimeHiRes (FileStatus stat) =
pcapriotti's avatar
pcapriotti committed
337
338
  unsafePerformIO $ withForeignPtr stat $ \stat_ptr -> do
    sec  <- (#peek struct stat, st_ctime) stat_ptr :: IO EpochTime
339
#ifdef HAVE_STRUCT_STAT_ST_CTIM
pcapriotti's avatar
pcapriotti committed
340
341
    nsec <- (#peek struct stat, st_ctim.tv_nsec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
342
#elif HAVE_STRUCT_STAT_ST_CTIMESPEC
pcapriotti's avatar
pcapriotti committed
343
344
    nsec <- (#peek struct stat, st_ctimespec.tv_nsec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
345
#elif HAVE_STRUCT_STAT_ST_CTIMENSEC
pcapriotti's avatar
pcapriotti committed
346
347
    nsec <- (#peek struct stat, st_ctimensec) stat_ptr :: IO (#type long)
    let frac = toInteger nsec % 10^(9::Int)
348
#elif HAVE_STRUCT_STAT_ST_CTIME_N
pcapriotti's avatar
pcapriotti committed
349
350
    nsec <- (#peek struct stat, st_ctime_n) stat_ptr :: IO (#type int)
    let frac = toInteger nsec % 10^(9::Int)
351
#elif HAVE_STRUCT_STAT_ST_UCTIME
pcapriotti's avatar
pcapriotti committed
352
353
    usec <- (#peek struct stat, st_uctime) stat_ptr :: IO (#type int)
    let frac = toInteger usec % 10^(6::Int)
354
355
356
357
358
#else
    let frac = 0
#endif
    return $ fromRational $ toRational sec + frac

359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
-- | Checks if this file is a block device.
isBlockDevice     :: FileStatus -> Bool
-- | Checks if this file is a character device.
isCharacterDevice :: FileStatus -> Bool
-- | Checks if this file is a named pipe device.
isNamedPipe       :: FileStatus -> Bool
-- | Checks if this file is a regular file device.
isRegularFile     :: FileStatus -> Bool
-- | Checks if this file is a directory device.
isDirectory       :: FileStatus -> Bool
-- | Checks if this file is a symbolic link device.
isSymbolicLink    :: FileStatus -> Bool
-- | Checks if this file is a socket device.
isSocket          :: FileStatus -> Bool

bos's avatar
bos committed
374
isBlockDevice stat =
375
  (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode
bos's avatar
bos committed
376
isCharacterDevice stat =
377
  (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode
bos's avatar
bos committed
378
isNamedPipe stat =
379
  (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode
bos's avatar
bos committed
380
isRegularFile stat =
381
  (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode
bos's avatar
bos committed
382
isDirectory stat =
383
  (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode
bos's avatar
bos committed
384
isSymbolicLink stat =
385
  (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode
bos's avatar
bos committed
386
isSocket stat =
387
388
389
390
391
392
393
  (fileMode stat `intersectFileModes` fileTypeModes) == socketMode

-- | @getFdStatus fd@ acts as 'getFileStatus' but uses a file descriptor @fd@.
--
-- Note: calls @fstat@.
getFdStatus :: Fd -> IO FileStatus
getFdStatus (Fd fd) = do
bos's avatar
bos committed
394
  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
395
396
397
398
  withForeignPtr fp $ \p ->
    throwErrnoIfMinus1_ "getFdStatus" (c_fstat fd p)
  return (FileStatus fp)

399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
-- -----------------------------------------------------------------------------
-- Setting file times

#if HAVE_UTIMENSAT || HAVE_FUTIMENS
data CTimeSpec = CTimeSpec EpochTime CLong

instance Storable CTimeSpec where
    sizeOf    _ = #size struct timespec
    alignment _ = alignment (undefined :: CInt)
    poke p (CTimeSpec sec nsec) = do
        (#poke struct timespec, tv_sec ) p sec
        (#poke struct timespec, tv_nsec) p nsec
    peek p = do
        sec  <- #{peek struct timespec, tv_sec } p
        nsec <- #{peek struct timespec, tv_nsec} p
        return $ CTimeSpec sec nsec

toCTimeSpec :: POSIXTime -> CTimeSpec
pcapriotti's avatar
pcapriotti committed
417
toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10^(9::Int) * frac)
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
  where
    (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac')
    (sec', frac') = properFraction $ toRational t
#endif

#ifdef HAVE_UTIMENSAT
foreign import ccall unsafe "utimensat"
    c_utimensat :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt
#endif

#if HAVE_FUTIMENS
foreign import ccall unsafe "futimens"
    c_futimens :: CInt -> Ptr CTimeSpec -> IO CInt
#endif

data CTimeVal = CTimeVal CLong CLong

instance Storable CTimeVal where
    sizeOf    _ = #size struct timeval
    alignment _ = alignment (undefined :: CInt)
    poke p (CTimeVal sec usec) = do
        (#poke struct timeval, tv_sec ) p sec
        (#poke struct timeval, tv_usec) p usec
    peek p = do
        sec  <- #{peek struct timeval, tv_sec } p
        usec <- #{peek struct timeval, tv_usec} p
        return $ CTimeVal sec usec

toCTimeVal :: POSIXTime -> CTimeVal
pcapriotti's avatar
pcapriotti committed
447
toCTimeVal t = CTimeVal sec (truncate $ 10^(6::Int) * frac)
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
  where
    (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac')
    (sec', frac') = properFraction $ toRational t

foreign import ccall unsafe "utimes"
    c_utimes :: CString -> Ptr CTimeVal -> IO CInt

#ifdef HAVE_LUTIMES
foreign import ccall unsafe "lutimes"
    c_lutimes :: CString -> Ptr CTimeVal -> IO CInt
#endif

#if HAVE_FUTIMES
foreign import ccall unsafe "futimes"
    c_futimes :: CInt -> Ptr CTimeVal -> IO CInt
#endif

-- | Like 'setFileTimesHiRes' but uses a file descriptor instead of a path.
-- This operation is not supported on all platforms. On these platforms,
-- this function will raise an exception.
--
-- Note: calls @futimens@ or @futimes@.
470
471
--
-- /Since: 2.7.0.0/
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()
#if HAVE_FUTIMENS
setFdTimesHiRes (Fd fd) atime mtime =
  withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
    throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times)
#elif HAVE_FUTIMES
setFdTimesHiRes (Fd fd) atime mtime =
  withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
    throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimes fd times)
#else
setFdTimesHiRes =
  error "setSymbolicLinkTimesHiRes: not available on this platform"
#endif

-- | Like 'touchFile' but uses a file descriptor instead of a path.
-- This operation is not supported on all platforms. On these platforms,
-- this function will raise an exception.
--
-- Note: calls @futimes@.
491
492
--
-- /Since: 2.7.0.0/
493
494
495
496
497
498
499
500
501
touchFd :: Fd -> IO ()
#if HAVE_FUTIMES
touchFd (Fd fd) =
  throwErrnoIfMinus1_ "touchFd" (c_futimes fd nullPtr)
#else
touchFd =
  error "touchFd: not available on this platform"
#endif

502
503
504
505
506
507
508
509
-- -----------------------------------------------------------------------------
-- fchown()

-- | Acts as 'setOwnerAndGroup' but uses a file descriptor instead of a
-- 'FilePath'.
--
-- Note: calls @fchown@.
setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
bos's avatar
bos committed
510
setFdOwnerAndGroup (Fd fd) uid gid =
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
  throwErrnoIfMinus1_ "setFdOwnerAndGroup" (c_fchown fd uid gid)

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

-- -----------------------------------------------------------------------------
-- ftruncate()

-- | Acts as 'setFileSize' but uses a file descriptor instead of a 'FilePath'.
--
-- Note: calls @ftruncate@.
setFdSize :: Fd -> FileOffset -> IO ()
setFdSize (Fd fd) off =
  throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd off)

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

data PathVar
530
  = FileSizeBits                  {- _PC_FILESIZEBITS     -}
531
532
533
534
535
536
  | LinkLimit                     {- _PC_LINK_MAX         -}
  | InputLineLimit                {- _PC_MAX_CANON        -}
  | InputQueueLimit               {- _PC_MAX_INPUT        -}
  | FileNameLimit                 {- _PC_NAME_MAX         -}
  | PathNameLimit                 {- _PC_PATH_MAX         -}
  | PipeBufferLimit               {- _PC_PIPE_BUF         -}
537
538
539
540
541
542
543
                                  -- 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      -}
544
545
  | SetOwnerAndGroupIsRestricted  {- _PC_CHOWN_RESTRICTED -}
  | FileNamesAreNotTruncated      {- _PC_NO_TRUNC         -}
546
547
548
549
  | VDisableChar                  {- _PC_VDISABLE         -}
  | AsyncIOAvailable              {- _PC_ASYNC_IO         -}
  | PrioIOAvailable               {- _PC_PRIO_IO          -}
  | SyncIOAvailable               {- _PC_SYNC_IO          -}
550
551
552

pathVarConst :: PathVar -> CInt
pathVarConst v = case v of
553
554
555
556
557
558
559
560
561
        LinkLimit                       -> (#const _PC_LINK_MAX)
        InputLineLimit                  -> (#const _PC_MAX_CANON)
        InputQueueLimit                 -> (#const _PC_MAX_INPUT)
        FileNameLimit                   -> (#const _PC_NAME_MAX)
        PathNameLimit                   -> (#const _PC_PATH_MAX)
        PipeBufferLimit                 -> (#const _PC_PIPE_BUF)
        SetOwnerAndGroupIsRestricted    -> (#const _PC_CHOWN_RESTRICTED)
        FileNamesAreNotTruncated        -> (#const _PC_NO_TRUNC)
        VDisableChar                    -> (#const _PC_VDISABLE)
562
563

#ifdef _PC_SYNC_IO
564
        SyncIOAvailable         -> (#const _PC_SYNC_IO)
565
#else
566
        SyncIOAvailable         -> error "_PC_SYNC_IO not available"
567
568
569
#endif

#ifdef _PC_ASYNC_IO
570
        AsyncIOAvailable        -> (#const _PC_ASYNC_IO)
571
#else
572
        AsyncIOAvailable        -> error "_PC_ASYNC_IO not available"
573
574
575
#endif

#ifdef _PC_PRIO_IO
576
        PrioIOAvailable         -> (#const _PC_PRIO_IO)
577
#else
578
        PrioIOAvailable         -> error "_PC_PRIO_IO not available"
579
580
581
#endif

#if _PC_FILESIZEBITS
582
        FileSizeBits            -> (#const _PC_FILESIZEBITS)
583
#else
584
        FileSizeBits            -> error "_PC_FILESIZEBITS not available"
585
586
587
#endif

#if _PC_SYMLINK_MAX
588
        SymbolicLinkLimit       -> (#const _PC_SYMLINK_MAX)
589
#else
590
        SymbolicLinkLimit       -> error "_PC_SYMLINK_MAX not available"
591
592
593
594
595
596
597
598
599
600
601
#endif

-- | @getFdPathVar var fd@ obtains the dynamic value of the requested
-- configurable file limit or option associated with the file or directory
-- attached to the open channel @fd@. For defined file limits, @getFdPathVar@
-- returns the associated value.  For defined file options, the result of
-- @getFdPathVar@ is undefined, but not failure.
--
-- Note: calls @fpathconf@.
getFdPathVar :: Fd -> PathVar -> IO Limit
getFdPathVar (Fd fd) v =
bos's avatar
bos committed
602
    throwErrnoIfMinus1 "getFdPathVar" $
603
604
      c_fpathconf fd (pathVarConst v)

bos's avatar
bos committed
605
foreign import ccall unsafe "fpathconf"
606
  c_fpathconf :: CInt -> CInt -> IO CLong