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; --C-- PortNumber: TYPE = MACHINE DEPENDENT RECORD [val: Basics.HWORD]; --C-- SockAddrIn: TYPE = WORD16 MACHINE DEPENDENT RECORD [ --see chapter 8.7, page 203 ... 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; 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 { 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}; d.socket ¬ UnixSysCalls.Socket[inet, stream, unspec]; IF LOOPHOLE[d.socket, INT]<0 THEN {sd.errorMsg ¬ "socket not created"; GOTO Oops}; 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 }; 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 }; }; 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] ~ { 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. „ 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 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 --copy to prevent even competing processes from writing memory outside buffer --ridiculously complex since I don't know which byte matters --create socket --bind socket to name --connect socket with remote socket --create stream Raises SunYPAgent.Error[$noMoreEntries] if not found. Κc–(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ Οeœ=™HKšœ9™9Kšœ,™,—K˜šΟk œ˜ KšœŠžœ˜•K˜—šΟnœžœžœ˜(KšžœžœJ˜e—šž˜K˜—Kšžœžœžœžœ˜™K™K™K™"K™/—K˜Kš Οcœ žœžœž œžœžœ˜FK˜š  œ žœžœž œžœ˜;Kš .˜.Kšœ&˜&Kšœ˜Kšœž˜Kšœ žœžœžœž˜$K˜K˜—šŸ œžœžœžœžœžœž œžœžœ˜]Kšœ˜K˜K˜—šŸœžœ>žœžœžœžœžœžœ˜€Kšœ ˜ Kšœ˜—K˜Kšœžœ žœžœ˜-K˜Kšœ žœ˜Kšœ žœ ˜K˜– "cedar" stylešœžœžœžœ˜9K– "cedar" stylešœ˜K– "cedar" stylešœ!˜!K– "cedar" stylešœ˜K– "cedar" stylešœ˜K– "cedar" stylešœ!˜!K– "cedar" stylešœ˜K– "cedar" stylešœ!˜!K– "cedar" stylešœ˜K– "cedar" stylešœ˜K– "cedar" stylešœ˜—K– "cedar" style˜šœ žœž œžœ˜$Kšœžœ˜Kšœžœžœ˜Kšœ žœ˜Kšœ žœ˜Kšœ žœ˜Kšœ˜Kš œ žœžœžœžœ ˜OKš œ žœžœžœžœ˜0Kšœ žœžœžœ ˜4Kšœ˜—K˜š Ÿœžœžœžœžœ˜/Kšžœžœ˜Kšœ˜—K˜šŸ œžœžœžœ˜.Kšœžœ žœ˜+K– "cedar" stylešžœ žœžœžœ˜4Kšœ˜Kšœ˜Kšžœžœ ˜*Kšœ˜—K– "cedar" style˜– "cedar" stylešŸœžœžœžœ˜LKšœžœ žœ˜+K– "cedar" stylešžœ žœžœžœ˜4šž˜– "cedar" stylešœžœ˜K– "cedar" styleš N™N—Kšœžœžœ ˜.Kšœ?˜?Kšœ˜Kšœ*˜*Kšœ ˜ Kšžœžœ žœž˜*Kšžœ˜—Kšžœžœ ˜*K– "cedar" stylešœ˜K– "cedar" style˜—– "cedar" stylešŸœžœžœžœ˜-K– "cedar" stylešžœ žœžœ˜K– "cedar" stylešžœ žœžœžœ!˜:– "cedar" stylešž˜Icode2šœžœžœ˜ILšžœžœ"žœ˜5Lšžœžœžœžœ˜-Lšžœ˜—K– "cedar" style˜—K– "cedar" style˜– "cedar" styleš Ÿ œžœžœžœžœ˜5Kšœžœ žœ˜+Kšžœžœ ˜!Kšœ˜Kšœ˜Kšœ˜K– "cedar" style˜—K– "cedar" style˜– "cedar" styleš Ÿœžœžœžœžœžœ ˜iKšœžœ˜Kšœžœ žœ˜+K– "cedar" stylešžœ žœžœžœ˜4– "cedar" stylešžœž˜Lšžœžœ ˜!Lšœžœ˜ šžœ˜ Lš œžœ/žœžœžœ˜L˜—Lšœ˜Lšœ˜Lšœ˜Lšœ˜Lšž˜—K– "cedar" style˜K– "cedar" style˜—– "cedar" stylešŸœžœžœ žœ˜-Kšœžœ žœ˜+K– "cedar" stylešžœ žœžœ˜K– "cedar" stylešžœžœ˜Kšœ žœ˜Kšœ"˜"K– "cedar" stylešœ˜—K˜šŸœžœžœžœ˜,Kšœžœ˜Kšœžœ˜$šžœž˜Kšœžœžœ ˜:Kšžœžœžœ˜Kšœ˜Kšž˜—K˜—K˜šŸœžœžœ˜ Kšœžœ žœ˜+Kšžœ žœ ˜Kšœ˜—K˜šŸœžœžœžœ˜?Jš <™