Use file instead of dir locking haskell#187

This commit simply imports the code from the filelock package verbatim
into a subdirectory, filelock. Depending on filelock as an external
package instead would be more straightforward, but I'm not sure what the
rules for external dependencies are here.

hackage-security/filelock/LICENSE

@@ -0,0 +1,121 @@
+Creative Commons Legal Code
+
+CC0 1.0 Universal
+
+    CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE
+    LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN
+    ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS
+    INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES
+    REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS
+    PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM
+    THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED
+    HEREUNDER.
+
+Statement of Purpose
+
+The laws of most jurisdictions throughout the world automatically confer
+exclusive Copyright and Related Rights (defined below) upon the creator
+and subsequent owner(s) (each and all, an "owner") of an original work of
+authorship and/or a database (each, a "Work").
+
+Certain owners wish to permanently relinquish those rights to a Work for
+the purpose of contributing to a commons of creative, cultural and
+scientific works ("Commons") that the public can reliably and without fear
+of later claims of infringement build upon, modify, incorporate in other
+works, reuse and redistribute as freely as possible in any form whatsoever
+and for any purposes, including without limitation commercial purposes.
+These owners may contribute to the Commons to promote the ideal of a free
+culture and the further production of creative, cultural and scientific
+works, or to gain reputation or greater distribution for their Work in
+part through the use and efforts of others.
+
+For these and/or other purposes and motivations, and without any
+expectation of additional consideration or compensation, the person
+associating CC0 with a Work (the "Affirmer"), to the extent that he or she
+is an owner of Copyright and Related Rights in the Work, voluntarily
+elects to apply CC0 to the Work and publicly distribute the Work under its
+terms, with knowledge of his or her Copyright and Related Rights in the
+Work and the meaning and intended legal effect of CC0 on those rights.
+
+1. Copyright and Related Rights. A Work made available under CC0 may be
+protected by copyright and related or neighboring rights ("Copyright and
+Related Rights"). Copyright and Related Rights include, but are not
+limited to, the following:
+
+  i. the right to reproduce, adapt, distribute, perform, display,
+     communicate, and translate a Work;
+ ii. moral rights retained by the original author(s) and/or performer(s);
+iii. publicity and privacy rights pertaining to a person's image or
+     likeness depicted in a Work;
+ iv. rights protecting against unfair competition in regards to a Work,
+     subject to the limitations in paragraph 4(a), below;
+  v. rights protecting the extraction, dissemination, use and reuse of data
+     in a Work;
+ vi. database rights (such as those arising under Directive 96/9/EC of the
+     European Parliament and of the Council of 11 March 1996 on the legal
+     protection of databases, and under any national implementation
+     thereof, including any amended or successor version of such
+     directive); and
+vii. other similar, equivalent or corresponding rights throughout the
+     world based on applicable law or treaty, and any national
+     implementations thereof.
+
+2. Waiver. To the greatest extent permitted by, but not in contravention
+of, applicable law, Affirmer hereby overtly, fully, permanently,
+irrevocably and unconditionally waives, abandons, and surrenders all of
+Affirmer's Copyright and Related Rights and associated claims and causes
+of action, whether now known or unknown (including existing as well as
+future claims and causes of action), in the Work (i) in all territories
+worldwide, (ii) for the maximum duration provided by applicable law or
+treaty (including future time extensions), (iii) in any current or future
+medium and for any number of copies, and (iv) for any purpose whatsoever,
+including without limitation commercial, advertising or promotional
+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each
+member of the public at large and to the detriment of Affirmer's heirs and
+successors, fully intending that such Waiver shall not be subject to
+revocation, rescission, cancellation, termination, or any other legal or
+equitable action to disrupt the quiet enjoyment of the Work by the public
+as contemplated by Affirmer's express Statement of Purpose.
+
+3. Public License Fallback. Should any part of the Waiver for any reason
+be judged legally invalid or ineffective under applicable law, then the
+Waiver shall be preserved to the maximum extent permitted taking into
+account Affirmer's express Statement of Purpose. In addition, to the
+extent the Waiver is so judged Affirmer hereby grants to each affected
+person a royalty-free, non transferable, non sublicensable, non exclusive,
+irrevocable and unconditional license to exercise Affirmer's Copyright and
+Related Rights in the Work (i) in all territories worldwide, (ii) for the
+maximum duration provided by applicable law or treaty (including future
+time extensions), (iii) in any current or future medium and for any number
+of copies, and (iv) for any purpose whatsoever, including without
+limitation commercial, advertising or promotional purposes (the
+"License"). The License shall be deemed effective as of the date CC0 was
+applied by Affirmer to the Work. Should any part of the License for any
+reason be judged legally invalid or ineffective under applicable law, such
+partial invalidity or ineffectiveness shall not invalidate the remainder
+of the License, and in such case Affirmer hereby affirms that he or she
+will not (i) exercise any of his or her remaining Copyright and Related
+Rights in the Work or (ii) assert any associated claims and causes of
+action with respect to the Work, in either case contrary to Affirmer's
+express Statement of Purpose.
+
+4. Limitations and Disclaimers.
+
+ a. No trademark or patent rights held by Affirmer are waived, abandoned,
+    surrendered, licensed or otherwise affected by this document.
+ b. Affirmer offers the Work as-is and makes no representations or
+    warranties of any kind concerning the Work, express, implied,
+    statutory or otherwise, including without limitation warranties of
+    title, merchantability, fitness for a particular purpose, non
+    infringement, or the absence of latent or other defects, accuracy, or
+    the present or absence of errors, whether or not discoverable, all to
+    the greatest extent permissible under applicable law.
+ c. Affirmer disclaims responsibility for clearing rights of other persons
+    that may apply to the Work or any use thereof, including without
+    limitation any person's Copyright and Related Rights in the Work.
+    Further, Affirmer disclaims responsibility for obtaining any necessary
+    consents, permissions or other rights required for any use of the
+    Work.
+ d. Affirmer understands and acknowledges that Creative Commons is not a
+    party to this document and has no duty or obligation with respect to
+    this CC0 or use of the Work.

hackage-security/filelock/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

hackage-security/filelock/System/FileLock.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
+
+-- | This module provides a portable interface to file locks as a mechanism for
+-- inter-process synchronization.
+--
+-- Each file lock is associated with a file. When taking a lock, the assiciated
+-- file is created if it's not present, then the file is locked in an
+-- OS-dependent way. While the lock is being held, no other process or
+-- thread can take it, unless the specified 'SharedExclusive' values
+-- allow it.
+--
+-- All locks held by a process are released when the process exits. They can
+-- also be explicitly released using 'unlockFile'.
+--
+-- It is not recommended to open or otherwise use lock files for other
+-- purposes, because it tends to expose differences between operating systems.
+-- For example, on Windows 'System.IO.openFile' for a lock file will fail when
+-- the lock is held, but on Unix it won't.
+--
+-- Note on the implementation: currently the module uses flock(2) on non-Windows
+-- platforms, and LockFileEx on Windows.
+module System.FileLock
+  ( FileLock
+  , SharedExclusive(..)
+  , lockFile
+  , tryLockFile
+  , unlockFile
+  , withFileLock
+  , withTryFileLock
+  ) where
+
+import Control.Applicative
+import qualified Control.Exception as E
+import Control.Monad
+import Data.IORef
+import Data.Traversable (traverse)
+import Data.Typeable
+import Prelude
+
+#ifdef USE_FLOCK
+import qualified System.FileLock.Internal.Flock as I
+#elif USE_LOCKFILEEX
+import qualified System.FileLock.Internal.LockFileEx as I
+#else
+#error No backend is available
+#endif
+
+-- | A token that represents ownership of a lock.
+data FileLock = Lock
+  {-# UNPACk #-} !I.Lock
+  {-# UNPACk #-} !(IORef Bool) -- alive?
+  deriving (Typeable)
+
+instance Eq FileLock where
+  Lock _ x == Lock _ y = x == y
+
+newLock :: I.Lock -> IO FileLock
+newLock x = Lock x <$> newIORef True
+
+-- | A type of lock to be taken.
+data SharedExclusive
+  = Shared -- ^ Other process can hold a shared lock at the same time.
+  | Exclusive -- ^ No other process can hold a lock, shared or exclusive.
+  deriving (Show, Eq, Typeable)
+
+-- | Take a lock. This function blocks until the lock is available.
+lockFile :: FilePath -> SharedExclusive -> IO FileLock
+lockFile path mode = newLock =<< I.lock path (mode == Exclusive)
+
+-- | Try to take a lock. This function does not block. If the lock is not
+-- immediately available, it returns Nothing.
+tryLockFile :: FilePath -> SharedExclusive -> IO (Maybe FileLock)
+tryLockFile path mode = traverse newLock =<< I.tryLock path (mode == Exclusive)
+
+-- | Release the lock.
+unlockFile :: FileLock -> IO ()
+unlockFile (Lock l ref) = do
+  wasAlive <- atomicModifyIORef ref $ \old -> (False, old)
+  when wasAlive $ I.unlock l
+
+-- | Perform some action with a lock held. Blocks until the lock is available.
+withFileLock :: FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO a
+withFileLock path mode = E.bracket (lockFile path mode) unlockFile
+
+-- | Perform sme action with a lock held. Non-blocking.
+withTryFileLock :: FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO (Maybe a)
+withTryFileLock path mode f = E.bracket (tryLockFile path mode) (traverse unlockFile) (traverse f)

hackage-security/filelock/System/FileLock/Internal/Flock.hsc

@@ -0,0 +1,67 @@
+module System.FileLock.Internal.Flock
+#ifndef USE_FLOCK
+  () where
+#else
+  (Lock, lock, tryLock, unlock) where
+
+#include <sys/file.h>
+
+import Control.Applicative
+import qualified Control.Exception as E
+import Data.Bits
+import Foreign.C.Error
+import Foreign.C.Types
+import System.Posix.Files
+import System.Posix.IO (openFd, closeFd, defaultFileFlags, OpenMode(..))
+import System.Posix.Types
+import Prelude
+
+type Lock = Fd
+
+lock :: FilePath -> Bool -> IO Lock
+lock path exclusive = do
+  fd <- open path
+  (`E.onException` closeFd fd) $ do
+    True <- flock fd exclusive True
+    return fd
+
+tryLock :: FilePath -> Bool -> IO (Maybe Lock)
+tryLock path exclusive = do
+  fd <- open path
+  (`E.onException` closeFd fd) $ do
+    success <- flock fd exclusive False
+    if success
+      then return $ Just $ fd
+      else Nothing <$ closeFd fd
+
+unlock :: Lock -> IO ()
+unlock fd = closeFd fd
+
+open :: FilePath -> IO Fd
+open path = openFd path WriteOnly (Just stdFileMode) defaultFileFlags
+
+flock :: Fd -> Bool -> Bool -> IO Bool
+flock (Fd fd) exclusive block = do
+  r <- c_flock fd $ modeOp .|. blockOp
+  if r == 0
+    then return True -- success
+    else do
+      errno <- getErrno
+      case () of
+        _ | errno == eWOULDBLOCK
+            -> return False -- already taken
+          | errno == eINTR
+            -> flock (Fd fd) exclusive block
+          | otherwise -> throwErrno "flock"
+  where
+    modeOp = case exclusive of
+      False -> #{const LOCK_SH}
+      True -> #{const LOCK_EX}
+    blockOp = case block of
+      True -> 0
+      False -> #{const LOCK_NB}
+
+foreign import ccall "flock"
+  c_flock :: CInt -> CInt -> IO CInt
+
+#endif /* USE_FLOCK */

hackage-security/filelock/System/FileLock/Internal/LockFileEx.hsc

@@ -0,0 +1,67 @@
+module System.FileLock.Internal.LockFileEx
+#ifndef USE_LOCKFILEEX
+  () where
+#else
+  (Lock, lock, tryLock, unlock) where
+
+#include <windows.h>
+
+import Control.Applicative
+import qualified Control.Exception as E
+import Data.Bits
+import Foreign.Marshal.Alloc
+import System.Win32.File
+import System.Win32.Mem
+import System.Win32.Types
+
+type Lock = HANDLE
+
+lock :: FilePath -> Bool -> IO Lock
+lock path exclusive = do
+  file <- open path
+  (`E.onException` closeHandle file) $ do
+    True <- lockFirstByte file exclusive True
+    return file
+
+tryLock :: FilePath -> Bool -> IO (Maybe Lock)
+tryLock path exclusive = do
+  file <- open path
+  (`E.onException` closeHandle file) $ do
+    r <- lockFirstByte file exclusive False
+    if r
+      then return $ Just file
+      else Nothing <$ closeHandle file
+
+unlock :: Lock -> IO ()
+unlock = closeHandle
+
+open :: FilePath -> IO HANDLE
+open path =
+  createFile path gENERIC_WRITE (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
+    Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing
+
+lockFirstByte :: HANDLE -> Bool -> Bool -> IO Bool
+lockFirstByte handle exclusive block
+    = allocaBytes sizeof_OVERLAPPED $ \op -> do
+  zeroMemory op $ fromIntegral sizeof_OVERLAPPED
+  -- Offset and OffsetHigh fields are set to 0 by zeroMemory.
+  r <- c_lockFileEx handle (exFlag .|. blockFlag) 0{-reserved-}
+    1{-number of bytes, lower dword-}
+    0{-number of bytes, higher dword-}
+    op
+  if r
+    then return True -- success
+    else do
+      code <- getLastError
+      if code == #{const ERROR_LOCK_VIOLATION}
+        then return False -- already taken
+        else failWith "LockFileEx" code
+  where
+    exFlag = if exclusive then #{const LOCKFILE_EXCLUSIVE_LOCK} else 0
+    blockFlag = if block then 0 else #{const LOCKFILE_FAIL_IMMEDIATELY}
+    sizeof_OVERLAPPED = #{size OVERLAPPED}
+
+foreign import stdcall "LockFileEx" c_lockFileEx
+  :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL
+
+#endif /* USE_LOCKFILEEX */

hackage-security/filelock/filelock.cabal

@@ -0,0 +1,44 @@
+-- Initial filelock.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                filelock
+version:             0.1.1.2
+synopsis:            Portable interface to file locking (flock / LockFileEx)
+description:         This package provides an interface to Windows and Unix
+                     file locking functionalities.
+homepage:            http://github.com/takano-akio/filelock
+license:             PublicDomain
+license-file:        LICENSE
+author:              Takano Akio
+maintainer:          [email protected]
+-- copyright:           
+category:            System
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+extra-source-files:  tests/lock.log.expected
+
+library
+  exposed-modules:     System.FileLock
+  other-modules:       System.FileLock.Internal.Flock
+                       System.FileLock.Internal.LockFileEx
+  -- other-extensions:    
+  build-depends:       base >=4.5.1.0 && <5
+  -- hs-source-dirs:      
+  default-language:    Haskell2010
+
+  ghc-options:        -Wall
+  if os(windows)
+    cpp-options:      -DUSE_LOCKFILEEX
+    build-depends:    Win32
+  else
+    cpp-options:      -DUSE_FLOCK
+    build-depends:    unix
+
+test-suite test
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     tests
+  main-is:            test.hs
+  build-depends:      filelock, process, async, base
+  ghc-options:        -threaded
+  default-language:   Haskell2010