From d8087d187dfa7b8b9d19085d05533ed203131bdc Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Fri, 5 Oct 2012 17:02:51 -0400 Subject: TransferSlots: Use SafeSemaphore's MSemN instead of QSemN from base As described in the documentation, QSemN is unsafe for a variety of reasons. --- Assistant/TransferSlots.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'Assistant') diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 9e9156ad9..c41b1d28c 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -16,9 +16,10 @@ import Logs.Transfer import qualified Control.Exception as E import Control.Concurrent +import qualified Control.Concurrent.MSemN as MSemN import Data.Typeable -type TransferSlots = QSemN +type TransferSlots = MSemN.MSemN Int {- A special exception that can be thrown to pause or resume a transfer, while - keeping its slot in use. -} @@ -39,21 +40,21 @@ numSlots :: Int numSlots = 1 newTransferSlots :: IO TransferSlots -newTransferSlots = newQSemN numSlots +newTransferSlots = MSemN.new numSlots {- Waits until a transfer slot becomes available, then runs a - TransferGenerator, and then runs the transfer action in its own thread. -} inTransferSlot :: TransferSlotRunner inTransferSlot dstatus s gen = do - waitQSemN s 1 + MSemN.wait s 1 runTransferThread dstatus s =<< gen {- Runs a TransferGenerator, and its transfer action, - without waiting for a slot to become available. -} inImmediateTransferSlot :: TransferSlotRunner inImmediateTransferSlot dstatus s gen = do - signalQSemN s (-1) + MSemN.signal s (-1) runTransferThread dstatus s =<< gen {- Runs a transfer action, in an already allocated transfer slot. @@ -67,7 +68,7 @@ inImmediateTransferSlot dstatus s gen = do - then rerunning the action. -} runTransferThread :: DaemonStatusHandle -> TransferSlots -> Maybe (Transfer, TransferInfo, IO ()) -> IO () -runTransferThread _ s Nothing = signalQSemN s 1 +runTransferThread _ s Nothing = MSemN.signal s 1 runTransferThread dstatus s (Just (t, info, a)) = do tid <- forkIO go updateTransferInfo dstatus t $ info { transferTid = Just tid } @@ -86,4 +87,4 @@ runTransferThread dstatus s (Just (t, info, a)) = do Just ResumeTransfer -> go _ -> done _ -> done - done = signalQSemN s 1 + done = MSemN.signal s 1 -- cgit v1.2.3