TextDocs.NewDocgCWindowsLeftWindowsTop ColorFlatLockedControlsOrgsBIER3Oberon10.Scn.FntSyntax10.Scn.Fnt[5$'&5k9(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *) MODULE NetSystem; (** portable, except where noted / source: Win32.NetSystem.Mod *) (* ejz *) IMPORT SYSTEM, Kernel, Kernel32, Modules, Threads, User32, WSock32, Input, Fonts, Texts, Oberon, Display, Display3, Strings, (* Registry,*) AosConfiguration, Displays, Windows; (** A Portable Oberon Interface to InterNet Protocols *) CONST WMGetHostInfo = User32.WMUser+10; WMConnect = User32.WMUser+11; ConnTabSize = 64; IPCacheSize = 8; SendBufSize = 1460; RecBufSize = 1460; RecBufLimit = 1400; IPAdrLen = 4; HostNameLen = 64; MaxAccept = 5; anyport* = 0; (** any port value *) (** result values *) done* = 0; (** everything went ok *) error* = 1; (** failure occured *) (* timeout* = 2; (* opening a connection is timed out *) *) (** return values of procedure State *) (* undef* = -1; (* unknown state *) *) closed* = 0; (** connection is closed (neither sending nor receiving) *) listening* = 1; (** passive connection is listening for a request *) in* = 2; (** receiving only *) out* = 3; (** sending only *) inout* = 4; (** sending and receiving is possible *) waitCon* = 5; (** still waiting to be connected *) errorCon* = 6; (** connecting failed *) TYPE Connection* = POINTER TO RECORD (** handle for TCP connections *) sock: WSock32.Socket; event: Threads.Event; nr, req: LONGINT; sendBuf: ARRAY SendBufSize OF CHAR; (* send buffer *) sendBufEnd: LONGINT; recBuf: ARRAY RecBufSize OF CHAR; (* receive buffer *) recBufPos, recBufEnd: LONGINT; state, res*: INTEGER (** result of last operation on a connection (error indication) *) END; IPAdr* = LONGINT; (** IP address in network byte order *) HostInfo = POINTER TO RECORD (* handle for asyncrouns GetIP and GetName *) handle: Kernel32.HANDLE; event: Threads.Event; ip: IPAdr; (* the ip-number of host name *) name: ARRAY HostNameLen OF CHAR; (* the host name for ip-number *) err, getip: BOOLEAN; (* indicating success or failure *) next: HostInfo; hostentBuf: ARRAY WSock32.MAXGETHOSTSTRUCT OF CHAR END; Socket* = POINTER TO RECORD (** handle for UDP "connections" *) sock: WSock32.Socket; res*: INTEGER (** result of last operation on a connection (error indication) *) END; Password = POINTER TO RECORD service, user, host, passwd: ARRAY HostNameLen OF CHAR; next: Password END; VAR ConnTab: ARRAY ConnTabSize OF LONGINT; GetIPTimeOut, GetNameTimeOut, OpenConnectionTimeOut, SendTimeOut, ReceiveTimeOut: LONGINT; IPCache: ARRAY IPCacheSize OF RECORD host: ARRAY HostNameLen OF CHAR; ip: IPAdr END; curIP: LONGINT; hostInfos: HostInfo; passwords: Password; tcpMtx: Threads.Mutex; W: Texts.Writer; ready: BOOLEAN; anyIP*, (** "NIL" ip-number *) allIP*, (** broadcast ip-number *) hostIP*: IPAdr; (** ip-number of local machine *) hostName*: ARRAY HostNameLen OF CHAR; (** name of local machine *) PROCEDURE FindConnection(sock: LONGINT): Connection; VAR i: LONGINT; C: Connection; BEGIN FOR i := 0 TO ConnTabSize-1 DO C := SYSTEM.VAL(Connection, ConnTab[i]); IF (C # NIL) & (C.sock = sock) THEN RETURN C END END; RETURN NIL END FindConnection; PROCEDURE *ConnectionFinalizer(C: PTR); BEGIN WITH C: Connection DO IF C.sock # WSock32.InvalidSocket THEN WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, 0, 0); WSock32.closesocket(C.sock); C.sock := WSock32.InvalidSocket END; IF C.nr < ConnTabSize THEN ConnTab[C.nr] := SYSTEM.VAL(LONGINT, NIL); C.nr := ConnTabSize END END END ConnectionFinalizer; PROCEDURE stop(); VAR i: LONGINT; C: Connection; BEGIN IF ready THEN ready := FALSE; hostInfos := NIL; FOR i := 0 TO ConnTabSize-1 DO C := SYSTEM.VAL(Connection, ConnTab[i]); IF C # NIL THEN ConnectionFinalizer(C); C.state := closed END END; tcpMtx := NIL END; WSock32.WSACleanup() END stop; PROCEDURE [WINAPI] *WindowHandler(win: Windows.Window; uMsg: LONGINT; wParam: User32.WParam; lParam: User32.LParam): User32.LResult; VAR res, err, event, i: LONGINT; adr: Kernel32.ADDRESS; C: Connection; P, H: HostInfo; ch: CHAR; BEGIN res := 0; IF uMsg = WMConnect THEN err := SYSTEM.LSH(lParam, -16); event := lParam MOD ASH(1, 16); C := FindConnection(wParam); IF C # NIL THEN CASE event OF WSock32.FDWrite: IF err = 0 THEN IF C.state IN {in, waitCon} THEN C.state := inout ELSIF ~(C.state IN {inout, closed}) THEN C.state := out END END |WSock32.FDAccept: IF err = 0 THEN INC(C.req) END |WSock32.FDConnect: IF err # 0 THEN ConnectionFinalizer(C); C.state := errorCon ELSE C.state := inout END |WSock32.FDClose: C.state := closed; C.req := 0 |WSock32.FDRead: IF err = 0 THEN IF C.state IN {out, waitCon} THEN C.state := inout ELSIF ~(C.state IN {inout, closed}) THEN C.state := in END END ELSE END; Threads.Set(C.event) ELSE END ELSIF uMsg = WMGetHostInfo THEN err := SYSTEM.LSH(lParam, -16); Threads.Lock(tcpMtx); P := NIL; H := hostInfos; WHILE (H # NIL) & (H.handle # wParam) DO P := H; H := H.next END; Threads.Unlock(tcpMtx); IF H # NIL THEN IF err = 0 THEN IF H.getip THEN SYSTEM.GET(SYSTEM.ADR(H.hostentBuf)+12, adr); SYSTEM.GET(adr, adr); SYSTEM.GET(adr, adr); SYSTEM.MOVE(SYSTEM.ADR(adr), SYSTEM.ADR(H.ip), IPAdrLen); curIP := (curIP+1) MOD IPCacheSize; COPY(H.name, IPCache[curIP].host); IPCache[curIP].ip := H.ip ELSE SYSTEM.GET(SYSTEM.ADR(H.hostentBuf), adr); i := 0; SYSTEM.GET(adr, ch); INC(adr); WHILE (ch # 0X) & (i < (HostNameLen-1)) DO H.name[i] := ch; INC(i); SYSTEM.GET(adr, ch); INC(adr) END; H.name[i] := 0X; Strings.Lower(H.name, H.name) END; Threads.Lock(tcpMtx); IF P # NIL THEN P.next := H.next ELSE hostInfos := H.next END; Threads.Unlock(tcpMtx) END; H.err := (err # 0); Threads.Set(H.event) END ELSIF (uMsg = User32.WMClose) & (win = Windows.dummyWin) THEN stop() END; RETURN res END WindowHandler; (** -- Adressing/Naming section. *) (** Convert a dotted IP address string (e.g. "1.2.3.4") to an IPAdr value. *) PROCEDURE ToHost*(num: ARRAY OF CHAR; VAR adr: IPAdr; VAR done: BOOLEAN); VAR i, j, n: LONGINT; BEGIN done := TRUE; i := 0; j := 0; adr := 0; WHILE done & (j < 4) & (num[i] # 0X) DO n := 0; WHILE (num[i] >= "0") & (num[i] <= "9") & (n < 256) DO n := n * 10 + ORD(num[i]) - ORD("0"); INC(i) END; IF num[i] = "." THEN INC(i) END; adr := adr*256+n; done := done & (n <= 256); INC(j) END; adr := WSock32.htonl(adr); done := done & (j = 4) & (num[i] = 0X) END ToHost; (** Convert an IPAdr value to a dotted IP address string *) PROCEDURE ToNum*(adr: IPAdr; VAR num: ARRAY OF CHAR); VAR i, j, n: LONGINT; PROCEDURE Digit(d: LONGINT); BEGIN num[j] := CHR(ORD("0")+d); INC(j) END Digit; BEGIN j := 0; FOR i := 0 TO 3 DO n := adr MOD 256; adr := adr DIV 256; IF n >= 100 THEN Digit(n DIV 100); Digit((n DIV 10) MOD 10) ELSIF n >= 10 THEN Digit(n DIV 10) END; Digit(n MOD 10); num[j] := "."; INC(j) END; num[j-1] := 0X END ToNum; (* Procedure delivers the ip-number of a named host. If a symbolic name is given, it will be resolved by use of domain name servers. *) PROCEDURE AsyncGetIP(VAR hostInfo: HostInfo; name: ARRAY OF CHAR); (** non-portable *) VAR i: LONGINT; BEGIN hostInfo := NIL; NEW(hostInfo); Strings.Lower(name, name); NEW(hostInfo.event); Threads.Create(hostInfo.event); hostInfo.getip := TRUE; hostInfo.next := NIL; COPY(name, hostInfo.name); hostInfo.err := TRUE; hostInfo.handle := 0; Threads.Lock(tcpMtx); FOR i := 0 TO IPCacheSize-1 DO IF IPCache[i].host = name THEN hostInfo.ip := IPCache[i].ip; hostInfo.err := FALSE; curIP := i; Threads.Set(hostInfo.event); Threads.Unlock(tcpMtx); RETURN END END; IF (name[0] >= "0") & (name[0] <= "9") THEN ToHost(name, hostInfo.ip, hostInfo.err); hostInfo.err := ~hostInfo.err; Threads.Set(hostInfo.event) ELSE hostInfo.handle := WSock32.WSAAsyncGetHostByName(Windows.dummyWin.hWnd, WMGetHostInfo, hostInfo.name, hostInfo.hostentBuf, WSock32.MAXGETHOSTSTRUCT); IF hostInfo.handle # 0 THEN hostInfo.next := hostInfos; hostInfos := hostInfo ELSE Threads.Set(hostInfo.event) END END; Threads.Unlock(tcpMtx) END AsyncGetIP; (** Procedure delivers the ip-number of a named host. If a symbolic name is given, it will be resolved by use of domain name servers. *) PROCEDURE GetIP*(name: ARRAY OF CHAR; VAR IP: IPAdr); VAR hostInfo: HostInfo; BEGIN IP := anyIP; IF ready THEN AsyncGetIP(hostInfo, name); IF (hostInfo # NIL) & Threads.Wait(hostInfo.event, GetIPTimeOut) & ~hostInfo.err THEN IP := hostInfo.ip END END; END GetIP; (* GetName is the reverse of GetIP. Given an ip-number, it delivers the name of a host. *) PROCEDURE AsyncGetName(VAR hostInfo: HostInfo; IP: IPAdr); (** non-portable *) BEGIN hostInfo := NIL; NEW(hostInfo); NEW(hostInfo.event); Threads.Create(hostInfo.event); hostInfo.getip := FALSE; hostInfo.next := NIL; SYSTEM.MOVE(SYSTEM.ADR(IP), SYSTEM.ADR(hostInfo.ip), IPAdrLen); hostInfo.err := TRUE; hostInfo.handle := 0; Threads.Lock(tcpMtx); hostInfo.handle := WSock32.WSAAsyncGetHostByAddr(Windows.dummyWin.hWnd, WMGetHostInfo, hostInfo.ip, IPAdrLen, WSock32.PFINet, hostInfo.hostentBuf, WSock32.MAXGETHOSTSTRUCT); IF hostInfo.handle # Kernel32.InvalidHandleValue THEN hostInfo.next := hostInfos; hostInfos := hostInfo ELSE Threads.Set(hostInfo.event) END; Threads.Unlock(tcpMtx) END AsyncGetName; (** GetName is the reverse of GetIP. Given an ip-number, it delivers the name of a host. *) PROCEDURE GetName*(IP: IPAdr; VAR name: ARRAY OF CHAR); VAR hostInfo: HostInfo; BEGIN COPY("", name); IF ready THEN AsyncGetName(hostInfo, IP); IF (hostInfo # NIL) & Threads.Wait(hostInfo.event, GetNameTimeOut) & ~hostInfo.err THEN COPY(hostInfo.name, name) END END; END GetName; PROCEDURE FreeConnTabEntry(): LONGINT; VAR i: LONGINT; firstTry: BOOLEAN; BEGIN firstTry := TRUE; LOOP i := 0; WHILE i < ConnTabSize DO IF ConnTab[i] = SYSTEM.VAL(LONGINT, NIL) THEN RETURN i END; INC(i) END; IF firstTry THEN firstTry := FALSE; Kernel.GC() ELSE Threads.Unlock(tcpMtx); HALT(99) END END END FreeConnTabEntry; PROCEDURE OpenConn(VAR C: Connection; locPort: INTEGER; remIP: IPAdr; remPort: INTEGER; VAR res: INTEGER); VAR sadr: WSock32.SockAddrIN; ret, err: LONGINT; BEGIN res := error; C := NIL; IF ~ready THEN RETURN END; Threads.Lock(tcpMtx); IF remPort = anyport THEN IF locPort # anyport THEN ret := FreeConnTabEntry(); NEW(C); C.nr := ret; NEW(C.event); Threads.Create(C.event); C.res := error; C.sock := WSock32.socket(WSock32.PFINet, WSock32.SockStream, WSock32.IPProtoTCP); IF C.sock # WSock32.InvalidSocket THEN IF FindConnection(C.sock) # NIL THEN Threads.Unlock(tcpMtx); HALT(99) END; sadr.sinFamily := WSock32.PFINet; sadr.sinPort := WSock32.htons(locPort); sadr.sinAddr := 0; ret := WSock32.bind(C.sock, sadr, SIZE(WSock32.SockAddrIN)); IF ret # 0 THEN ConnectionFinalizer(C) ELSE C.state := waitCon; C.req := 0; ConnTab[C.nr] := SYSTEM.VAL(LONGINT, C); ret := WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDAccept); IF ret = 0 THEN ret := WSock32.listen(C.sock, MaxAccept); IF ret # 0 THEN err := WSock32.WSAGetLastError() END; IF (ret = 0) OR (err = WSock32.WSAEWouldBlock) THEN Kernel.RegisterObject(C, ConnectionFinalizer, FALSE); C.state := listening; res := done END; Threads.Set(C.event) END END END END ELSE ret := FreeConnTabEntry(); NEW(C); C.nr := ret; NEW(C.event); Threads.Create(C.event); C.res := error; C.sock := WSock32.socket(WSock32.PFINet, WSock32.SockStream, WSock32.IPProtoTCP); IF C.sock # WSock32.InvalidSocket THEN IF FindConnection(C.sock) # NIL THEN Threads.Unlock(tcpMtx); HALT(99) END; IF locPort # anyport THEN sadr.sinFamily := WSock32.PFINet; sadr.sinPort := WSock32.htons(locPort); sadr.sinAddr := 0; ret := WSock32.bind(C.sock, sadr, SIZE(WSock32.SockAddrIN)); IF ret # 0 THEN ConnectionFinalizer(C) END END; IF C.sock # WSock32.InvalidSocket THEN C.state := waitCon; C.req := 0; ConnTab[C.nr] := SYSTEM.VAL(LONGINT, C); ret := WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDConnect+WSock32.FDRead+WSock32.FDWrite+WSock32.FDClose); IF ret = 0 THEN sadr.sinFamily := WSock32.PFINet; sadr.sinPort := WSock32.htons(remPort); SYSTEM.MOVE(SYSTEM.ADR(remIP), SYSTEM.ADR(sadr.sinAddr), IPAdrLen); ret := WSock32.connect(C.sock, sadr, SIZE(WSock32.SockAddrIN)); IF ret # 0 THEN err := WSock32.WSAGetLastError() END; IF (ret = 0) OR (err = WSock32.WSAEWouldBlock) THEN ret := WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDConnect+WSock32.FDRead+WSock32.FDWrite+WSock32.FDClose); IF ret = 0 THEN Kernel.RegisterObject(C, ConnectionFinalizer, FALSE); res := done END END END END END END; Threads.Unlock(tcpMtx); IF C # NIL THEN IF res = done THEN C.sendBufEnd := 0; C.recBufPos := 0; C.recBufEnd := 0; C.res := done ELSE ConnectionFinalizer(C); C := NIL END END END OpenConn; (** -- TCP section. *) (* Stream oriented communication *) (** Procedure opens a connection. locPort, remPort, remIP are contained in the quadrupel which determines a connection uniquely. As locIP is always the current machine, it is omitted. If remPort is equal to anyport or remIP is equal to anyIP, a passive connection will be opened. After execution, C is a brand new connection. res indicates any error. *) PROCEDURE OpenConnection*(VAR C: Connection; locPort: INTEGER; remIP: IPAdr; remPort: INTEGER; VAR res: INTEGER); VAR ok: BOOLEAN; BEGIN OpenConn(C, locPort, remIP, remPort, res); IF res = done THEN IF C.res = done THEN ok := Threads.Wait(C.event, OpenConnectionTimeOut) END; IF C.state IN {in, out, inout, listening, closed} THEN res := done ELSE res := error; C := NIL END END END OpenConnection; (** Like OpenConnection, but this procedure may return immediately and delay the actual opening of the connection. In this case State() should be checked to wait for the connection status to change from waitCon. *) PROCEDURE AsyncOpenConnection*(VAR C: Connection; locPort: INTEGER; remIP: IPAdr; remPort: INTEGER; VAR res: INTEGER); BEGIN OpenConn(C, locPort, remIP, remPort, res) END AsyncOpenConnection; PROCEDURE FlushSendBuffer(C: Connection); VAR ret, err, beg: LONGINT; BEGIN beg := 0; WHILE (C.sendBufEnd > beg) & (C.res = done) DO ret := WSock32.send(C.sock, C.sendBuf[beg], C.sendBufEnd-beg, 0); IF ret <= 0 THEN err := WSock32.WSAGetLastError(); IF err # WSock32.WSAEWouldBlock THEN Kernel32.Str("FlushSendBuffer error "); Kernel32.Int(err); Kernel32.Ln(); IF (err = WSock32.WSAEInval) OR (err = WSock32.WSAEConnAborted) OR (err = WSock32.WSAEConnReset) THEN C.state := closed; C.sendBufEnd := 0 END; C.res := error ELSE WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDRead+WSock32.FDWrite+WSock32.FDClose); IF ~Threads.Wait(C.event, SendTimeOut) THEN C.res := error END END ELSE INC(beg, ret) END END; IF C.sendBufEnd = beg THEN C.sendBufEnd := 0 END END FlushSendBuffer; (** Procedure closes the connection. Connection can not be used for send operations afterwards. *) PROCEDURE CloseConnection*(C: Connection); BEGIN IF C.sock # WSock32.InvalidSocket THEN FlushSendBuffer(C); ConnectionFinalizer(C); C.state := closed END END CloseConnection; (** Indicates whether there exists a remote machine which wants to connect to the local one. This Procedure is only useful on passive connections. For active connections (State(C) # listen), it always delivers FALSE. *) PROCEDURE Requested*(C: Connection): BOOLEAN; BEGIN RETURN C.req > 0 END Requested; (** Procedure accepts a new waiting, active connection (newC) on a passive one (State(C) = listen). If no connection is waiting, accept blocks until there is one or an error occurs. If C is not a passive connection, Accept does nothing but res is set to Done. *) PROCEDURE Accept*(C: Connection; VAR newC: Connection; VAR res: INTEGER); VAR ret: LONGINT; BEGIN newC := NIL; res := error; IF C.req > 0 THEN Threads.Lock(tcpMtx); ret := FreeConnTabEntry(); NEW(newC); newC.nr := ret; NEW(newC.event); Threads.Create(newC.event); newC.res := error; newC.sock := WSock32.accept(C.sock, NIL, NIL); DEC(C.req); IF newC.sock = WSock32.InvalidSocket THEN C.res := error; newC := NIL ELSE C.res := done; IF FindConnection(newC.sock) # NIL THEN Threads.Unlock(tcpMtx); HALT(99) END; newC.state := inout; newC.req := 0; newC.recBufPos := 0; newC.recBufEnd := 0; newC.sendBufEnd := 0; ConnTab[newC.nr] := SYSTEM.VAL(LONGINT, newC); WSock32.WSAAsyncSelect(newC.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDRead+WSock32.FDWrite+WSock32.FDClose); Kernel.RegisterObject(newC, ConnectionFinalizer, FALSE); newC.res := done; res := done END; WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDAccept); Threads.Unlock(tcpMtx) END END Accept; (** Procedure returns the state of a connection (see constant section). *) PROCEDURE State*(C: Connection): INTEGER; BEGIN IF C.sendBufEnd > 0 THEN FlushSendBuffer(C) END; RETURN C.state END State; (** Returns the number of bytes which may be read without blocking. *) PROCEDURE Available*(C: Connection): LONGINT; VAR err, ret, avail: LONGINT; BEGIN IF C.sendBufEnd > 0 THEN FlushSendBuffer(C) END; avail := C.recBufEnd-C.recBufPos; IF (avail < RecBufLimit) & (C.sock # WSock32.InvalidSocket) THEN IF avail <= 0 THEN avail := 0; ret := WSock32.recv(C.sock, C.recBuf[0], RecBufSize, 0) ELSIF C.recBufPos = 0 THEN ret := WSock32.recv(C.sock, C.recBuf[C.recBufEnd], RecBufSize-avail, 0) ELSE SYSTEM.MOVE(SYSTEM.ADR(C.recBuf[C.recBufPos]), SYSTEM.ADR(C.recBuf[0]), avail); ret := WSock32.recv(C.sock, C.recBuf[avail], RecBufSize-avail, 0) END; IF ret < 0 THEN (* SocketError *) err := WSock32.WSAGetLastError(); IF (err = WSock32.WSAEInval) OR (err = WSock32.WSAEConnAborted) OR (err = WSock32.WSAEConnReset) THEN C.state := closed; ELSIF (err # WSock32.WSAEWouldBlock) & (err # WSock32.WSAENoBufs) THEN Kernel32.Str("Available error "); Kernel32.Int(err); Kernel32.Ln(); C.res := error END; ret := 0 ELSE WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDRead+WSock32.FDWrite+WSock32.FDClose) END; C.recBufPos := 0; C.recBufEnd := avail+ret; avail := C.recBufEnd-C.recBufPos; ASSERT(C.res = done) END; RETURN avail END Available; (** Procedure delivers the ip-number and port number of a connection's remote partner. *) PROCEDURE GetPartner*(C: Connection; VAR remIP: IPAdr; VAR remPort: INTEGER); VAR saddr: WSock32.SockAddrIN; ret, len: LONGINT; BEGIN len := SIZE(WSock32.SockAddrIN); ret := WSock32.getpeername(C.sock, saddr, len); IF ret = 0 THEN remPort := WSock32.ntohs(saddr.sinPort); SYSTEM.MOVE(SYSTEM.ADR(saddr.sinAddr), SYSTEM.ADR(remIP), IPAdrLen); C.res := done ELSE remIP := anyIP; remPort := anyport; C.res := error END END GetPartner; (** Blocking write len bytes of data (beginning at pos in buf) to C. *) PROCEDURE WriteBytes*(C: Connection; pos, len: LONGINT; VAR x: ARRAY OF SYSTEM.BYTE); VAR free, clen: LONGINT; BEGIN ASSERT(LEN(x) >= (pos+len)); WHILE (len > 0) & (C.res = done) DO free := SendBufSize-C.sendBufEnd; IF len <= free THEN clen := len ELSE clen := free END; SYSTEM.MOVE(SYSTEM.ADR(x)+pos, SYSTEM.ADR(C.sendBuf[C.sendBufEnd]), clen); INC(C.sendBufEnd, clen); INC(pos, clen); DEC(len, clen); IF C.sendBufEnd >= SendBufSize THEN FlushSendBuffer(C) END END END WriteBytes; (** Blocking write a single byte to C. *) PROCEDURE Write*(C: Connection; x: SYSTEM.BYTE); BEGIN WriteBytes(C, 0, 1, x) END Write; (** Blocking write two bytes in network byte ordering to C. *) PROCEDURE WriteInt*(C: Connection; x: INTEGER); BEGIN x := WSock32.htons(x); WriteBytes(C, 0, 2, x) END WriteInt; (** Blocking write four bytes in network byte ordering to C. *) PROCEDURE WriteLInt*(C: Connection; x: LONGINT); BEGIN x := WSock32.htonl(x); WriteBytes(C, 0, 4, x) END WriteLInt; (** Blocking write a string without "0X" and terminated by "CRLF" to C. *) PROCEDURE WriteString*(C: Connection; s: ARRAY OF CHAR); VAR i: LONGINT; BEGIN i := 0; WHILE s[i] # 0X DO INC(i) END; WriteBytes(C, 0, i, s); WriteBytes(C, 0, 2, Strings.CRLF) END WriteString; (** Blocking read len bytes of data (beginning at pos in buf) to buf. *) PROCEDURE ReadBytes*(C: Connection; pos, len: LONGINT; VAR x: ARRAY OF SYSTEM.BYTE); VAR ret, err, free, clen: LONGINT; BEGIN ASSERT(LEN(x) >= (pos+len)); IF C.sendBufEnd > 0 THEN FlushSendBuffer(C) END; WHILE (len > 0) & (C.res = done) DO free := C.recBufEnd-C.recBufPos; IF free > 0 THEN IF len <= free THEN clen := len ELSE clen := free END; SYSTEM.MOVE(SYSTEM.ADR(C.recBuf[C.recBufPos]), SYSTEM.ADR(x)+pos, clen); INC(C.recBufPos, clen); INC(pos, clen); DEC(len, clen) ELSE C.recBufPos := 0; C.recBufEnd := 0; IF C.sock # WSock32.InvalidSocket THEN ret := WSock32.recv(C.sock, C.recBuf[0], RecBufSize, 0); IF ret < 0 THEN (* SocketError *) err := WSock32.WSAGetLastError(); IF (err = WSock32.WSAEInval) OR (err = WSock32.WSAEConnAborted) OR (err = WSock32.WSAEConnReset) THEN Kernel32.Str("ReadBytes error "); Kernel32.Int(err); Kernel32.Ln(); C.state := closed; C.res := error ELSIF (err # WSock32.WSAEWouldBlock) & (err # WSock32.WSAENoBufs) THEN C.res := error END ELSIF ret = 0 THEN WSock32.WSAAsyncSelect(C.sock, Windows.dummyWin.hWnd, WMConnect, WSock32.FDRead+WSock32.FDWrite+WSock32.FDClose); IF ~Threads.Wait(C.event, ReceiveTimeOut) THEN C.res := error END ELSE C.recBufEnd := ret END ELSE C.res := error END END END; ASSERT(C.res = done) END ReadBytes; (** Blocking read a single byte. *) PROCEDURE Read*(C: Connection; VAR x: SYSTEM.BYTE); BEGIN ReadBytes(C, 0, 1, x) END Read; (** Blocking read two bytes in network byte ordering. *) PROCEDURE ReadInt*(C: Connection; VAR x: INTEGER); BEGIN ReadBytes(C, 0, 2, x); x := WSock32.ntohs(x); END ReadInt; (** Blocking read four bytes in network byte ordering. *) PROCEDURE ReadLInt*(C: Connection; VAR x: LONGINT); BEGIN ReadBytes(C, 0, 4, x); x := WSock32.ntohl(x); END ReadLInt; (** Blocking read a string terminated by ( [CR]LF | 0X ). *) PROCEDURE ReadString*(C: Connection; VAR s: ARRAY OF CHAR); VAR i, l: LONGINT; ch, ch0: CHAR; BEGIN i := 0; ch := 1X; ch0 := 1X; l := Available(C); REPEAT IF l > 0 THEN ch0 := ch; ReadBytes(C, 0, 1, ch); s[i] := ch; INC(i); DEC(l) ELSE l := Available(C); Threads.Pass() END UNTIL (ch = 0X) OR (ch = Strings.LF) OR ((l <= 0) & ~(C.state IN {in, inout})); IF (ch = Strings.LF) & (ch0 = Strings.CR) THEN s[i-2] := 0X ELSIF (ch = Strings.LF) OR (ch = Strings.CR) THEN s[i-1] := 0X ELSE s[i] := 0X END END ReadString; (** -- UDP section. *) (* Datagram oriented communication *) PROCEDURE *SockFinalizer(S: PTR); BEGIN WITH S: Socket DO IF S.sock # WSock32.InvalidSocket THEN WSock32.closesocket(S.sock); S.sock := WSock32.InvalidSocket END END END SockFinalizer; (** Opens a socket which is dedicated to datagram services. locPort is registered to receive datagrams from any port and any host. *) PROCEDURE OpenSocket*(VAR S: Socket; locPort: INTEGER; VAR res: INTEGER); VAR ret: LONGINT; sadr: WSock32.SockAddrIN; BEGIN S := NIL; res := error; IF ~ready THEN RETURN END; NEW(S); S.sock := WSock32.socket(WSock32.PFINet, WSock32.SockDGram, WSock32.IPProtoUDP); IF S.sock # WSock32.InvalidSocket THEN sadr.sinFamily := WSock32.PFINet; sadr.sinAddr := 0; IF locPort # anyport THEN sadr.sinPort := WSock32.htons(locPort) ELSE sadr.sinPort := 0 END; ret := WSock32.bind(S.sock, sadr, SIZE(WSock32.SockAddrIN)); IF ret # 0 THEN SockFinalizer(S) ELSE Kernel.RegisterObject(S, SockFinalizer, FALSE); res := done END END; IF res # done THEN S := NIL END END OpenSocket; (** Closes the socket. You can not receive datagrams anymore. *) PROCEDURE CloseSocket*(S: Socket); BEGIN SockFinalizer(S) END CloseSocket; (** Sends len bytes of data (beginning at pos in buf) to the host specified by remIP and remPort. *) PROCEDURE SendDG*(S: Socket; remIP: IPAdr; remPort: INTEGER; pos, len: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE); VAR ret: LONGINT; sadr: WSock32.SockAddrIN; BEGIN ASSERT(LEN(buf) >= (pos+len)); SYSTEM.MOVE(SYSTEM.ADR(remIP), SYSTEM.ADR(sadr.sinAddr), IPAdrLen); sadr.sinFamily := WSock32.PFINet; sadr.sinPort := WSock32.htons(remPort); ret := WSock32.sendto(S.sock, buf[pos], len, 0, sadr, SIZE(WSock32.SockAddrIN)); S.res := SHORT(ret) END SendDG; (** Stores an entire datagram in buf beginning at pos. On success (S.res = done), remIP and remPort indicate the sender, len indicate the length of valid data. *) PROCEDURE ReceiveDG*(S: Socket; VAR remIP: IPAdr; VAR remPort: INTEGER; pos: LONGINT; VAR len: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE); VAR l: LONGINT; sadr: WSock32.SockAddrIN; BEGIN ASSERT(pos <= LEN(buf)); l := SIZE(WSock32.SockAddrIN); len := WSock32.recvfrom(S.sock, buf[pos], LEN(buf)-pos, 0, sadr, l); remPort := WSock32.ntohs(sadr.sinPort); SYSTEM.MOVE(SYSTEM.ADR(sadr.sinAddr), SYSTEM.ADR(remIP), IPAdrLen) END ReceiveDG; (** Returns the size of the first available datagram on the socket, otherwise <= 0. *) PROCEDURE AvailableDG*(S: Socket): LONGINT; VAR avail: LONGINT; BEGIN WSock32.ioctlsocket(S.sock, WSock32.FIONRead, avail); RETURN avail END AvailableDG; (* Conversions *) (** Write 2 bytes in network byte ordering to buf[pos]. *) PROCEDURE PutInt*(VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; x: INTEGER); BEGIN ASSERT(pos <= LEN(buf) - 2); x := WSock32.htons(x); SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(buf[pos]), 2) END PutInt; (** Read 2 bytes in network byte ordering from buf[pos]. *) PROCEDURE GetInt*(VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: INTEGER); BEGIN ASSERT(pos <= LEN(buf) - 2); SYSTEM.MOVE(SYSTEM.ADR(buf[pos]), SYSTEM.ADR(x), 2); x := WSock32.ntohs(x) END GetInt; (** Write 4 bytes in network byte ordering to buf[pos]. *) PROCEDURE PutLInt*(VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; x: LONGINT); BEGIN ASSERT(pos <= LEN(buf) - 4); x := WSock32.htonl(x); SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(buf[pos]), 4) END PutLInt; (** Read 4 bytes in network byte ordering from buf[pos]. *) PROCEDURE GetLInt*(VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: LONGINT); BEGIN ASSERT(pos <= LEN(buf) - 4); SYSTEM.MOVE(SYSTEM.ADR(buf[pos]), SYSTEM.ADR(x), 4); x := WSock32.ntohl(x) END GetLInt; (** -- Initialisation section. *) (** Command NetSystem.Stop ~ Shut down NetSystem. *) PROCEDURE Stop*; BEGIN stop(); Windows.UnregisterWindowHandler(WindowHandler) END Stop; PROCEDURE Init(); VAR i: LONGINT; done: BOOLEAN; BEGIN anyIP := 0; allIP := -1; ToHost("127.0.0.1", hostIP, done);hostName := ""; FOR i := 0 TO ConnTabSize-1 DO ConnTab[i] := SYSTEM.VAL(LONGINT, NIL) END; FOR i := 0 TO IPCacheSize-1 DO IPCache[i].host := ""; IPCache[i].ip := anyIP END; curIP := 0; Modules.InstallTermHandler(Stop) END Init; (** Command NetSystem.Start ~ Start up NetSystem. *) PROCEDURE Start*; VAR ret, i: LONGINT; data: WSock32.WSAData; str: ARRAY 256 OF CHAR; hostInfo: HostInfo; async: BOOLEAN; BEGIN IF ~ready THEN Init(); hostInfos := NIL; NEW(tcpMtx); Threads.Init(tcpMtx); Kernel32.Str("WSAStartup: "); ret := WSock32.WSAStartup(101H, data); IF ret # 0 THEN ready := FALSE; Kernel32.Int(ret) ELSE ret := 0; i := 0; WHILE (ret <= 256) & (data.szDescription[ret] # 0X) DO IF data.szDescription[ret] >= " " THEN str[i] := data.szDescription[ret]; INC(i) ELSIF (data.szDescription[ret] = Strings.CR) OR (data.szDescription[ret] = Strings.LF) THEN str[i] := 0X; i := 0; Kernel32.Str(str); Kernel32.Ln() END; INC(ret) END; str[i] := 0X; Kernel32.Str(str); ready := TRUE END; IF ready THEN Kernel32.Ln(); Windows.RegisterWindowHandler(WindowHandler, WMConnect); Windows.RegisterWindowHandler(WindowHandler, WMGetHostInfo); (* Registry.OberonPath("NetSystem", str); Registry.GetKeyValue(Registry.CurrentUser, str, "HostName", hostName); *) hostName := ""; IF ~AosConfiguration.GetKeyValue(Oberon.configuration,"NetSystem","HostName",hostName) THEN Kernel32.Str("gethostname: "); ret := WSock32.gethostname(hostName, LEN(hostName)); ready := ret = 0 ELSE Kernel32.Str("NetSystem.HostName: ") END; IF ready THEN Windows.UseDummyWin(); Kernel32.Str(hostName); Kernel32.Ln(); IF AosConfiguration.GetKeyValue(Oberon.configuration,"NetSystem","HostIP", str) THEN Kernel32.Str("NetSystem.HostIP: "); ToHost(str, hostIP, ready) ELSE hostIP := anyIP; (* Registry.OberonPath("NetSystem", str); Registry.GetKeyValue(Registry.CurrentUser, str, "Async", str); *) IF AosConfiguration.GetKeyValue(Oberon.configuration,"NetSystem","Async", str)THEN Strings.StrToBool(str, async); ELSE async := TRUE END; IF async THEN Kernel32.Str("WSAAsyncGetHostByName: "); AsyncGetIP(hostInfo, hostName); IF (hostInfo # NIL) & Threads.Wait(hostInfo.event, GetIPTimeOut) & ~hostInfo.err THEN hostIP := hostInfo.ip END ELSE Kernel32.Str("gethostbyname: "); ret := WSock32.gethostbyname(hostName); IF ret # Kernel32.NULL THEN SYSTEM.GET(ret+12, ret); SYSTEM.GET(ret, ret); SYSTEM.MOVE(ret, SYSTEM.ADR(hostIP), IPAdrLen) END END END END END; IF ready & (hostIP # anyIP) THEN ToNum(hostIP, str); Kernel32.Str(str) ELSE Kernel32.Str("failed"); ready := FALSE; Stop() END; Kernel32.Ln() END END Start; (** -- Passwords section. *) PROCEDURE getPassword(msg, msg1: ARRAY OF CHAR; fnt: Fonts.Font; VAR pw: ARRAY OF CHAR; readable: BOOLEAN); CONST TickSize = 6; TickSpace = 4; VAR X, Y, x, y, T, pos, BoxW, BoxH, w1, w2, w3, h: INTEGER; keys: SET; done, fin: BOOLEAN; ch: CHAR; M: Display3.Mask; disp: Displays.Display; PROCEDURE Feedback(count: INTEGER); VAR len, x: INTEGER; BEGIN IF readable THEN pw[pos] := 0X; Display3.ReplConst(M, Display3.groupC, X+1, (Y + BoxH DIV 4)-2*TickSize, BoxW-2, 4*TickSize, Display.replace); Display3.CenterString(M, Display3.textC, X, (Y + BoxH DIV 4)-2*TickSize, BoxW, 4*TickSize, fnt, pw, Display.paint) ELSE Display3.ReplConst(M, Display3.groupC, X + 2, Y + BoxH DIV 4, BoxW - 4, TickSize, Display.replace); len := count * (TickSize + TickSpace); x := X + BoxW DIV 2 - len DIV 2; y := Y + BoxH DIV 4; WHILE count > 0 DO Display3.ReplConst(M, Display3.textC, x, y, TickSize, TickSize, Display.paint); DEC(count); INC(x, TickSize + TickSpace) END END END Feedback; PROCEDURE Box(); VAR tmp: INTEGER; BEGIN Display3.StringSize(msg, fnt, w1, h, tmp); BoxW := w1; Display3.StringSize(msg1, fnt, w2, h, tmp); IF w2 > BoxW THEN BoxW := w2 END; IF w3 > BoxW THEN BoxW := w3 END; BoxW := BoxW * 15 DIV 10; BoxH := h * 4 * 15 DIV 10; X := SHORT(disp.width DIV 2 - BoxW DIV 2); Y := SHORT(disp.height DIV 2 - BoxH DIV 2); NEW(M); Display3.Open(M); Display3.Add(M, X+2, Y+2, BoxW-4, BoxH-4); Display3.FilledRect3D(NIL, Display3.topC, Display3.bottomC, Display3.groupC, X, Y, BoxW, BoxH, 1, Display.replace); T := Y + BoxH * 3 DIV 4; Display3.String(M, Display3.textC, X + BoxW DIV 2 - w1 DIV 2, T, fnt, msg, Display.paint); DEC(T, h); Display3.String(M, Display3.textC, X + BoxW DIV 2 - w2 DIV 2, T, fnt, msg1, Display.paint); DEC(T, h) END Box; BEGIN disp := Display.cur; Oberon.Defocus(); Box(); fin := FALSE; pos := 0; REPEAT Input.Mouse(keys, x, y); IF Input.Available() > 0 THEN Input.Read(ch); CASE ch OF 1BX: fin := TRUE; pos := 0; | 0DX: fin := TRUE; | 7FX: IF pos > 0 THEN DEC(pos); Feedback(pos) END ELSE IF pos < LEN(pw) - 1 THEN pw[pos] := ch; INC(pos); Feedback(pos) END END END UNTIL fin; pw[pos] := 0X; done := Displays.PutEvent(NIL, disp, Displays.redraw, 0) END getPassword; (** Retrieve the password for user using service on host. Parameters service, host and user must be specified. Parameter user is in/out. If empty, it returns the first (user, password) pair found, otherwise it returns the specified user's password. *) PROCEDURE GetPassword*(service, host: ARRAY OF CHAR; VAR user, password: ARRAY OF CHAR); VAR pass: Password; msg, temp: ARRAY HostNameLen OF CHAR; BEGIN Strings.Lower(service, service); Strings.Lower(host, host); pass := passwords; WHILE (pass # NIL) & ~((pass.service = service) & (pass.host = host) & ((user = "") OR (pass.user = user))) DO pass := pass.next END; IF pass # NIL THEN COPY(pass.user, user); COPY(pass.passwd, password); ELSE IF (service # "") & (host # "") THEN IF user = "" THEN COPY(service, msg); Strings.Append(msg, " to "); Strings.Append(msg, host); getPassword("Please enter your username for", msg, Fonts.This("Syntax12.Scn.Fnt"), temp, TRUE); COPY(temp, user) ELSE COPY(user, temp) END; IF temp # "" THEN COPY(service, msg); Strings.Append(msg, " to "); Strings.Append(msg, temp); Strings.AppendCh(msg, "@"); Strings.Append(msg, host); getPassword("Please enter your password for", msg, Fonts.This("Syntax12.Scn.Fnt"), password, FALSE); IF password # "" THEN NEW(pass); pass.next := passwords; passwords := pass; COPY(service, pass.service); COPY(host, pass.host); COPY(temp, pass.user); COPY(password, pass.passwd); RETURN END END END; COPY("", user); COPY("", password) END; END GetPassword; (** Remove password for user using service on host. *) PROCEDURE DelPassword*(service, user, host: ARRAY OF CHAR); VAR ppass, pass: Password; BEGIN Strings.Lower(service, service); Strings.Lower(host, host); ppass := NIL; pass := passwords; WHILE (pass # NIL) & ((pass.service # service) & (pass.host # host) & (pass.user # user)) DO ppass := pass; pass := pass.next END; IF pass # NIL THEN IF ppass # NIL THEN ppass.next := pass.next ELSE passwords := pass.next END END END DelPassword; PROCEDURE InputRead(VAR ch: CHAR); (* not really clean *) BEGIN Input.Read(ch) END InputRead; (** Command NetSystem.SetUser { service ":" ["//"] user [ ":" password ] "@" host [ "/" ] } "~" If password is not specified in-line, prompts for the password for the (service, host, user) triple. The (service, host, user, password) 4-tuple is stored in memory for retrieval with GetPassword. Multiple identical passwords may be set with one command. *) PROCEDURE SetUser*; VAR R: Texts.Reader; service, usr, host, pwd, entered: ARRAY 64 OF CHAR; ok, verbose: BOOLEAN; ch: CHAR; pass: Password; PROCEDURE Next(VAR str: ARRAY OF CHAR); VAR i: LONGINT; BEGIN Texts.Read(R, ch); WHILE ~R.eot & ((ch <= " ") OR (ch = ":") OR (ch = "@") OR (ch = "/") OR ~(R.lib IS Fonts.Font)) DO Texts.Read(R, ch) END; i := 0; WHILE ~R.eot & (ch > " ") & (ch # ":") & (ch # "@") & (ch # "/") & (ch # "~") & (R.lib IS Fonts.Font) DO str[i] := ch; INC(i); Texts.Read(R, ch) END; str[i] := 0X END Next; PROCEDURE InputStr(prompt: ARRAY OF CHAR; show: BOOLEAN; VAR str: ARRAY OF CHAR); VAR i: LONGINT; ch: CHAR; BEGIN Texts.SetColor(W, 1); Texts.WriteString(W, prompt); Texts.SetColor(W, 15); Texts.Append(Oberon.Log, W.buf); InputRead(ch); i := 0; WHILE (ch # 0DX) & (ch # 1AX) DO IF ch = 7FX THEN IF i > 0 THEN Texts.Delete(Oberon.Log, Oberon.Log.len-1, Oberon.Log.len); DEC(i) END ELSE IF show THEN Texts.Write(W, ch) ELSE Texts.Write(W, "*") END; Texts.Append(Oberon.Log, W.buf); str[i] := ch; INC(i) END; InputRead(ch) END; IF ch # 0DX THEN i := 0 END; str[i] := 0X; Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END InputStr; PROCEDURE Replace(p: Password); VAR q, prev: Password; msg: ARRAY 12 OF CHAR; BEGIN q := passwords; prev := NIL; WHILE (q # NIL) & ~((q.service = p.service) & (q.host = p.host) & (q.user = p.user)) DO prev := q; q := q.next END; IF q # NIL THEN (* password exists, delete old one first *) IF prev = NIL THEN passwords := passwords.next ELSE prev.next := q.next END; msg := "replaced" ELSE msg := "set" END; p.next := passwords; passwords := p; IF verbose THEN Texts.WriteString(W, p.service); Texts.Write(W, ":"); Texts.WriteString(W, p.user); Texts.Write(W, "@"); Texts.WriteString(W, p.host); Texts.WriteString(W, " password "); Texts.WriteString(W, msg); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END Replace; BEGIN Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos); ok := TRUE; entered[0] := 0X; verbose := FALSE; WHILE ~R.eot & ok DO ok := FALSE; Next(service); IF service = "\v" THEN verbose := TRUE; Next(service) END; Strings.Lower(service, service); IF ch = ":" THEN Next(usr); IF ch = ":" THEN (* password specified in-line *) Next(pwd); IF ch = "@" THEN Next(host) ELSE COPY(pwd, host); pwd[0] := 0X END ELSIF ch = "@" THEN (* no password specified in-line *) pwd[0] := 0X; Next(host) ELSE (* no user or password specified *) COPY(usr, host); usr[0] := 0X; pwd[0] := 0X END; Strings.Lower(host, host); IF host[0] # 0X THEN IF (usr[0] = 0X) OR ((pwd[0] = 0X) & (entered[0] = 0X)) THEN Texts.WriteString(W, service); Texts.WriteString(W, "://"); IF usr[0] # 0X THEN Texts.WriteString(W, usr); Texts.Write(W, "@") END; Texts.WriteString(W, host); Texts.WriteLn(W) END; IF usr[0] = 0X THEN (* no user specified, prompt *) InputStr("Enter user name: ", TRUE, usr); IF usr[0] = 0X THEN RETURN END END; IF pwd[0] = 0X THEN (* no pwd specified *) IF entered[0] = 0X THEN (* prompt first time *) InputStr("Enter password: ", FALSE, entered); IF entered[0] = 0X THEN RETURN END (* esc *) END; pwd := entered END; NEW(pass); COPY(service, pass.service); COPY(host, pass.host); COPY(usr, pass.user); COPY(pwd, pass.passwd); Replace(pass); ok := TRUE END END END END SetUser; (** Command NetSystem.ClearUser ~ Clear all passwords from memory. *) PROCEDURE ClearUser*; BEGIN passwords := NIL END ClearUser; BEGIN Texts.OpenWriter(W); GetIPTimeOut := 30*Input.TimeUnit; GetNameTimeOut := GetIPTimeOut; OpenConnectionTimeOut := GetIPTimeOut; SendTimeOut := 30*Input.TimeUnit; ReceiveTimeOut := SendTimeOut; passwords := NIL; ready := FALSE; Start() END NetSystem. BIER"3:Z CSyntax10.Scn.Fnt28.05.03 13:36:52TimeStamps.New