Commit 49a3dcf6 authored by John van Groningen's avatar John van Groningen

split the Tcp library in a part that contains the functions that do not depend...

split the Tcp library in a part that contains the functions that do not depend on Object IO (module TCPIP), and a part that includes all the functions (module StdTCP).


parent 7a21f70d
wsock32.dll
WSACleanup@0
WSAStartup@8
ntohs@4
ntohl@4
accept@12
listen@8
bind@12
htons@4
socket@12
connect@12
htonl@4
send@16
recv@16
closesocket@4
WSAGetLastError@0
gethostbyname@4
inet_addr@4
ioctlsocket@12
select@20
sendto@24
recvfrom@24
getservbyname@8
WSAAsyncGetHostByName@20
WSAAsyncSelect@16
setsockopt@20
shutdown@8
__WSAFDIsSet@8
getsockopt@20
\ No newline at end of file
definition module StdChannels
import TCPChannelClass
:: ReceiveMsg m = Received m
| EOM // receiving "EOM" will automatically close the receiver
:: SendEvent = Sendable
| Disconnected // receiving "Disconnected" will automatically close the receiver
implementation module StdChannels
definition module StdEventTCP
import TCPChannelClass,TCPDef,StdTCPDef
from StdPSt import :: IOSt, :: PSt
from StdIOCommon import :: ErrorReport
from TCPEvent import class accSChannel
from StdReceiver import class Receivers
instance ChannelEnv (PSt .l), (IOSt .l)
instance Receivers TCP_ListenerReceiver
instance Receivers TCP_Receiver
instance Receivers TCP_CharReceiver
openSendNotifier :: .ls !(SendNotifier *(ch .a) .ls (PSt .l))
!(PSt .l)
-> (!ErrorReport,!*(ch .a),!PSt .l)
| accSChannel ch & Send ch
/* opens a send notifier, which informs the application, that sending on the
channel is again possible due to flow conditions. Possible error reports are
NoError and ErrorNotifierOpen
*/
closeSendNotifier :: !*(ch .a) !(IOSt .l)
-> (!*(ch .a), !IOSt .l)
| accSChannel ch
/* closes a send notifier. This function will be called implicitly if a send
channel is closed, so there is no need to do it explicitly then.
*/
lookupIPAddress_async :: !String !(InetLookupFunction (PSt .l)) !(PSt .l)
-> PSt .l
/* lookupIPAddress_async asynchronously looks up an IP address. The String can be
in dotted decimal form or alphanumerical. The InetLookupFunction will be called
with the IP address, if this address was found, otherwise with Nothing.
*/
connectTCP_async :: !(!IPAddress,!Port) !(InetConnectFunction (PSt .l))
!(PSt .l)
-> PSt .l
/* connectTCP_async asynchronously tries to establish a new connection. The
InetConnectFunction will be called with the new duplex channel if this attempt
was succesful, otherwise with Nothing
*/
This diff is collapsed.
definition module StdStringChannels
import StdString
import TCPDef, StdTCPDef, TCPChannelClass, TCPEvent
from StdIOCommon import :: ErrorReport
from StdReceiver import :: ReceiverType, :: RId, class Receivers(..),::PSt
from TCPChannels import class getNrOfChannels, class SelectReceive, class SelectSend
import TCPStringChannels
:: *StringChannelReceiver ls pst
= StringChannelReceiver
(RId (ReceiveMsg String)) StringRChannel
(ReceiverFunction (ReceiveMsg String) *(ls,pst))
[ReceiverAttribute *(ls,pst)]
instance Receivers StringChannelReceiver
implementation module StdStringChannels
import StdEnv
import StdPSt, StdId, StdPStClass, StdReceiver
import TCPChannelClass, TCPDef, TCPChannels, TCPEvent
import receiverdefaccess
import TCPStringChannels, TCPStringChannelsInternal
import StdEventTCP
from tcp import class ChannelEnv (channel_env_get_current_tick)
:: *StringChannelReceiver ls ps
= StringChannelReceiver
(RId (ReceiveMsg String)) StringRChannel
(ReceiverFunction (ReceiveMsg String) *(ls,ps))
[ReceiverAttribute *(ls,ps)]
/* For a StringChannelReceiver two receivers are opened: one tcp receiver and one "ordinary" receiver.
The latter receives strings from the tcp receiver which contains the ReadPhase state.
*/
instance Receivers StringChannelReceiver where
openReceiver ls (StringChannelReceiver id {tcp_rchan, readPhase, maxSize} callback attributes) pSt
#! (isEom, readPhase) = isEOM readPhase
(tcpRcvId, pSt) = accPIO openId pSt
(errReport, pSt) = openReceiver (id, tcpRcvId, readPhase)
(TCP_Receiver tcpRcvId tcp_rchan tcpCallback []) pSt
| errReport<>NoError
= (errReport, pSt)
// MW11 was #! connected = getConnected attributes
#! connected = getConnectedIds attributes
(errReport, pSt) = openReceiver ls (Receiver id (checkEOM id callback)
[ReceiverConnectedReceivers [tcpRcvId: connected] :
attributes]) pSt
| not isEom
= (errReport, pSt)
#! pSt = snd (asyncSend id EOM pSt)
= (errReport, pSt)
where
isEOM EndOfMessages = (True, EndOfMessages)
isEOM readphase = (False, readphase)
tcpCallback (Received byteSeq) ((id, tcpRcvId, readPhase), pSt)
# (newStrings, readPhase) = addString (toString byteSeq, 0) readPhase maxSize
(isEom, readPhase) = isEOM readPhase
| isEom
= ((id, tcpRcvId, readPhase), snd (asyncSend id EOM pSt))
// this will also close the tcp receiver in the end
#! pSt = seq (map transition newStrings) pSt
= ((id, tcpRcvId, readPhase), pSt)
where
transition string pSt
= snd (asyncSend id (Received string) pSt)
tcpCallback EOM (ls=:(id,_,_),pSt)
#! (_, pSt) = asyncSend id EOM pSt
= (ls, pSt)
checkEOM id callback EOM ls_pSt
#! (ls,pSt) = callback EOM ls_pSt
pSt = appPIO (closeReceiver (rIdtoId id)) pSt
= (ls, pSt)
checkEOM id callback m ls_pSt
= callback m ls_pSt
getReceiverType _ = "StringChannelReceiver"
getConnectedIds rAtts
= case [ids \\ (ReceiverConnectedReceivers ids)<-rAtts] of
[] -> []
[h:_] -> h
definition module StdTCP
// ********************************************************************************
// Clean Standard TCP library, version 1.2.2
//
// StdTCP imports all definition modules needed for TCP.
// Author: Martin Wierich
// Modified: 7 September 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
import TCPIP,
StdChannels,
StdTCPChannels,
StdEventTCP,
StdStringChannels,
StdTCPDef
implementation module StdTCP
definition module StdTCPChannels
import StdString
import TCPDef, StdChannels
from tcp_bytestreams import :: TCP_RCharStream_{..}, :: TCP_SCharStream_{..}
from StdIOBasic import :: :^:(:^:), :: Void(Void)
import TCPChannels
instance SelectReceive Void
instance SelectReceive (:^: *x *y) | SelectReceive, getNrOfChannels x
& SelectReceive y
instance SelectSend Void
instance SelectSend (:^: *x *y) | SelectSend, getNrOfChannels x
& SelectSend y
instance getNrOfChannels Void
instance getNrOfChannels (:^: *x *y) | getNrOfChannels x & getNrOfChannels y
implementation module StdTCPChannels
import StdEnv
import TCPDef, StdChannels
import tcp, ostcp, ostick, tcp_bytestreams
from StdIOBasic import :: :^:(..), :: Void
import TCPChannels
instance SelectSend (:^: *x *y) | SelectSend, getNrOfChannels x & SelectSend y
where
accSChannels f (l_channels :^: r_channels)
#! (l, l_channels) = accSChannels f l_channels
(r, r_channels) = accSChannels f r_channels
= (l++r, l_channels :^: r_channels)
appDisconnected n (l_channels :^: r_channels) env
#! (l_length, l_channels) = getNrOfChannels l_channels
| n<l_length
#! (result, l_channels, env) = appDisconnected n l_channels env
= (result, l_channels :^: r_channels, env)
#! (result, r_channels, env) = appDisconnected (n-l_length) r_channels env
= (result, l_channels :^: r_channels, env)
instance SelectSend Void
where
accSChannels _ void
= ([],void)
appDisconnected _ _ _
= abort "StdTCPChannels: error: tried to apply appDisconnected to an object of type Void"
instance SelectReceive (:^: *x *y) | SelectReceive, getNrOfChannels x & SelectReceive y
where
accRChannels f (l_channels :^: r_channels)
#! (l, l_channels) = accRChannels f l_channels
(r, r_channels) = accRChannels f r_channels
= (l++r, l_channels :^: r_channels)
getRState n (l_channels :^: r_channels) env
#! (l_length, l_channels) = getNrOfChannels l_channels
| n<l_length
#! (result, l_channels, env) = getRState n l_channels env
= (result, l_channels :^: r_channels, env)
#! (result, r_channels, env) = getRState (n-l_length) r_channels env
= (result, l_channels :^: r_channels, env)
instance SelectReceive Void
where
accRChannels _ void
= ([],void)
getRState _ void env
= (Nothing, void, env)
instance getNrOfChannels (:^: *x *y) | getNrOfChannels x & getNrOfChannels y
where
getNrOfChannels (l :^: r)
#! (nl, l) = getNrOfChannels l
(nr, r) = getNrOfChannels r
= (nl+nr, l :^: r)
instance getNrOfChannels Void
where
getNrOfChannels void
= (0, void)
definition module StdTCPDef
from StdMaybe import :: Maybe
import TCPDef
import StdReceiverDef
from id import ::Id
from TCPChannelClass import :: DuplexChannel
import StdChannels
from tcp import :: IPAddress, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_
// ********************************************************************************
// for event driven processing
// ********************************************************************************
// To receive byte sequences
:: *TCP_Receiver ls pst
= TCP_Receiver
Id TCP_RChannel
(ReceiverFunction (ReceiveMsg ByteSeq) *(ls,pst))
[ReceiverAttribute *(ls,pst)]
:: SendNotifier sChannel ls pst
= SendNotifier
sChannel
(ReceiverFunction SendEvent *(ls,pst))
[ReceiverAttribute *(ls,pst)]
// To accept new connections
:: *TCP_ListenerReceiver ls pst
= TCP_ListenerReceiver
Id TCP_Listener
(*(ReceiveMsg *(IPAddress,TCP_DuplexChannel)) -> *(*(ls,pst) -> *(ls,pst)))
[ReceiverAttribute *(ls,pst)]
// To receive characters
:: *TCP_CharReceiver ls pst
= TCP_CharReceiver
Id TCP_RChannel (Maybe NrOfIterations)
(ReceiverFunction (ReceiveMsg Char) *(ls,pst))
[ReceiverAttribute *(ls,pst)]
/* For efficency the receiver function of a TCP_CharReceiver will be called from
a loop. Within this loop no other events can be handled. The NrOfIterations
parameter limits the maximum number of iterations.
*/
:: NrOfIterations :== Int
:: InetLookupFunction st :== (Maybe IPAddress) -> st -> st
:: InetConnectFunction st :== *(Maybe TCP_DuplexChannel) -> *(st -> st)
implementation module StdTCPDef
from StdMaybe import :: Maybe
import TCPDef
from StdReceiverDef import ::ReceiverAttribute,::ReceiverFunction
from id import ::Id
from TCPChannelClass import :: DuplexChannel
import StdChannels
from tcp import :: IPAddress, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_
definition module ostcptoolbox
// ********************************************************************************
// Clean Standard TCP library, version 1.2.2
//
// Author: Martin Wierich
// Modified: 15 October 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
import StdMaybe
import TCPDef
from TCPChannelClass import :: Timeout
import tcp
import ostoolbox
OSinstallTCP :: !*OSToolbox -> *OSToolbox
implementation module ostcptoolbox
import StdInt, StdTuple
import StdMaybe
import TCPDef,TCPChannelClass
import tcp, ostick
import clCrossCall_12
import code from "cCrossCallTCP_121." // PA: moved from ostoolbox
OSinstallTCP :: !*OSToolbox -> *OSToolbox
OSinstallTCP tb
= snd (issueCleanRequest2 (\_ tb->(return0Cci,tb)) (Rq0Cci CcRqCREATETCPWINDOW) (osInstallTCP tb))
osInstallTCP :: !*OSToolbox -> *OSToolbox
osInstallTCP _
= code {
ccall InstallCrossCallTCP "I-I"
}
definition module TCPChannelClass
// ********************************************************************************
// Clean Standard TCP library, version 1.2.2
//
// StdChannels defines operations on channels
// Author: Martin Wierich
// Modified: 15 October 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
from StdMaybe import :: Maybe
from StdOverloaded import class toString, class ==
from tcp import class ChannelEnv
instance ChannelEnv World
// ********************************************************************************
// receive channels
// ********************************************************************************
class Receive ch where
receive_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env)
| ChannelEnv env
receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
| ChannelEnv env
available :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
eom :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
/* receive_MT
tries to receive on a channel. This function will block until data can be
received, eom becomes true, or the timeout expires.
receiveUpTo max ch env
receives messages on a channel until available becomes False or max
messages have been received.
available
polls on a channel whether some data is ready to be received. If the
returned Boolean is True, then a following receive_MT will not block and
return TR_Success.
eom ("end of messages")
polls on a channel whether data can't be received anymore.
*/
class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env
// Closes the channel
// ********************************************************************************
// send channels
// ********************************************************************************
class Send ch where
send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*env)
| ChannelEnv env
abortConnection :: !*(ch .a) !*env
-> *env
| ChannelEnv env
disconnected :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
bufferSize :: !*(ch .a)
-> (!Int, !*(ch .a))
/* send_MT mbTimeout a ch env
adds the data a to the channels internal buffer and tries to send this
buffer.
nsend_MT mbTimeout l ch env
adds the data l to the channels internal buffer and tries to send this
buffer.
flushBuffer_MT
tries to send the channels internal buffer.
closeSChannel_MT
first tries to send the channels internal buffer and then closes the
channel.
abortConnection
will cause an abortive disconnect (sent data can be lost).
disconnected
polls on a channel, whether data can't be sent anymore. If the returned
Boolean is True, then a following send_MT will not block and return
TR_NoSuccess.
bufferSize
returns the size of the channels internal buffer in bytes.
The integer value that is returned by send_MT, nsend_MT, flushBuffer_MT, and
closeSChannel_MT is the number of sent bytes.
*/
// ********************************************************************************
// miscellaneous
// ********************************************************************************
class MaxSize ch where
setMaxSize :: !Int !*(ch .a) -> *(ch .a)
getMaxSize :: !*(ch .a) -> (!Int, !*(ch .a))
clearMaxSize :: !*(ch .a) -> *(ch .a)
// Set, get, or clear the maximum size of the data that can be received
:: DuplexChannel sChannel rChannel a
= { sChannel:: sChannel a
, rChannel:: rChannel a
}
:: TimeoutReport
= TR_Expired
| TR_Success
| TR_NoSuccess
:: Timeout :== Int // timeout in ticks
instance == TimeoutReport
instance toString TimeoutReport
// ********************************************************************************
// derived functions
// ********************************************************************************
nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env
-> (!TimeoutReport, ![.a],!*(ch .a),!*env)
| Receive ch & ChannelEnv env
/* nreceive_MT mbTimeout n ch env
tries to call receive_MT n times. If the result is (tReport, l, ch2, env2),
then the following holds:
tReport==TR_Succes <=> length l==n
tReport==TR_NoSuccess => length l<n
*/
/* The following two receive functions call their "_MT" counterpart with no
timeout. If the data can't be received because eom became True the function will
abort.
*/
receive :: !*(ch .a) !*env
-> (!.a, !*(ch .a), !*env)
| ChannelEnv env & Receive ch
nreceive :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
| ChannelEnv env & Receive ch
/* The following three send functions call their "_MT" counterpart with no timeout.
*/
send :: !.a !*(ch .a) !*env
-> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
nsend :: ![.a] !*(ch .a) !*env
-> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
closeChannel :: !*(ch .a) !*env
-> *env
| ChannelEnv env & Send ch
/* The following two send functions call their "_MT" counterpart with timeout == 0.
"NB" is a shorthand for "non blocking"
*/
send_NB :: !.a !*(ch .a) !*env
-> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
flushBuffer_NB :: !*(ch .a) !*env
-> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
implementation module TCPChannelClass
import StdEnv,StdMaybe
import tcp
from ostcp import tcp_getcurrenttick
instance ChannelEnv World
where
channelEnvKind env
= (WORLD, env)
mb_close_inet_receiver_without_id _ _ world
= world
channel_env_get_current_tick env
// = os_getcurrenttick env
= tcp_getcurrenttick env
///////////////////////////////// receive channels /////////////////////////////////
class Receive ch where
receive_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env)
| ChannelEnv env
receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
| ChannelEnv env
available :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
eom :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env
//////////////////////////////// send channels /////////////////////////////////////
class Send ch
where
send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)