{-# LANGUAGE CPP #-}{-# LANGUAGE DeriveDataTypeable #-}#include "HsNetDef.h"
moduleNetwork.Socket.Shutdown(ShutdownCmd (..),shutdown ,gracefulClose )whereimportqualifiedControl.ExceptionasEimportForeign.Marshal.Alloc(mallocBytes,free)importControl.Concurrent(threadDelay)#if !defined(mingw32_HOST_OS)
importControl.Concurrent(putMVar,takeMVar,newEmptyMVar)importqualifiedGHC.EventasEvimportSystem.Posix.Types(Fd(..))#endif
importNetwork.Socket.Buffer importNetwork.Socket.Imports importNetwork.Socket.Internal importNetwork.Socket.Types dataShutdownCmd =ShutdownReceive |ShutdownSend |ShutdownBoth derivingTypeablesdownCmdToInt::ShutdownCmd ->CIntsdownCmdToInt ShutdownReceive =0sdownCmdToIntShutdownSend =1sdownCmdToIntShutdownBoth =2-- | Shut down one or both halves of the connection, depending on the-- second argument to the function. If the second argument is-- 'ShutdownReceive', further receives are disallowed. If it is-- 'ShutdownSend', further sends are disallowed. If it is-- 'ShutdownBoth', further sends and receives are disallowed.shutdown::Socket ->ShutdownCmd ->IO()shutdown s stype =void$withFdSocket s $\fd ->throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown"$c_shutdown fd $sdownCmdToInt stype foreignimportCALLCONVunsafe"shutdown"c_shutdown::CInt->CInt->IOCInt#if !defined(mingw32_HOST_OS)
dataWait =MoreData |TimeoutTripped #endif
-- | Closing a socket gracefully.-- This sends TCP FIN and check if TCP FIN is received from the peer.-- The second argument is time out to receive TCP FIN in millisecond.-- In both normal cases and error cases, socket is deallocated finally.---- Since: 3.1.1.0gracefulClose::Socket ->Int->IO()gracefulClose s tmout =sendRecvFIN `E.finally`close s wheresendRecvFIN =do-- Sending TCP FIN.shutdown s ShutdownSend -- Waiting TCP FIN.#if defined(mingw32_HOST_OS)
recvEOFloop#else
mevmgr <-Ev.getSystemEventManagercasemevmgr ofNothing->recvEOFloop -- non-threaded RTSJustevmgr ->recvEOFev evmgr #endif
-- milliseconds. Taken from BSD fast clock value.clock =200recvEOFloop =E.bracket(mallocBytesbufSize )free$loop 0whereloop delay buf =do-- We don't check the (positive) length.-- In normal case, it's 0. That is, only FIN is received.-- In error cases, data is available. But there is no-- application which can read it. So, let's stop receiving-- to prevent attacks.r <-recvBufNoWait s buf bufSize letdelay' =delay +clock when(r ==-1&&delay' <tmout )$dothreadDelay(clock *1000)loop delay' buf #if !defined(mingw32_HOST_OS)
recvEOFev evmgr =dotmmgr <-Ev.getSystemTimerManagermvar <-newEmptyMVarE.bracket(register evmgr tmmgr mvar )(unregister evmgr tmmgr )$\_->dowait <-takeMVarmvar casewait ofTimeoutTripped ->return()-- We don't check the (positive) length.-- In normal case, it's 0. That is, only FIN is received.-- In error cases, data is available. But there is no-- application which can read it. So, let's stop receiving-- to prevent attacks.MoreData ->E.bracket(mallocBytesbufSize )free(\buf ->void$recvBufNoWait s buf bufSize )register evmgr tmmgr mvar =do-- millisecond to microsecondkey1 <-Ev.registerTimeouttmmgr (tmout *1000)$putMVarmvar TimeoutTripped key2 <-withFdSocket s $\fd' ->doletcallback __=putMVarmvar MoreData fd =Fdfd' #if __GLASGOW_HASKELL__ < 709
Ev.registerFdevmgrcallbackfdEv.evtRead#else
Ev.registerFdevmgr callback fd Ev.evtReadEv.OneShot#endif
return(key1 ,key2 )unregister evmgr tmmgr (key1 ,key2 )=doEv.unregisterTimeouttmmgr key1 Ev.unregisterFdevmgr key2 #endif
-- Don't use 4092 here. The GHC runtime takes the global lock-- if the length is over 3276 bytes in 32bit or 3272 bytes in 64bit.bufSize =1024