5f6509e · project-m36 · git.iko.soy

git.iko.soy/project-m36

fix file lock handle leak on connection close

System.IO actively prevents opening the same file twice in write mode, so we must resort to a lower-level API luckily, the locking API is self-contained needs Windows munging

commit5f6509ea3d4ca6e44ca012d6a1e70ac83211f333 authorAgentM <agentm@themactionfaction.com> dateMon 18 Sep 2017, 19:45 (9 years ago) parenta11a49a

4 files changed+37−33

compare with master

unifiedsplit

src/bin/benchmark/Handles.hs+3−2 src/lib/ProjectM36/Client.hs+6−3 src/lib/ProjectM36/FileLock.hs+20−14 src/lib/ProjectM36/TransactionGraph/Persist.hs+8−14

src/bin/benchmark/Handles.hs+3−2

@@ -9,6 +9,7 @@ import Text.Megaparsec hiding (option)

99import Data.Monoid

1010import qualified Data.Map as M

1111import System.Directory

12+import Control.Monad

1213

1314type OpenCloseCount = Int

1415

@@ -33,7 +34,7 @@ parseDbDir = strOption (short 'd' <> long "dbdir")

3334main :: IO ()

3435main = do

3536 (HandlesArgs ocCount tCount dbdir) <- execParser $ info (helper <*> parseArgs) fullDesc

36− sequence_ $ replicate ocCount (runOpenClose tCount dbdir)

37+ replicateM_ ocCount (runOpenClose tCount dbdir)

3738

3839runOpenClose :: TransactionCount -> DbDir -> IO ()

3940runOpenClose tCount dbdir = do

@@ -51,7 +52,7 @@ runOpenClose tCount dbdir = do

5152 case eErr of

5253 Left err -> error (show err)

5354 Right _ -> do

54− sequence_ $ replicate tCount (runTransaction session conn)

55+ replicateM_ tCount (runTransaction session conn)

5556 close conn

5657 printFdCount

5758

src/lib/ProjectM36/Client.hs+6−3

@@ -214,8 +214,6 @@ defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (c

214214-- | The 'Connection' represents either local or remote access to a database. All operations flow through the connection.

215215type ClientNodes = STMSet.Set ProcessId

216216

217−type TransactionGraphLockHandle = Handle

218−

219217-- internal structure specific to in-process connections

220218data InProcessConnectionConf = InProcessConnectionConf {

221219 ipPersistenceStrategy :: PersistenceStrategy,

@@ -225,7 +223,7 @@ data InProcessConnectionConf = InProcessConnectionConf {

225223 ipScriptSession :: Maybe ScriptSession,

226224 ipLocalNode :: LocalNode,

227225 ipTransport :: Transport, -- we hold onto this so that we can close it gracefully

228− ipLocks :: Maybe (TransactionGraphLockHandle, MVar LockFileHash) -- nothing when NoPersistence

226+ ipLocks :: Maybe (LockFile, MVar LockFileHash) -- nothing when NoPersistence

229227 }

230228

231229data RemoteProcessConnectionConf = RemoteProcessConnectionConf {

@@ -416,6 +414,7 @@ closeSession :: SessionId -> Connection -> IO ()

416414closeSession sessionId (InProcessConnection conf) =

417415 atomically $ STMMap.delete sessionId (ipSessions conf)

418416closeSession sessionId conn@(RemoteProcessConnection _) = remoteCall conn (CloseSession sessionId)

417+

419418-- | 'close' cleans up the database access connection and closes any relevant sockets.

420419close :: Connection -> IO ()

421420close (InProcessConnection conf) = do

@@ -425,6 +424,10 @@ close (InProcessConnection conf) = do

425424 pure ()

426425 closeLocalNode (ipLocalNode conf)

427426 closeTransport (ipTransport conf)

427+ let mLocks = ipLocks conf

428+ case mLocks of

429+ Nothing -> pure ()

430+ Just (lockFileH, _) -> closeLockFile lockFileH

428431

429432close conn@(RemoteProcessConnection conf) = do

430433 _ <- remoteCall conn Logout :: IO Bool

src/lib/ProjectM36/FileLock.hs+20−14

@@ -1,4 +1,4 @@

1−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE CPP, NamedFieldPuns #-}

22--cross-platform file locking utilizing POSIX file locking on Unix/Linux and Windows file locking

33--hackage's System.FileLock doesn't support POSIX advisory locks nor locking file based on file descriptors, hence this needless rewrite

44module ProjectM36.FileLock where

@@ -53,33 +53,39 @@ unlockFile handle = withHandleToHANDLE handle $ \winHandle -> do

5353 error ("failed to unlock database lock: " ++ show res)

5454

5555#else

56+--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles

5657import qualified System.Posix.IO as P

58+import System.Posix.Types

59+import System.Posix.Files

5760

5861lockStruct :: P.LockRequest -> P.FileLock

5962lockStruct req = (req, AbsoluteSeek, 0, 0)

6063

64+newtype LockFile = LockFile Fd

65+

66+--we cannot use openFile from System.IO because it implements complicated locking which prevents opening the same file twice in write mode in the same process with no way to bypass the check.

67+openLockFile :: FilePath -> IO LockFile

68+openLockFile path = do

69+ LockFile <$> P.createFile path ownerWriteMode

70+

71+closeLockFile :: LockFile -> IO ()

72+closeLockFile l@(LockFile fd) = do

73+ unlockFile l

74+ P.closeFd fd

75+

6176--blocks on lock, if necessary

62−lockFile :: Handle -> LockType -> IO ()

63−lockFile file lock = do

64− fd <- P.handleToFd file

77+lockFile :: LockFile -> LockType -> IO ()

78+lockFile (LockFile fd) lock = do

6579 let lockt = case lock of

6680 WriteLock -> P.WriteLock

6781 ReadLock -> P.ReadLock

6882 P.waitToSetLock fd (lockStruct lockt)

6983

70−unlockFile :: Handle -> IO ()

71−unlockFile file = do

72− fd <- P.handleToFd file

84+unlockFile :: LockFile -> IO ()

85+unlockFile (LockFile fd) =

7386 P.waitToSetLock fd (lockStruct P.Unlock)

7487#endif

7588

7689data LockType = ReadLock | WriteLock

7790

78−{-

79−lockFileSTM :: Handle -> LockType -> STM ()

80−lockFileSTM file lock = unsafeIOToSTM $ onException (lockFile file lock) (unlockFile file)

81−

82−unlockFileSTM :: Handle -> STM ()

83−unlockFileSTM file = unsafeIOToSTM $ unlockFile file

84−-}

8591

src/lib/ProjectM36/TransactionGraph/Persist.hs+8−14

@@ -10,7 +10,6 @@ import ProjectM36.FileLock

1010import System.Directory

1111import System.FilePath

1212import System.IO.Temp

13−import System.IO

1413import Data.Time.Clock.POSIX

1514import qualified Data.UUID as U

1615import qualified Data.Set as S

@@ -71,7 +70,7 @@ checkForOtherVersions dbdir = do

7170 pure (Right ())

7271

7372

74−setupDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Either PersistenceError (Handle, LockFileHash))

73+setupDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Either PersistenceError (LockFile, LockFileHash))

7574setupDatabaseDir sync dbdir bootstrapGraph = do

7675 dbdirExists <- doesDirectoryExist dbdir

7776 eWrongVersion <- checkForOtherVersions dbdir

@@ -81,9 +80,9 @@ setupDatabaseDir sync dbdir bootstrapGraph = do

8180 m36exists <- doesFileExist (transactionLogPath dbdir)

8281 if dbdirExists && m36exists then do

8382 --no directories to write, just

84− lockFileH <- openLockFile dbdir

85− gDigest <- bracket_ (lockFile lockFileH WriteLock) (unlockFile lockFileH) (readGraphTransactionIdFileDigest dbdir)

86− pure (Right (lockFileH, gDigest))

83+ locker <- openLockFile (lockFilePath dbdir)

84+ gDigest <- bracket_ (lockFile locker WriteLock) (unlockFile locker) (readGraphTransactionIdFileDigest dbdir)

85+ pure (Right (locker, gDigest))

8786 else if not m36exists then do

8887 locks <- bootstrapDatabaseDir sync dbdir bootstrapGraph

8988 pure (Right locks)

@@ -92,19 +91,14 @@ setupDatabaseDir sync dbdir bootstrapGraph = do

9291{-

9392initialize a database directory with the graph from which to bootstrap- return lock file handle

9493-}

95−bootstrapDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (Handle, LockFileHash)

94+bootstrapDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash)

9695bootstrapDatabaseDir sync dbdir bootstrapGraph = do

9796 createDirectory dbdir

98− lockFileH <- openLockFile dbdir

97+ locker <- openLockFile (lockFilePath dbdir)

9998 let allTransIds = map transactionId (S.toList (transactionsForGraph bootstrapGraph))

100− digest <- bracket_ (lockFile lockFileH WriteLock) (unlockFile lockFileH) (transactionGraphPersist sync dbdir allTransIds bootstrapGraph)

101− pure (lockFileH, digest)

99+ digest <- bracket_ (lockFile locker WriteLock) (unlockFile locker) (transactionGraphPersist sync dbdir allTransIds bootstrapGraph)

100+ pure (locker, digest)

102101

103−openLockFile :: FilePath -> IO Handle

104−openLockFile dbdir = do

105− lockFileH <- openFile (lockFilePath dbdir) WriteMode

106− pure lockFileH

107−

108102{-

109103incrementally updates an existing database directory

110104--algorithm: