XCommunicationsTCPPCedar.mesa
Copyright Ó 1988, 1989, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, July 11, 1988 2:41:31 pm PDT
Christian Jacobi, May 2, 1989 1:10:50 pm PDT
DIRECTORY
Ascii, Arpa, Basics, Convert, XCommunications, SunYPAgent, UnixFile, UnixSocket, UnixSysCalls, UnixSysCallExtensions, UXStrings, UnixTypes, IO, Rope;
XCommunicationsTCPPCedar: CEDAR PROGRAM
IMPORTS Basics, Convert, IO, Rope, SunYPAgent, UnixSysCalls, UnixSysCallExtensions, XCommunications =
BEGIN
STREAM: TYPE = IO.STREAM;
From Sun manual:
Network Programming
Revision A, of 9 May 1988
Chapter 8.8, Figure 8.9, page 206
Initiating an Internet Domain Stream Connection
--C-- PortNumber: TYPE = MACHINE DEPENDENT RECORD [val: Basics.HWORD];
--C-- SockAddrIn: TYPE = WORD16 MACHINE DEPENDENT RECORD [
--see chapter 8.7, page 203 ...<netinet/in.h>
sinFamily: UnixSocket.ProtocolFamily,
sinPort: PortNumber,
sinAddr: Arpa.Address,
sinZero: PACKED ARRAY [0..8) OF BYTE
];
MoveBytes: UNSAFE PROC [dest: POINTER, src: POINTER, len: CARDINAL] ~ UNCHECKED MACHINE CODE{
"XR←MoveBytesDisjoint"
};
UnixSysCallsWrite: PROC [d: UnixFile.FileDescriptor, buf: UnixTypes.CHARPtr, nBytes: INT] RETURNS [INT] ~ TRUSTED MACHINE CODE {
"XR←Write"
};
noArpaAddress: ERROR [why: Rope.ROPE] = CODE;
iBufferSize: INT = 512;
oBufferSize: INT = 4096;
myStreamProcs: REF IO.StreamProcs ¬ IO.CreateStreamProcs[
variety: inputOutput,
class: $XCommunicationsTCPPCedar,
getChar: MyGetChar,
endOf: MyEndOf,
unsafeGetBlock: MyUnsafeGetBlock,
putChar: MyPutChar,
unsafePutBlock: MyUnsafePutBlock,
flush: SendNow,
close: MyClose
];
MyDataRec: TYPE = MONITORED RECORD [
socket: UnixSysCalls.FD,
closed: BOOL ¬ FALSE,
oBufCnt: INT ¬ 0,
iBufCnt: INT ¬ 0,
iBufStart: INT ¬ 0,
server: SockAddrIn,
outBuffer: PACKED ARRAY [0..oBufferSize) OF CHAR, --never full between commands
inBuffer: PACKED ARRAY [0..iBufferSize) OF CHAR,
myStream: IO.STREAM ¬ NIL --usefull to raise errors
];
MyEndOf: PROC [self: STREAM] RETURNS [BOOL] = {
RETURN [FALSE];
};
MyPutChar: PROC [self: STREAM, char: CHAR] = {
d: REF MyDataRec = NARROW[self.streamData];
IF d.closed THEN ERROR IO.Error[StreamClosed, self];
d.outBuffer[d.oBufCnt] ¬ char;
d.oBufCnt ¬ d.oBufCnt+1;
IF d.oBufCnt>=oBufferSize THEN MyFlush[d];
};
MyUnsafePutBlock: PROC [self: STREAM, block: Basics.UnsafeBlock] = TRUSTED {
d: REF MyDataRec = NARROW[self.streamData];
IF d.closed THEN ERROR IO.Error[StreamClosed, self];
DO
bCnt: INT ¬ d.oBufCnt;
--copy to prevent even competing processes from writing memory outside buffer
cnt: INT ¬ MIN[oBufferSize-bCnt, block.count];
MoveBytes[@d.outBuffer+bCnt, block.base+block.startIndex, cnt];
d.oBufCnt ¬ d.oBufCnt + cnt;
block.startIndex ¬ block.startIndex + cnt;
block.count ¬ block.count - cnt;
IF block.count>0 THEN MyFlush[d] ELSE EXIT
ENDLOOP;
IF d.oBufCnt>=oBufferSize THEN MyFlush[d];
};
ReadSome: PROC [d: REF MyDataRec] = TRUSTED {
IF d.iBufCnt>0 THEN RETURN;
IF d.closed THEN ERROR IO.Error[StreamClosed, d.myStream];
DO
n: INT ¬ UnixSysCalls.Read[d.socket, LOOPHOLE[@d.inBuffer], iBufferSize];
IF n>0 THEN {d.iBufCnt ¬ n; d.iBufStart ¬ 0; RETURN};
IF n<0 THEN ERROR IO.EndOfStream[d.myStream];
ENDLOOP;
};
MyGetChar: PROC [self: STREAM] RETURNS [ch: CHAR] = {
d: REF MyDataRec = NARROW[self.streamData];
IF d.iBufCnt<=0 THEN ReadSome[d];
ch ¬ d.inBuffer[d.iBufStart];
d.iBufCnt ¬ d.iBufCnt - 1;
d.iBufStart ¬ d.iBufStart + 1;
};
MyUnsafeGetBlock: UNSAFE PROC [self: STREAM, block: Basics.UnsafeBlock] RETURNS [nBytesRead: INT ¬ 0] = {
n: INT;
d: REF MyDataRec = NARROW[self.streamData];
IF d.closed THEN ERROR IO.Error[StreamClosed, self];
WHILE block.count>0 DO
IF d.iBufCnt<=0 THEN ReadSome[d];
n ¬ MIN[d.iBufCnt, block.count];
TRUSTED {
MoveBytes[dest: LOOPHOLE[block.base+block.startIndex+nBytesRead], src: LOOPHOLE[LOOPHOLE[@d.inBuffer, INT]+d.iBufStart], len: n];
};
d.iBufCnt ¬ d.iBufCnt - n;
d.iBufStart ¬ d.iBufStart + n;
block.count ¬ block.count - n;
nBytesRead ¬ nBytesRead + n;
ENDLOOP
};
MyClose: PROC [self: STREAM, abort: BOOL] = {
d: REF MyDataRec = NARROW[self.streamData];
IF d.closed THEN RETURN;
IF ~abort THEN SendNow[self];
d.closed ¬ TRUE;
[] ¬ UnixSysCalls.Close[d.socket];
};
MyFlush: PROC [d: REF MyDataRec] = TRUSTED {
addr: POINTER ¬ @d.outBuffer;
cnt: INT ¬ d.oBufCnt; d.oBufCnt ¬ 0;
WHILE cnt>0 DO
n: INT ¬ UnixSysCallsWrite[d.socket, LOOPHOLE[addr], cnt];
IF n<0 THEN ERROR;
cnt ¬ cnt-n; addr ¬ addr+n;
ENDLOOP
};
SendNow: PROC [self: STREAM] = {
d: REF MyDataRec = NARROW[self.streamData];
IF d.oBufCnt>0 THEN MyFlush[d];
};
NewUnixRefTrue: PROC [] RETURNS [UnixTypes.CHARPtr] = TRUSTED {
--ridiculously complex since I don't know which byte matters
RawBytes: TYPE = RECORD [PACKED SEQUENCE COMPUTED CARD OF BYTE];
boolTRUE: REF RawBytes ¬ NEW[RawBytes[4]];
FOR i: INT IN [0..3) DO
boolTRUE[i] ¬ LOOPHOLE[TRUE, BYTE];
ENDLOOP;
RETURN [LOOPHOLE[boolTRUE]]
};
Create: PROC [base: Rope.ROPE, port: REF ANY] RETURNS [sd: XCommunications.StreamData] = TRUSTED {
portNo: INT;
d: REF MyDataRec ¬ NEW[MyDataRec];
WITH port SELECT FROM
ri: REF INT => portNo ¬ ri­;
ENDCASE => {sd.errorMsg ¬ "bad port type"; GOTO Oops};
--create socket
d.socket ¬ UnixSysCalls.Socket[inet, stream, unspec];
IF LOOPHOLE[d.socket, INT]<0 THEN {sd.errorMsg ¬ "socket not created"; GOTO Oops};
--bind socket to name
d.server.sinFamily ¬ inet;
d.server.sinAddr ¬ GetArpaAddressFromName[base
! noArpaAddress => {sd.errorMsg ¬ why; GOTO Oops};
];
d.server.sinPort ¬ [Basics.HFromInt16[portNo]];
IF UnixSysCallExtensions.SetBlocking[d.socket, someData]=failure THEN {
sd.errorMsg ¬ "not connected: non blocking mode failed";
GOTO Oops
};
--connect socket with remote socket
IF UnixSysCalls.Connect[d.socket, LOOPHOLE[@d.server], BYTES[SockAddrIn]]#success THEN {
sd.errorMsg ¬ "not connected"; GOTO Oops
};
TRUSTED {
boolTRUE: UnixTypes.CHARPtr ¬ NewUnixRefTrue[];
tCPNODELAY: INT ¬ 1;
tCPProto: INT ¬ 6;
IF UnixSysCalls.SetSockOpt[d.socket, tCPProto, tCPNODELAY, LOOPHOLE[boolTRUE], 4] # success THEN {
[] ¬ UnixSysCalls.Close[d.socket];
sd.errorMsg ¬ "not connected: setting NoDelay failed";
GOTO Oops
};
};
--create stream
sd.in ¬ sd.out ¬ IO.CreateStream[streamProcs: myStreamProcs, streamData: d];
sd.success ¬ TRUE;
sd.errorFromStream ¬ ErrorFromStream;
d.myStream ¬ sd.in;
EXITS Oops => {}
};
ErrorFromStream: PROC [s: IO.STREAM] RETURNS [reason: Rope.ROPE] = {
reason ¬ "failure";
};
GetArpaAddressFromName: PROC [name: Rope.ROPE] RETURNS [address: Arpa.Address ¬ Arpa.nullAddress] = {
ypH: SunYPAgent.Handle; val: REF TEXT; tokens: SunYPAgent.TextSeq;
ypH ¬ SunYPAgent.ObtainHandle[
! SunYPAgent.Error => ERROR noArpaAddress[IO.PutFR["no yp handle: %g", IO.atom[code]]]
];
val ¬ YPMatchIgnoringCase[ypH, "hosts.byname", name
! SunYPAgent.Error => ERROR noArpaAddress[IO.PutFR["host not known : %g", IO.atom[code]]]
];
tokens ¬ SunYPAgent.Tokenize[val];
IF tokens.length < 1 THEN ERROR noArpaAddress["error in YP hosts map"];
address ¬ Convert.ArpaAddressFromRope[Rope.FromRefText[tokens[0]]];
SunYPAgent.ReleaseHandle[ypH];
};
YPMatchIgnoringCase: PROC [ypH: SunYPAgent.Handle, map: Rope.ROPE, key: Rope.ROPE]
RETURNS [val: REF TEXT] ~ {
Raises SunYPAgent.Error[$noMoreEntries] if not found.
tKey: Rope.ROPE; unchanged: BOOL;
{
ENABLE SunYPAgent.Error => CONTINUE;
val ¬ SunYPAgent.Match[ypH, map, key];
IF val # NIL THEN RETURN;
};
{
ENABLE SunYPAgent.Error => CONTINUE;
[tKey, unchanged] ¬ ToLowerRope[key];
IF NOT unchanged THEN val ¬ SunYPAgent.Match[ypH, map, tKey];
IF val # NIL THEN RETURN;
};
{
ENABLE SunYPAgent.Error => CONTINUE;
[tKey, unchanged] ¬ ToUpperRope[key];
IF NOT unchanged THEN val ¬ SunYPAgent.Match[ypH, map, tKey];
IF val # NIL THEN RETURN;
};
{
[tKey, val] ¬ SunYPAgent.First[ypH, map];
DO
IF Rope.Equal[tKey, key, FALSE] THEN RETURN;
[tKey, val] ¬ SunYPAgent.Next[ypH, map, tKey];
ENDLOOP;
};
};
ToLowerRope: PROC [in: Rope.ROPE] RETURNS [out: Rope.ROPE, wasLower: BOOL] ~ {
t: REF TEXT ¬ Rope.ToRefText[in];
wasLower ¬ TRUE;
FOR i: CARDINAL IN [0 .. t.length) DO
c: CHAR ~ t[i];
IF c IN ['A..'Z] THEN { wasLower ¬ FALSE; t[i] ¬ c + Ascii.caseOffset };
ENDLOOP;
out ¬ Rope.FromRefText[t];
};
ToUpperRope: PROC [in: Rope.ROPE] RETURNS [out: Rope.ROPE, wasUpper: BOOL] ~ {
t: REF TEXT ¬ Rope.ToRefText[in];
wasUpper ¬ TRUE;
FOR i: CARDINAL IN [0 .. t.length) DO
c: CHAR ~ t[i];
IF c IN ['a..'z] THEN { wasUpper ¬ FALSE; t[i] ¬ c - Ascii.caseOffset };
ENDLOOP;
out ¬ Rope.FromRefText[t];
};
XCommunications.RegisterCommunication[[create: Create, protocol: $TCP]];
END.