System/Win32/NamedPipes.hsc
#include <fcntl.h>
#include <windows.h>
#include "namedpipeapi_compat.h"
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumericUnderscores #-}
-- | For full details on the Windows named pipes API see
-- <https://docs.microsoft.com/en-us/windows/desktop/ipc/named-pipes>
--
module System.Win32.NamedPipes (
-- * Named pipe server APIs
createNamedPipe,
pIPE_UNLIMITED_INSTANCES,
-- ** Parameter types
LPSECURITY_ATTRIBUTES,
OpenMode,
pIPE_ACCESS_DUPLEX,
pIPE_ACCESS_INBOUND,
pIPE_ACCESS_OUTBOUND,
fILE_FLAG_OVERLAPPED,
PipeMode,
pIPE_TYPE_BYTE,
pIPE_TYPE_MESSAGE,
pIPE_READMODE_BYTE,
pIPE_READMODE_MESSAGE,
pIPE_WAIT,
pIPE_NOWAIT,
pIPE_ACCEPT_REMOTE_CLIENTS,
pIPE_REJECT_REMOTE_CLIENTS,
-- * Named pipe client APIs
-- ** connect to a named pipe
connect,
-- ** waiting for named pipe instances
waitNamedPipe,
TimeOut,
nMPWAIT_USE_DEFAULT_WAIT,
nMPWAIT_WAIT_FOREVER,
) where
import Control.Exception
import Control.Monad (when)
import Foreign.C.String (withCString)
import System.Win32.Types hiding (try)
import System.Win32.File
-- | The named pipe open mode.
--
-- This must specify one of:
--
-- * 'pIPE_ACCESS_DUPLEX'
-- * 'pIPE_ACCESS_INBOUND'
-- * 'pIPE_ACCESS_OUTBOUND'
--
-- It may also specify:
--
-- * 'fILE_FLAG_WRITE_THROUGH'
-- * 'fILE_FLAG_OVERLAPPED'
--
-- It may also specify any combination of:
--
-- * 'wRITE_DAC'
-- * 'wRITE_OWNER'
-- * 'aCCESS_SYSTEM_SECURITY'
--
type OpenMode = UINT
#{enum OpenMode,
, pIPE_ACCESS_DUPLEX = PIPE_ACCESS_DUPLEX
, pIPE_ACCESS_INBOUND = PIPE_ACCESS_INBOUND
, pIPE_ACCESS_OUTBOUND = PIPE_ACCESS_OUTBOUND
}
-- | The pipe mode.
--
-- One of the following type modes can be specified. The same type mode must be
-- specified for each instance of the pipe.
--
-- * 'pIPE_TYPE_BYTE'
-- * 'pIPE_TYPE_MESSAGE'
--
-- One of the following read modes can be specified. Different instances of the
-- same pipe can specify different read modes.
--
-- * 'pIPE_READMODE_BYTE'
-- * 'pIPE_READMODE_MESSAGE'
--
-- One of the following wait modes can be specified. Different instances of the
-- same pipe can specify different wait modes.
--
-- * 'pIPE_WAIT'
-- * 'pIPE_NOWAIT'
--
-- One of the following remote-client modes can be specified. Different
-- instances of the same pipe can specify different remote-client modes.
--
-- * 'pIPE_ACCEPT_REMOTE_CLIENT'
-- * 'pIPE_REJECT_REMOTE_CLIENT'
--
type PipeMode = UINT
#{enum PipeMode,
, pIPE_TYPE_BYTE = PIPE_TYPE_BYTE
, pIPE_TYPE_MESSAGE = PIPE_TYPE_MESSAGE
, pIPE_READMODE_BYTE = PIPE_READMODE_BYTE
, pIPE_READMODE_MESSAGE = PIPE_READMODE_MESSAGE
, pIPE_WAIT = PIPE_WAIT
, pIPE_NOWAIT = PIPE_NOWAIT
, pIPE_ACCEPT_REMOTE_CLIENTS = PIPE_ACCEPT_REMOTE_CLIENTS
, pIPE_REJECT_REMOTE_CLIENTS = PIPE_REJECT_REMOTE_CLIENTS
}
-- | If the 'createNamedPipe' @nMaxInstances@ parameter is
-- 'pIPE_UNLIMITED_INSTANCES', the number of pipe instances that can be created
-- is limited only by the availability of system resources.
pIPE_UNLIMITED_INSTANCES :: DWORD
pIPE_UNLIMITED_INSTANCES = #const PIPE_UNLIMITED_INSTANCES
-- | Creates an instance of a named pipe and returns a handle for subsequent
-- pipe operations. A named pipe server process uses this function either to
-- create the first instance of a specific named pipe and establish its basic
-- attributes or to create a new instance of an existing named pipe.
--
-- For full details see
-- <https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-createnamedpipea>
--
-- To create a named pipe which can be associate with IO completion port on
-- needs to pass 'fILE_FLAG_OVERLAPPED' to 'OpenMode' argument,
-- e.g.
--
-- > Win32.createNamedPipe pipeName
-- > (pIPE_ACCESS_DUPLEX .|. fILE_FLAG_OVERLAPPED)
-- > (pIPE_TYPE_BYTE .|. pIPE_READMODE_BYTE)
-- > pIPE_UNLIMITED_INSTANCES
-- > 512
-- > 512
-- > 0
-- > NothinROR
--
--
createNamedPipe :: String -- ^ A unique pipe name of the form @\\.\pipe\{pipename}@
-- The `pipename` part of the name can include any
-- character other than a backslash, including
-- numbers and special characters. The entire pipe
-- name string can be up to 256 characters long.
-- Pipe names are not case sensitive.
-> OpenMode
-> PipeMode
-> DWORD -- ^ nMaxInstances
-> DWORD -- ^ nOutBufferSize
-> DWORD -- ^ nInBufferSize
-> DWORD -- ^ nDefaultTimeOut
-> Maybe LPSECURITY_ATTRIBUTES
-> IO HANDLE
createNamedPipe name openMode pipeMode
nMaxInstances nOutBufferSize nInBufferSize
nDefaultTimeOut mb_attr =
withTString name $ \ c_name ->
failIf (==iNVALID_HANDLE_VALUE) ("CreateNamedPipe ('" ++ name ++ "')") $
c_CreateNamedPipe c_name openMode pipeMode
nMaxInstances nOutBufferSize nInBufferSize
nDefaultTimeOut (maybePtr mb_attr)
foreign import ccall unsafe "windows.h CreateNamedPipeW"
c_CreateNamedPipe :: LPCTSTR
-> DWORD
-> DWORD
-> DWORD
-> DWORD
-> DWORD
-> DWORD
-> LPSECURITY_ATTRIBUTES
-> IO HANDLE
-- | Timeout in milliseconds.
--
-- * 'nMPWAIT_USE_DEFAULT_WAIT' indicates that the timeout value passed to
-- 'createNamedPipe' should be used.
-- * 'nMPWAIT_WAIT_FOREVER' - 'waitNamedPipe' will block forever, until a named
-- pipe instance is available.
--
type TimeOut = DWORD
#{enum TimeOut,
, nMPWAIT_USE_DEFAULT_WAIT = NMPWAIT_USE_DEFAULT_WAIT
, nMPWAIT_WAIT_FOREVER = NMPWAIT_WAIT_FOREVER
}
-- | Wait until a named pipe instance is available. If there is no instance at
-- hand before the timeout, it will error with 'ERROR_SEM_TIMEOUT', i.e.
-- @invalid argument (The semaphore timeout period has expired)@
--
-- It returns 'True' if there is an available instance, subsequent 'createFile'
-- might still fail, if another thread will take turn and connect before, or if
-- the other end shuts down the name pipe.
--
-- It returns 'False' if timeout fired.
--
waitNamedPipe :: String -- ^ pipe name
-> TimeOut -- ^ nTimeOut
-> IO Bool
waitNamedPipe name timeout =
withCString name $ \ c_name -> do
r <- c_WaitNamedPipe c_name timeout
e <- getLastError
if | r -> pure r
| e == eRROR_SEM_TIMEOUT -> pure False
| otherwise -> failWith "waitNamedPipe" e
-- 'c_WaitNamedPipe' is a blocking call, hence the _safe_ import.
foreign import ccall safe "windows.h WaitNamedPipeA"
c_WaitNamedPipe :: LPCSTR -- lpNamedPipeName
-> DWORD -- nTimeOut
-> IO BOOL
-- | A reliable connect call, as designed in
-- <https://docs.microsoft.com/en-us/windows/win32/ipc/named-pipe-client>
--
-- The arguments are passed directly to 'createFile'.
--
-- Note we pick the more familiar posix naming convention, do not confuse this
-- function with 'connectNamedPipe' (which corresponds to posix 'accept')
--
connect :: String -- ^ file name
-> AccessMode -- ^ dwDesiredAccess
-> ShareMode -- ^ dwSharedMode
-> Maybe LPSECURITY_ATTRIBUTES -- ^ lpSecurityAttributes
-> CreateMode -- ^ dwCreationDisposition
-> FileAttributeOrFlag -- ^ dwFlagsAndAttributes
-> Maybe HANDLE -- ^ hTemplateFile
-> IO HANDLE
connect fileName dwDesiredAccess dwSharedMode lpSecurityAttributes dwCreationDisposition dwFlagsAndAttributes hTemplateFile = connectLoop
where
connectLoop = do
-- `createFile` checks for `INVALID_HANDLE_VALUE` and retries if this is
-- caused by `ERROR_SHARING_VIOLATION`.
mh <- try $
createFile fileName
dwDesiredAccess
dwSharedMode
lpSecurityAttributes
dwCreationDisposition
dwFlagsAndAttributes
hTemplateFile
case mh :: Either IOException HANDLE of
Left e -> do
errorCode <- getLastError
when (errorCode /= eRROR_PIPE_BUSY)
$ throwIO e
-- all pipe instance were busy, wait 20s and retry; we ignore the
-- result
_ <- waitNamedPipe fileName 5_000
connectLoop
Right h -> pure h
-- | [ERROR_PIPE_BUSY](https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-#ERROR_PIPE_BUSY):
-- all pipe instances are busy.
--
eRROR_PIPE_BUSY :: ErrCode
eRROR_PIPE_BUSY = #const ERROR_PIPE_BUSY
eRROR_SEM_TIMEOUT :: ErrCode
eRROR_SEM_TIMEOUT = #const ERROR_SEM_TIMEOUT