1{-# LANGUAGE CPP #-}
2{-# LANGUAGE InterruptibleFFI #-}
3{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE MultiWayIf #-}
5{-# LANGUAGE NoImplicitPrelude #-}
6
7module GHC.IO.Handle.Lock (
8    FileLockingNotSupported(..)
9  , LockMode(..)
10  , hLock
11  , hTryLock
12  , hUnlock
13  ) where
14
15
16#include "HsBaseConfig.h"
17
18import Data.Functor (void)
19import GHC.Base
20import GHC.IO.Handle.Lock.Common (LockMode(..), FileLockingNotSupported(..))
21import GHC.IO.Handle.Types (Handle)
22
23#if defined(mingw32_HOST_OS)
24import GHC.IO.Handle.Lock.Windows
25#elif HAVE_OFD_LOCKING
26import GHC.IO.Handle.Lock.LinuxOFD
27#elif HAVE_FLOCK
28import GHC.IO.Handle.Lock.Flock
29#else
30import GHC.IO.Handle.Lock.NoOp
31#endif
32
33-- | If a 'Handle' references a file descriptor, attempt to lock contents of the
34-- underlying file in appropriate mode. If the file is already locked in
35-- incompatible mode, this function blocks until the lock is established. The
36-- lock is automatically released upon closing a 'Handle'.
37--
38-- Things to be aware of:
39--
40-- 1) This function may block inside a C call. If it does, in order to be able
41-- to interrupt it with asynchronous exceptions and/or for other threads to
42-- continue working, you MUST use threaded version of the runtime system.
43--
44-- 2) The implementation uses 'LockFileEx' on Windows and 'flock' otherwise,
45-- hence all of their caveats also apply here.
46--
47-- 3) On non-Windows plaftorms that don't support 'flock' (e.g. Solaris) this
48-- function throws 'FileLockingNotImplemented'. We deliberately choose to not
49-- provide fcntl based locking instead because of its broken semantics.
50--
51-- @since 4.10.0.0
52hLock :: Handle -> LockMode -> IO ()
53hLock h mode = void $ lockImpl h "hLock" mode True
54
55-- | Non-blocking version of 'hLock'.
56--
57-- @since 4.10.0.0
58hTryLock :: Handle -> LockMode -> IO Bool
59hTryLock h mode = lockImpl h "hTryLock" mode False
60
61-- | Release a lock taken with 'hLock' or 'hTryLock'.
62--
63-- @since 4.11.0.0
64hUnlock :: Handle -> IO ()
65hUnlock = unlockImpl
66
67----------------------------------------
68
69