1{-# LANGUAGE CPP         #-}
2{-# LANGUAGE Trustworthy #-}
3-- | Open 'Handle' based locking
4module Lukko (
5    FileLockingNotSupported(..),
6    Impl.fileLockingSupported,
7    Impl.FileLockingSupported,
8    FileLockingMethod (..),
9    Impl.fileLockingMethod,
10    LockMode(..),
11    -- * File descriptors
12    FD,
13    fdOpen,
14    fdClose,
15    fdLock,
16    fdTryLock,
17    fdUnlock,
18    -- * Handles
19    handleToFd,
20    hLock,
21    hTryLock,
22    hUnlock,
23    ) where
24
25{- Parts of these software is derived from GHC sources
26   distributed under BSD-3-Clause license:
27
28The Glasgow Haskell Compiler License
29
30Copyright 2004, The University Court of the University of Glasgow.
31All rights reserved.
32
33Redistribution and use in source and binary forms, with or without
34modification, are permitted provided that the following conditions are met:
35
36- Redistributions of source code must retain the above copyright notice,
37this list of conditions and the following disclaimer.
38
39- Redistributions in binary form must reproduce the above copyright notice,
40this list of conditions and the following disclaimer in the documentation
41and/or other materials provided with the distribution.
42
43- Neither name of the University nor the names of its contributors may be
44used to endorse or promote products derived from this software without
45specific prior written permission.
46
47THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
48GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
49INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
50FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
51UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
52FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
53DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
54SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
55CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
56LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
57OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
58DAMAGE.
59
60-}
61
62import Control.Monad (void)
63import System.IO     (Handle)
64
65import Lukko.Internal.Types
66
67import qualified Lukko.Internal.FD as Impl
68
69#if defined(USE_OFD_LOCKING)
70import qualified Lukko.OFD as Impl
71#elif defined(USE_FLOCK)
72import qualified Lukko.FLock as Impl
73#elif defined(USE_WINDOWS_LOCK)
74import qualified Lukko.Windows as Impl
75#else
76import qualified Lukko.NoOp as Impl
77#endif
78
79-------------------------------------------------------------------------------
80-- Handles
81-------------------------------------------------------------------------------
82
83-- | If a 'Handle' references a file descriptor, attempt to lock contents of the
84-- underlying file in appropriate mode. If the file is already locked in
85-- incompatible mode, this function blocks until the lock is established. The
86-- lock is automatically released upon closing a 'Handle'.
87--
88-- Things to be aware of:
89--
90-- 1) This function may block inside a C call. If it does, in order to be able
91-- to interrupt it with asynchronous exceptions and/or for other threads to
92-- continue working, you MUST use threaded version of the runtime system.
93--
94-- 2) The implementation uses 'LockFileEx' on Windows,
95-- /open file descriptor/ locks on Linux, and 'flock' otherwise,
96-- hence all of their caveats also apply here.
97--
98-- 3) On non-Windows plaftorms that don't support 'flock' (e.g. Solaris) this
99-- function throws 'FileLockingNotImplemented'. We deliberately choose to not
100-- provide @fcntl@ based locking instead because of its broken semantics.
101--
102hLock :: Handle -> LockMode -> IO ()
103hLock = Impl.hLock
104
105-- | Non-blocking version of 'hLock'.
106hTryLock :: Handle -> LockMode -> IO Bool
107hTryLock = Impl.hTryLock
108
109-- | Release a lock taken with 'hLock' or 'hTryLock'.
110hUnlock :: Handle -> IO ()
111hUnlock = Impl.hUnlock
112
113-------------------------------------------------------------------------------
114-- File descriptors
115-------------------------------------------------------------------------------
116
117-- | Opaque /file descriptor/
118--
119-- An @int@ / 'CInt' on unix systems,
120-- and 'HANDLE' on windows.
121type FD = Impl.FD
122
123-- | Open file to be used for locking.
124fdOpen :: FilePath -> IO FD
125fdOpen = Impl.fdOpen
126
127-- | Close lock file.
128fdClose :: FD -> IO ()
129fdClose = Impl.fdClose
130
131-- | Convert GHC 'Handle' to lukko 'FD'.
132handleToFd :: Handle -> IO FD
133handleToFd = Impl.handleToFd
134
135-- | Like 'hLock', but work on "raw" file descriptor,
136-- as handled by 'fdOpen' and 'fdClose'.
137fdLock :: Impl.FD -> LockMode -> IO ()
138fdLock = Impl.fdLock
139
140-- | Non-blocking version of 'fdLock'.
141fdTryLock :: Impl.FD -> LockMode -> IO Bool
142fdTryLock = Impl.fdTryLock
143
144-- | Release a lock taken with 'fdLock' or 'fdTryLock'.
145fdUnlock :: Impl.FD -> IO ()
146fdUnlock = Impl.fdUnlock
147