1{-# LANGUAGE CApiFFI #-}
2{-# LANGUAGE NondecreasingIndentation #-}
3#if __GLASGOW_HASKELL__ >= 709
4{-# LANGUAGE Safe #-}
5#else
6{-# LANGUAGE Trustworthy #-}
7#endif
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  System.Posix.Unistd
11-- Copyright   :  (c) The University of Glasgow 2002
12-- License     :  BSD-style (see the file libraries/base/LICENSE)
13--
14-- Maintainer  :  libraries@haskell.org
15-- Stability   :  provisional
16-- Portability :  non-portable (requires POSIX)
17--
18-- POSIX miscellaneous stuff, mostly from unistd.h
19--
20-----------------------------------------------------------------------------
21
22module System.Posix.Unistd (
23    -- * System environment
24    SystemID(..),
25    getSystemID,
26
27    SysVar(..),
28    getSysVar,
29
30    -- * Sleeping
31    sleep, usleep, nanosleep,
32
33    -- * File synchronisation
34    fileSynchronise,
35    fileSynchroniseDataOnly,
36
37  {-
38    ToDo from unistd.h:
39      confstr,
40      lots of sysconf variables
41
42    -- use Network.BSD
43    gethostid, gethostname
44
45    -- should be in System.Posix.Files?
46    pathconf, fpathconf,
47
48    -- System.Posix.Signals
49    ualarm,
50
51    -- System.Posix.IO
52    read, write,
53
54    -- should be in System.Posix.User?
55    getEffectiveUserName,
56-}
57  ) where
58
59#include "HsUnix.h"
60
61import Foreign.C.Error
62import Foreign.C.String ( peekCString )
63import Foreign.C.Types
64import Foreign
65import System.Posix.Types
66import System.Posix.Internals
67
68#if !(HAVE_FSYNC && HAVE_FDATASYNC)
69import System.IO.Error ( ioeSetLocation )
70import GHC.IO.Exception ( unsupportedOperation )
71#endif
72
73-- -----------------------------------------------------------------------------
74-- System environment (uname())
75
76data SystemID =
77  SystemID { systemName :: String
78           , nodeName   :: String
79           , release    :: String
80           , version    :: String
81           , machine    :: String
82           }
83
84getSystemID :: IO SystemID
85getSystemID = do
86  allocaBytes (#const sizeof(struct utsname)) $ \p_sid -> do
87    throwErrnoIfMinus1_ "getSystemID" (c_uname p_sid)
88    sysN <- peekCString ((#ptr struct utsname, sysname) p_sid)
89    node <- peekCString ((#ptr struct utsname, nodename) p_sid)
90    rel  <- peekCString ((#ptr struct utsname, release) p_sid)
91    ver  <- peekCString ((#ptr struct utsname, version) p_sid)
92    mach <- peekCString ((#ptr struct utsname, machine) p_sid)
93    return (SystemID { systemName = sysN,
94                       nodeName   = node,
95                       release    = rel,
96                       version    = ver,
97                       machine    = mach
98                     })
99
100foreign import ccall unsafe "uname"
101   c_uname :: Ptr CUtsname -> IO CInt
102
103-- -----------------------------------------------------------------------------
104-- sleeping
105
106-- | Sleep for the specified duration (in seconds).  Returns the time remaining
107-- (if the sleep was interrupted by a signal, for example).
108--
109-- /GHC Note/: 'Control.Concurrent.threadDelay' is a better choice.  Since GHC
110-- uses signals for its internal clock, a call to 'sleep' will usually be
111-- interrupted immediately.  That makes 'sleep' unusable in a program compiled
112-- with GHC, unless the RTS timer is disabled (with @+RTS -V0@).  Furthermore,
113-- without the @-threaded@ option, 'sleep' will block all other user threads.
114-- Even with the @-threaded@ option, 'sleep' requires a full OS thread to
115-- itself.  'Control.Concurrent.threadDelay' has none of these shortcomings.
116--
117sleep :: Int -> IO Int
118sleep 0 = return 0
119sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r)
120
121{-# WARNING sleep "This function has several shortcomings (see documentation). Please consider using Control.Concurrent.threadDelay instead." #-}
122
123foreign import ccall safe "sleep"
124  c_sleep :: CUInt -> IO CUInt
125
126-- | Sleep for the specified duration (in microseconds).
127--
128-- /GHC Note/: 'Control.Concurrent.threadDelay' is a better choice.
129-- Without the @-threaded@ option, 'usleep' will block all other user
130-- threads.  Even with the @-threaded@ option, 'usleep' requires a
131-- full OS thread to itself.  'Control.Concurrent.threadDelay' has
132-- neither of these shortcomings.
133--
134usleep :: Int -> IO ()
135#ifdef HAVE_NANOSLEEP
136usleep usecs = nanosleep (fromIntegral usecs * 1000)
137#else
138usleep 0 = return ()
139#ifdef USLEEP_RETURNS_VOID
140usleep usecs = c_usleep (fromIntegral usecs)
141#else
142usleep usecs = throwErrnoIfMinus1_ "usleep" (c_usleep (fromIntegral usecs))
143#endif
144
145#ifdef USLEEP_RETURNS_VOID
146foreign import ccall safe "usleep"
147  c_usleep :: CUInt -> IO ()
148#else
149foreign import ccall safe "usleep"
150  c_usleep :: CUInt -> IO CInt
151#endif
152#endif /* HAVE_NANOSLEEP */
153
154-- | Sleep for the specified duration (in nanoseconds)
155--
156-- /GHC Note/: the comment for 'usleep' also applies here.
157nanosleep :: Integer -> IO ()
158#ifndef HAVE_NANOSLEEP
159nanosleep = error "nanosleep: not available on this platform"
160#else
161nanosleep 0 = return ()
162nanosleep nsecs = do
163  allocaBytes (#const sizeof(struct timespec)) $ \pts1 -> do
164  allocaBytes (#const sizeof(struct timespec)) $ \pts2 -> do
165     let (tv_sec0, tv_nsec0) = nsecs `divMod` 1000000000
166     let
167       loop tv_sec tv_nsec = do
168         (#poke struct timespec, tv_sec)  pts1 tv_sec
169         (#poke struct timespec, tv_nsec) pts1 tv_nsec
170         res <- c_nanosleep pts1 pts2
171         if res == 0
172            then return ()
173            else do errno <- getErrno
174                    if errno == eINTR
175                       then do
176                           tv_sec'  <- (#peek struct timespec, tv_sec)  pts2
177                           tv_nsec' <- (#peek struct timespec, tv_nsec) pts2
178                           loop tv_sec' tv_nsec'
179                       else throwErrno "nanosleep"
180     loop (fromIntegral tv_sec0 :: CTime) (fromIntegral tv_nsec0 :: CTime)
181
182data {-# CTYPE "struct timespec" #-} CTimeSpec
183
184foreign import capi safe "HsUnix.h nanosleep"
185  c_nanosleep :: Ptr CTimeSpec -> Ptr CTimeSpec -> IO CInt
186#endif
187
188-- -----------------------------------------------------------------------------
189-- System variables
190
191data SysVar = ArgumentLimit
192            | ChildLimit
193            | ClockTick
194            | GroupLimit
195            | OpenFileLimit
196            | PosixVersion
197            | HasSavedIDs
198            | HasJobControl
199        -- ToDo: lots more
200
201getSysVar :: SysVar -> IO Integer
202getSysVar v =
203    case v of
204      ArgumentLimit -> sysconf (#const _SC_ARG_MAX)
205      ChildLimit    -> sysconf (#const _SC_CHILD_MAX)
206      ClockTick     -> sysconf (#const _SC_CLK_TCK)
207      GroupLimit    -> sysconf (#const _SC_NGROUPS_MAX)
208      OpenFileLimit -> sysconf (#const _SC_OPEN_MAX)
209      PosixVersion  -> sysconf (#const _SC_VERSION)
210      HasSavedIDs   -> sysconf (#const _SC_SAVED_IDS)
211      HasJobControl -> sysconf (#const _SC_JOB_CONTROL)
212
213sysconf :: CInt -> IO Integer
214sysconf n = do
215  r <- throwErrnoIfMinus1 "getSysVar" (c_sysconf n)
216  return (fromIntegral r)
217
218foreign import ccall unsafe "sysconf"
219  c_sysconf :: CInt -> IO CLong
220
221-- -----------------------------------------------------------------------------
222-- File synchronization
223
224-- | Performs @fsync(2)@ operation on file-descriptor.
225--
226-- Throws 'IOError' (\"unsupported operation\") if platform does not
227-- provide @fsync(2)@ (use @#if HAVE_FSYNC@ CPP guard to
228-- detect availability).
229--
230-- @since 2.7.1.0
231fileSynchronise :: Fd -> IO ()
232#if HAVE_FSYNC
233fileSynchronise fd = do
234  throwErrnoIfMinus1_ "fileSynchronise" (c_fsync fd)
235
236foreign import capi safe "unistd.h fsync"
237  c_fsync :: Fd -> IO CInt
238#else
239{-# WARNING fileSynchronise
240    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FSYNC@)" #-}
241fileSynchronise _ = ioError (ioeSetLocation unsupportedOperation
242                             "fileSynchronise")
243#endif
244
245-- | Performs @fdatasync(2)@ operation on file-descriptor.
246--
247-- Throws 'IOError' (\"unsupported operation\") if platform does not
248-- provide @fdatasync(2)@ (use @#if HAVE_FDATASYNC@ CPP guard to
249-- detect availability).
250--
251-- @since 2.7.1.0
252fileSynchroniseDataOnly :: Fd -> IO ()
253#if HAVE_FDATASYNC
254fileSynchroniseDataOnly fd = do
255  throwErrnoIfMinus1_ "fileSynchroniseDataOnly" (c_fdatasync fd)
256
257foreign import capi safe "unistd.h fdatasync"
258  c_fdatasync :: Fd -> IO CInt
259#else
260{-# WARNING fileSynchroniseDataOnly
261    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FDATASYNC@)" #-}
262fileSynchroniseDataOnly _ = ioError (ioeSetLocation unsupportedOperation
263                                     "fileSynchroniseDataOnly")
264#endif
265