XSyntax10.Scn.FntSyntax10i.Scn.Fnt>aSyntax10b.Scn.Fnt   )Q#Courier10.Scn.FntMarkElemsAlloc O!Ya% O! O} Ow OOcbO a &O OOOfJ }O D*UO O ,#WOOW]O 10O RO  WOO H  OO O!O "O#O $O>%O&O H  'O (OH  )O*O +O ,O -O.O /O 0O91O DMODULE TCP; (* TCP Connections for Oberon for Windows -- MH 15.4.94 / 1.6.94 *) (* mh 13.2.95 TCP.ReadBytes: evtl. mehrere read Aufrufe, bis genug Daten gelesen. Experimental *) IMPORT SYSTEM, Kernel, Input, Console; CONST Done* = 0; NotDone* = 1; Timeout* = 2; LocalPortInUse* = 3; AnyAdr* = 0; AnyPort* = 0; DefaultTimeout = 5 * Input.TimeUnit; (* 5 sec *) ConnTabSize = 64; PFInet = 2; SockStream = 1; IPProtoTCP = 6; InvalidSocket = -1; SocketError = -1; ADDRINUSE = 10048; TIMEDOUT = 10060; INTR = 10004; SysNotReady = 10091; VerNotSupported = 10092; EInval = 10022; TYPE Connection* = POINTER TO ConnectionDesc; ConnectionDesc* = RECORD id-: LONGINT; winsock: LONGINT; END ; Listener* = POINTER TO ListenerDesc; ListenerDesc = RECORD winsock: LONGINT; END ; IpAdr* = LONGINT; WSAData = RECORD (* WSADATA *) wVersion, wHighVersion: INTEGER; szDescription: ARRAY 257 OF CHAR; szSystemStatus: ARRAY 129 OF CHAR; iMaxSockets, iMaxUdpDg: INTEGER; filler: LONGINT; END ; SockAddr = RECORD (* struct sockaddr_in *) family: INTEGER; port: INTEGER; internetAddr: LONGINT; zero: ARRAY 8 OF CHAR; END ; HookProcedure = PROCEDURE(): LONGINT; VAR WSAStartup: PROCEDURE (versionRequired: LONGINT; lpWSAData: LONGINT): LONGINT; WSACleanup: PROCEDURE; WSAGetLastError: PROCEDURE (): LONGINT; WSASetBlockingHook: PROCEDURE (proc: HookProcedure): HookProcedure; WSAUnhookBlockingHook: PROCEDURE; WSACancelBlockingCall: PROCEDURE(); inetaddr: PROCEDURE (str: LONGINT): LONGINT; gethostbyname: PROCEDURE (name: LONGINT): LONGINT; socket: PROCEDURE (af, type, protocol: LONGINT): LONGINT; connect: PROCEDURE (socket, name, namelen: LONGINT): LONGINT; bind: PROCEDURE (socket, name, namelen: LONGINT): LONGINT; listen: PROCEDURE (socket, backlog: LONGINT): LONGINT; accept: PROCEDURE (socket, addr, addrlen: LONGINT): LONGINT; recv: PROCEDURE (socket, bufaddr, buflen, flags: LONGINT): LONGINT; send: PROCEDURE (socket, bufaddr, buflen, flags: LONGINT): LONGINT; ioctlsocket: PROCEDURE (socket, cmd, argptr: LONGINT): LONGINT; select: PROCEDURE (dummy, read, write, except, timeout: LONGINT): LONGINT; closesocket: PROCEDURE (s: LONGINT): LONGINT; htons: PROCEDURE (x: INTEGER): INTEGER; htonl: PROCEDURE (x: LONGINT): LONGINT; ntohs: PROCEDURE (x: INTEGER): INTEGER; ntohl: PROCEDURE (x: LONGINT): LONGINT; gethostname: PROCEDURE (name: LONGINT; namelen: LONGINT): LONGINT; OldHook: HookProcedure; TimeOut: LONGINT; ConnTab: ARRAY ConnTabSize OF LONGINT; (* weak pointers to connections *) res-: INTEGER; PROCEDURE FreeConnTabEntry(): INTEGER; (* returns i: 0 <= i < ConnTabSize with ConnTab[i] = 0, or -1 *) VAR i: INTEGER; BEGIN i := 0; WHILE i < ConnTabSize DO IF ConnTab[i] = 0 THEN RETURN i END ; INC(i); END ; Kernel.GC; i := 0; WHILE i < ConnTabSize DO IF ConnTab[i] = 0 THEN RETURN i END ; INC(i); END ; RETURN -1 END FreeConnTabEntry; PROCEDURE ThisConn (id: LONGINT): INTEGER; VAR i: INTEGER; C: Connection; BEGIN WHILE i < ConnTabSize DO IF ConnTab[i] # 0 THEN C := SYSTEM.VAL(Connection, ConnTab[i]); IF C.id = id THEN RETURN i END END ; INC(i); END ; RETURN -1; END ThisConn; PROCEDURE TimeoutHook (): LONGINT; VAR res, EBX, ESI, EDI: LONGINT; BEGIN SYSTEM.GETREG(3, EBX); SYSTEM.GETREG(6, ESI); SYSTEM.GETREG(7, EDI); IF Input.Time() > TimeOut THEN WSACancelBlockingCall(); ELSIF OldHook # NIL THEN res := OldHook() ELSE res := 0 (* false *) END ; SYSTEM.PUTREG(3, EBX); SYSTEM.PUTREG(6, ESI); SYSTEM.PUTREG(7, EDI); RETURN res; END TimeoutHook; PROCEDURE Close* (L: Listener); VAR x: LONGINT; BEGIN x := closesocket(L.winsock); L.winsock := InvalidSocket; END Close; PROCEDURE ListenerFinalizer (L: SYSTEM.PTR); VAR x: LONGINT; BEGIN WITH L: Listener DO x := closesocket(L.winsock); L.winsock := InvalidSocket ELSE END END ListenerFinalizer; PROCEDURE Listen* (L: Listener; lport: INTEGER; radr: IpAdr; rport: INTEGER; VAR res: INTEGER); VAR x: LONGINT; sadr: SockAddr; BEGIN L.winsock := socket(PFInet, SockStream, IPProtoTCP); IF L.winsock = InvalidSocket THEN res := NotDone; ELSE ASSERT(lport # AnyPort); (* assign a local port number *) sadr.family := PFInet; sadr.port := htons(lport); sadr.internetAddr := AnyAdr; x := bind(L.winsock, SYSTEM.ADR(sadr), SIZE(SockAddr)); IF x # 0 THEN IF WSAGetLastError() = ADDRINUSE THEN res := LocalPortInUse ELSE res := NotDone END ; x := closesocket(L.winsock); RETURN END ; x := listen(L.winsock, 5); IF x # 0 THEN x := closesocket(L.winsock); res := NotDone; RETURN END ; END ; Kernel.RegisterObject(L, ListenerFinalizer); res := Done; END Listen; PROCEDURE Requested* (L: Listener): BOOLEAN; TYPE SocketSet = RECORD n: LONGINT; s: ARRAY 64 OF LONGINT END ; Timeout = RECORD sec, usec: LONGINT END ; VAR set: SocketSet; timeout: Timeout; x: LONGINT; BEGIN timeout.sec := 0; timeout.usec := 0; set.n := 1; set.s[0] := L.winsock; x := select(0, SYSTEM.ADR(set), 0, 0, SYSTEM.ADR(timeout)); IF x = SocketError THEN HALT(66) ELSE RETURN x > 0 END END Requested; PROCEDURE Disconnect* (C: Connection); VAR x: LONGINT; i: INTEGER; BEGIN x := closesocket(C.winsock); C.winsock := InvalidSocket; i := ThisConn(C.id); IF i >= 0 THEN ConnTab[i] := 0 END END Disconnect; PROCEDURE ConnectionFinalizer (C: SYSTEM.PTR); VAR x: LONGINT; i: INTEGER; BEGIN WITH C: Connection DO x := closesocket(C.winsock); C.winsock := InvalidSocket; i := ThisConn(C.id); IF i >= 0 THEN ConnTab[i] := 0 END ; ELSE END END ConnectionFinalizer; PROCEDURE Accept* (L: Listener; C: Connection; VAR res: INTEGER); VAR x: LONGINT; i: INTEGER; BEGIN C.winsock := accept(L.winsock, 0, 0); IF C.winsock = SocketError THEN res := NotDone; ELSE i := FreeConnTabEntry(); IF i < 0 THEN x := closesocket(C.winsock); C.winsock := InvalidSocket; res := NotDone; ELSE C.id := Input.Time(); ConnTab[i] := SYSTEM.VAL(LONGINT, C); Kernel.RegisterObject(C, ConnectionFinalizer); res := Done; END END ; END Accept; PROCEDURE Connect* (C: Connection; lport: INTEGER; Adr: IpAdr; rport: INTEGER; timeout: LONGINT; VAR res: INTEGER); (* timeout = 0 => default timeout *) VAR sadr: SockAddr; x, e: LONGINT; i: INTEGER; BEGIN res := Done; C.winsock := socket(PFInet, SockStream, IPProtoTCP); IF C.winsock = InvalidSocket THEN res := NotDone ELSE IF lport # AnyPort THEN (* assign a local port number *) sadr.family := PFInet; sadr.port := htons(lport); sadr.internetAddr := AnyAdr; x := bind(C.winsock, SYSTEM.ADR(sadr), SIZE(SockAddr)); IF x # 0 THEN x := WSAGetLastError(); IF x = ADDRINUSE THEN res := LocalPortInUse ELSE res := NotDone END ; x := closesocket(C.winsock); C.winsock := InvalidSocket; RETURN END END ; IF timeout <= 0 THEN timeout := DefaultTimeout END ; TimeOut := Input.Time() + timeout; sadr.family := PFInet; sadr.port := htons(rport); sadr.internetAddr := Adr; OldHook := WSASetBlockingHook(TimeoutHook); x := connect(C.winsock, SYSTEM.ADR(sadr), SIZE(SockAddr)); IF x # 0 THEN e := WSAGetLastError() END ; WSAUnhookBlockingHook; IF x # 0 THEN IF (e = TIMEDOUT) OR (e = INTR) THEN res := Timeout ELSE res := NotDone END ; x := closesocket(C.winsock); C.winsock := InvalidSocket; RETURN END ; i := FreeConnTabEntry(); IF i < 0 THEN x := closesocket(C.winsock); C.winsock := InvalidSocket; res := NotDone; RETURN; ELSE C.id := Input.Time(); ConnTab[i] := SYSTEM.VAL(LONGINT, C) END ; Kernel.RegisterObject(C, ConnectionFinalizer) END END Connect; PROCEDURE HostByName* (hostname: ARRAY OF CHAR; VAR adr: IpAdr; VAR res: INTEGER); (** res Done, NotDone, or Timeout **) TYPE hostent = POINTER TO RECORD (* struct hostent *) name, aliases: LONGINT; addrtype, length: INTEGER; adr: LONGINT; (*POINTER TO POINTER TO LONGINT*) END ; VAR host: hostent; e: LONGINT; BEGIN TimeOut := Input.Time() + DefaultTimeout; OldHook := WSASetBlockingHook(TimeoutHook); host := SYSTEM.VAL(hostent, gethostbyname(SYSTEM.ADR(hostname))); IF host # NIL THEN WSAUnhookBlockingHook; SYSTEM.GET(host.adr, adr); SYSTEM.GET(adr, adr); res := Done ELSE e := WSAGetLastError(); WSAUnhookBlockingHook; IF (e = TIMEDOUT) OR (e = INTR) THEN res := Timeout ELSE res := NotDone END ; adr := 0 END END HostByName; PROCEDURE HostByNumber* (number: ARRAY OF CHAR; VAR adr: IpAdr; VAR res: INTEGER); BEGIN adr := inetaddr(SYSTEM.ADR(number)); IF adr # 0 THEN res := Done ELSE res := NotDone END ; END HostByNumber; PROCEDURE GetHostName* (VAR s: ARRAY OF CHAR; VAR res: INTEGER); (** Returns the local hostname *) BEGIN res := SHORT(gethostname(SYSTEM.ADR(s[0]), LEN(s))) END GetHostName; PROCEDURE GetHostAddress* (VAR adr: IpAdr; VAR res: INTEGER); VAR name: ARRAY 128 OF CHAR; BEGIN GetHostName(name, res); HostByName(name, adr, res) END GetHostAddress; PROCEDURE ThisConnection* (id: LONGINT): Connection; VAR i: INTEGER; BEGIN i := ThisConn(id); IF i >= 0 THEN RETURN SYSTEM.VAL(Connection, ConnTab[i]) ELSE RETURN NIL END END ThisConnection; PROCEDURE Available* (C: Connection): LONGINT; (* number of bytes that can be read without blocking *) CONST FIONREAD = 4004667FH; VAR x, avail: LONGINT; BEGIN x := ioctlsocket(C.winsock, FIONREAD, SYSTEM.ADR(avail)); IF x # 0 THEN x := WSAGetLastError(); Console.Ln; Console.Str("Error in Available (ioctlsocket): "); Console.Int(x); HALT(44); END ; RETURN avail; END Available; PROCEDURE AvailToSend* (C: Connection): LONGINT; BEGIN RETURN MAX(LONGINT) END AvailToSend; PROCEDURE Connected* (C: Connection): BOOLEAN; (* can write to C *) CONST MsgPeek = 2; TYPE SocketSet = RECORD n: LONGINT; s: ARRAY 64 OF LONGINT END ; Timeout = RECORD sec, usec: LONGINT END ; VAR set: SocketSet; timeout: Timeout; x: LONGINT; ch: CHAR; BEGIN IF C.winsock # InvalidSocket THEN timeout.sec := 0; timeout.usec := 0; set.n := 1; set.s[0] := C.winsock; x := select(0, SYSTEM.ADR(set), 0, 0, SYSTEM.ADR(timeout)); IF x = SocketError THEN HALT(99) ELSE IF x = 1 THEN RETURN recv(C.winsock, SYSTEM.ADR(ch), 1, MsgPeek) = 1; ELSE RETURN TRUE END END ELSE RETURN FALSE END END Connected; (* --------------------- read procedures --------------- *) (* all Read* procedures are blocking, res = Done if connection is alive, NotDone otherwise *) PROCEDURE Read* (C: Connection; VAR x: SYSTEM.BYTE); VAR n: LONGINT; BEGIN n := recv(C.winsock, SYSTEM.ADR(x), 1, 0); IF n > 0 THEN res := Done ELSE res := NotDone END END Read; PROCEDURE ReadBytes* (C: Connection; VAR x: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT); (** receive bytes x[beg] .. x[beg+len]; Precodition: (beg >= 0) AND (beg+len <= LEN(x)) **) VAR n, adr, total: LONGINT; BEGIN ASSERT((beg >= 0) & (LEN(x) >= beg+len)); adr := SYSTEM.ADR(x) + beg; total := 0; n := 1; WHILE (total < len) & (n # 0) DO IF Available(C) < len - total THEN n := 0 ELSE n := recv(C.winsock, adr, len - total, 0); END ; INC(total, n); INC(adr, n); END ; IF total < len THEN res := NotDone ELSE res := Done END END ReadBytes; PROCEDURE ReadInt* (C: Connection; VAR x: INTEGER); VAR n: LONGINT; nx: INTEGER; BEGIN n := recv(C.winsock, SYSTEM.ADR(nx), 2, 0); IF n = 2 THEN res := Done; x := ntohs(nx) ELSE res := NotDone END END ReadInt; PROCEDURE ReadLInt* (C: Connection; VAR x: LONGINT); VAR nx, n: LONGINT; BEGIN n := recv(C.winsock, SYSTEM.ADR(nx), 4, 0); IF n = 4 THEN res := Done; x := ntohl(nx) ELSE res := NotDone END END ReadLInt; PROCEDURE ReadReal* (C: Connection; VAR r: REAL); VAR n: LONGINT; BEGIN n := recv(C.winsock, SYSTEM.ADR(r), 4, 0); IF n = 4 THEN res := Done ELSE res := NotDone END END ReadReal; PROCEDURE ReadLReal* (C: Connection; VAR r: LONGREAL); VAR n: LONGINT; BEGIN n := recv(C.winsock, SYSTEM.ADR(r), 8, 0); IF n = 8 THEN res := Done ELSE res := NotDone END END ReadLReal; PROCEDURE ReadSet* (C: Connection; VAR s: SET); VAR n: LONGINT; BEGIN n := recv(C.winsock, SYSTEM.ADR(s), 4, 0); IF n = 4 THEN res := Done ELSE res := NotDone END END ReadSet; PROCEDURE ReadString* (C: Connection; VAR s: ARRAY OF CHAR); VAR n: LONGINT; i: INTEGER; ch: CHAR; BEGIN i := 0; res := Done; REPEAT n := recv(C.winsock, SYSTEM.ADR(ch), 1, 0); IF n # 1 THEN res := NotDone END ; s[i] := ch; INC(i) UNTIL (ch = 0X) OR (res = NotDone) END ReadString; PROCEDURE ReadBool* (C: Connection; VAR b: BOOLEAN); VAR n: LONGINT; BEGIN n := recv(C.winsock, SYSTEM.ADR(b), 1, 0); IF n = 1 THEN res := Done ELSE res := NotDone END END ReadBool; (* --------------------- write procedures --------------- *) (* Blocking, res = Done if connection is alive, NotDone otherwise *) PROCEDURE Write* (C: Connection; x: SYSTEM.BYTE); VAR n: LONGINT; BEGIN n := send(C.winsock, SYSTEM.ADR(x), 1, 0); IF n = 1 THEN res := Done ELSE res := NotDone END END Write; PROCEDURE WriteBytes* (C: Connection; VAR x: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT); (** send bytes x[beg] .. x[beg+len]; Precodition: (beg >= 0) AND (beg+len <= LEN(x)) **) VAR n: LONGINT; BEGIN ASSERT((beg >= 0) & (LEN(x) >= beg + len)); n := send(C.winsock, SYSTEM.ADR(x)+beg, len, 0); IF n = len THEN res := Done ELSE res := NotDone END END WriteBytes; PROCEDURE WriteUrgent* (C: Connection; x: SYSTEM.BYTE); VAR n: LONGINT; BEGIN n := send(C.winsock, SYSTEM.ADR(x), 1, 1); IF n = 1 THEN res := Done ELSE res := NotDone END END WriteUrgent; PROCEDURE WriteBytesUrgent* (C: Connection; VAR x: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT); (** send bytes x[beg] .. x[beg+len]; Precodition: (beg >= 0) AND (beg+len <= LEN(x)) **) VAR n: LONGINT; BEGIN ASSERT((beg >= 0) & (LEN(x) >= beg + len)); n := send(C.winsock, SYSTEM.ADR(x)+beg, len, 1); IF n = len THEN res := Done ELSE res := NotDone END END WriteBytesUrgent; PROCEDURE WriteInt* (C: Connection; x: INTEGER); VAR nx: INTEGER; n: LONGINT; BEGIN nx := htons(x); n := send(C.winsock, SYSTEM.ADR(nx), 2, 0); IF n = 2 THEN res := Done ELSE res := NotDone END END WriteInt; PROCEDURE WriteLInt* (C: Connection; x: LONGINT); VAR nx, n: LONGINT; BEGIN nx := htonl(x); n := send(C.winsock, SYSTEM.ADR(nx), 4, 0); IF n = 4 THEN res := Done ELSE res := NotDone END END WriteLInt; PROCEDURE WriteReal* (C: Connection; r: REAL); VAR n: LONGINT; BEGIN n := send(C.winsock, SYSTEM.ADR(r), 4, 0); IF n = 4 THEN res := Done ELSE res := NotDone END END WriteReal; PROCEDURE WriteLReal* (C: Connection; r: LONGREAL); VAR n: LONGINT; BEGIN n := send(C.winsock, SYSTEM.ADR(r), 8, 0); IF n = 8 THEN res := Done ELSE res := NotDone END END WriteLReal; PROCEDURE WriteSet* (C: Connection; s: SET); VAR n: LONGINT; BEGIN n := send(C.winsock, SYSTEM.ADR(s), 4, 0); IF n = 4 THEN res := Done ELSE res := NotDone END END WriteSet; PROCEDURE WriteString* (C: Connection; s: ARRAY OF CHAR); VAR n, len: LONGINT; BEGIN len := 0; WHILE s[len] # 0X DO INC(len) END ; n := send(C.winsock, SYSTEM.ADR(s), len+1, 0); IF n = len+1 THEN res := Done ELSE res := NotDone END END WriteString; PROCEDURE WriteBool* (C: Connection; b: BOOLEAN); VAR n: LONGINT; BEGIN n := send(C.winsock, SYSTEM.ADR(b), 1, 0); IF n = 1 THEN res := Done ELSE res := NotDone END END WriteBool; (* ----------- initialization and finalization ------------- *) PROCEDURE Terminate; BEGIN WSACleanup(); END Terminate; PROCEDURE Init; VAR mod, res: LONGINT; data: WSAData; err: ARRAY 32 OF CHAR; i: INTEGER; BEGIN mod := Kernel.LoadLibrary("WSOCK32"); IF mod # 0 THEN Kernel.GetAdr(mod, "WSAStartup", SYSTEM.VAL(LONGINT, WSAStartup)); Kernel.GetAdr(mod, "WSACleanup", SYSTEM.VAL(LONGINT, WSACleanup)); Kernel.GetAdr(mod, "WSAGetLastError", SYSTEM.VAL(LONGINT, WSAGetLastError)); Kernel.GetAdr(mod, "WSASetBlockingHook", SYSTEM.VAL(LONGINT, WSASetBlockingHook)); Kernel.GetAdr(mod, "WSAUnhookBlockingHook", SYSTEM.VAL(LONGINT, WSAUnhookBlockingHook)); Kernel.GetAdr(mod, "WSACancelBlockingCall", SYSTEM.VAL(LONGINT, WSACancelBlockingCall)); Kernel.GetAdr(mod, "inet_addr", SYSTEM.VAL(LONGINT, inetaddr)); Kernel.GetAdr(mod, "gethostbyname", SYSTEM.VAL(LONGINT, gethostbyname)); Kernel.GetAdr(mod, "socket", SYSTEM.VAL(LONGINT, socket)); Kernel.GetAdr(mod, "connect", SYSTEM.VAL(LONGINT, connect)); Kernel.GetAdr(mod, "bind", SYSTEM.VAL(LONGINT, bind)); Kernel.GetAdr(mod, "listen", SYSTEM.VAL(LONGINT, listen)); Kernel.GetAdr(mod, "accept", SYSTEM.VAL(LONGINT, accept)); Kernel.GetAdr(mod, "select", SYSTEM.VAL(LONGINT, select)); Kernel.GetAdr(mod, "recv", SYSTEM.VAL(LONGINT, recv)); Kernel.GetAdr(mod, "send", SYSTEM.VAL(LONGINT, send)); Kernel.GetAdr(mod, "ioctlsocket", SYSTEM.VAL(LONGINT, ioctlsocket)); Kernel.GetAdr(mod, "closesocket", SYSTEM.VAL(LONGINT, closesocket)); Kernel.GetAdr(mod, "htons", SYSTEM.VAL(LONGINT, htons)); Kernel.GetAdr(mod, "htonl", SYSTEM.VAL(LONGINT, htonl)); Kernel.GetAdr(mod, "ntohs", SYSTEM.VAL(LONGINT, ntohs)); Kernel.GetAdr(mod, "ntohl", SYSTEM.VAL(LONGINT, ntohl)); Kernel.GetAdr(mod, "gethostname", SYSTEM.VAL(LONGINT, gethostname)); res := WSAStartup(101H, SYSTEM.ADR(data)); IF res # 0 THEN CASE res OF SysNotReady: err := "Network subsystem not ready"; | VerNotSupported, EInval: err := "sockets ver 1.1 not available"; ELSE END ; HALT(99); ELSE Kernel.InstallTermHandler(Terminate); END ; FOR i := 0 TO ConnTabSize - 1 DO ConnTab[i] := 0 END ; END ; res := Done END Init; BEGIN Init END TCP.