Oberon/ETH Oberon/2.3.7/NetSystem.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE NetSystem;	(** portable *)	(* mg 16.08.96 *) (* A Portable Oberon Interface to Internet Protocols *) IMPORT SYSTEM, Kernel, Modules, NetBase, NetPorts, NetIP, NetUDP, NetTCP, NetDNS, Input, Texts, Oberon, TextFrames, Strings, Fonts; CONST anyport* = 0;	(** any port value *) (** result values *) done* = 0;	(** everything went ok *) error* = 1;	(** failure occured *) (** return values of procedure 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 *) CR = 0DX; LF = 0AX; Trace = FALSE; TYPE Connection* = POINTER TO ConnectionDesc;	(** handle for TCP connections *) ConnectionDesc* = RECORD port: NetPorts.Port; res*: INTEGER;	(** result of last operation on a connection (error indication) *) state: INTEGER; Available: PROCEDURE (C: Connection; VAR res: INTEGER): LONGINT; Receive: PROCEDURE (C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER); Send: PROCEDURE (C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER); END; IPAdr* = LONGINT; (** IP address in network byte order *) Socket* = POINTER TO SocketDesc;	(** handle for UDP "connections" *) SocketDesc* = RECORD C: NetUDP.Connection; res*: INTEGER;	(** result of last operation on a connection (error indication) *) state: INTEGER END; Password = POINTER TO PasswordDesc; PasswordDesc = RECORD service, user, host, passwd: ARRAY 64 OF CHAR; next: Password END; VAR anyIP*: IPAdr;	(** "NIL" ip-number *) allIP*: IPAdr;	(** broadcast ip-number *) hostIP*: IPAdr;	(** main ip-number of local machine *) hostName*: ARRAY 64 OF CHAR;	(** main name of local machine *) started: BOOLEAN; W: Texts.Writer; passwords: Password; hex: ARRAY 17 OF CHAR; task: Oberon.Task; PROCEDURE GetEntry (key, name: ARRAY OF CHAR; VAR arg0, arg1: ARRAY OF CHAR); VAR S: Texts.Scanner; key0: ARRAY 64 OF CHAR; i, j: INTEGER; BEGIN COPY(key, key0); i := 0; WHILE key0[i] # 0X DO INC(i) END; j := 0; WHILE name[j] # 0X DO key0[i] := name[j]; INC(i); INC(j) END; key0[i] := 0X; Oberon.OpenScanner(S, key0); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, arg0); Texts.Scan(S) ELSE COPY("", arg0) END; IF (S.class = Texts.Char) & (S.c = ",") THEN Texts.Scan(S); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, arg1) ELSE COPY("", arg1) END ELSE COPY("", arg1) END END GetEntry; PROCEDURE GetEntry0 (key, name: ARRAY OF CHAR; VAR arg: ARRAY OF CHAR); VAR S: Texts.Scanner; key0: ARRAY 64 OF CHAR;  i, j: INTEGER; BEGIN COPY(key, key0); i := 0; WHILE key0[i] # 0X DO INC(i) END; j := 0; WHILE name[j] # 0X DO key0[i] := name[j]; INC(i); INC(j) END; key0[i] := 0X; Oberon.OpenScanner(S, key0); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, arg); Texts.Scan(S) ELSE COPY("", arg) END END GetEntry0; PROCEDURE ToNum0 (num: ARRAY OF CHAR; VAR n: INTEGER; VAR done: BOOLEAN); VAR i: INTEGER; BEGIN n := 0; i := 0; WHILE ("0" <= num[i]) & (num[i] <= "9") DO 		n := n * 10 + ORD(num[i]) - ORD("0"); INC(i) END; done := num[i] = 0X END ToNum0; PROCEDURE ToHost0 (num: ARRAY OF CHAR; VAR adr: NetIP.Adr; VAR done: BOOLEAN); VAR addr: IPAdr; buf: ARRAY 32 OF CHAR; i, j, k, n: INTEGER; BEGIN done := TRUE; addr := 0; i := 0; j := 0; WHILE done & (j < 4) & (num[i] # 0X) DO 		k := 0; WHILE (num[i] # ".") & (num[i] # 0X) DO 			buf[k] := num[i]; INC(k); INC(i) END; buf[k] := 0X; ToNum0(buf, n, done); addr := ASH(addr, 8) + n; done := done & (n <= 256); IF num[i] = "." THEN INC(i) END; INC(j) END; adr := SYSTEM.VAL(NetIP.Adr, addr); NetBase.HostLToNet(adr); done := done & (j = 4) & (num[i] = 0X) END ToHost0; PROCEDURE AdrToStr(netAdr: ARRAY OF SYSTEM.BYTE; VAR net: ARRAY OF CHAR); VAR i, j: LONGINT; BEGIN j := 0; FOR i := 0 TO NetBase.MacAdrLen-1 DO 		net[j] := hex[ORD(netAdr[i]) DIV 10H MOD 10H]; net[j+1] := hex[ORD(netAdr[i]) MOD 10H]; net[j+2] := ":"; INC(j, 3) END; DEC(j); net[j] := 0X END AdrToStr; (* Look up an ethernet address to find ip address and hostname. *) PROCEDURE FindAddress(key: ARRAY OF CHAR; netAdr: ARRAY OF SYSTEM.BYTE;  VAR hostname, num: ARRAY OF CHAR); VAR net: ARRAY 20 OF CHAR; s: Texts.Scanner;  found: BOOLEAN; BEGIN AdrToStr(netAdr, net); num[0] := 0X; hostname[0] := 0X; IF net # "00:00:00:00:00:00" THEN Oberon.OpenScanner(s, key); found := FALSE; WHILE (s.class = Texts.String) & ~found DO 			found := s.s = net; Texts.Scan(s); IF (s.class = Texts.Char) & (s.c = ",") THEN Texts.Scan(s); IF s.class = Texts.String THEN COPY(s.s, hostname); Texts.Scan(s); IF (s.class = Texts.Char) & (s.c = ",") THEN Texts.Scan(s); IF s.class = Texts.String THEN IF found THEN COPY(s.s, num) END; Texts.Scan(s) END ELSE s.class := Texts.Inval END END ELSE s.class := Texts.Inval END END; IF num[0] = 0X THEN hostname[0] := 0X; Texts.WriteString(W, "NetSystem.Route#.Host setting not found in Oberon.Text"); Texts.WriteLn(W); Texts.WriteString(W, net); Texts.WriteString(W, " not found in "); Texts.WriteString(W, key); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END ELSE (* MAC adr all zero, ignore *) END END FindAddress; (** -- 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); BEGIN ToHost0(num, SYSTEM.VAL(NetIP.Adr, adr), done); IF ~done THEN adr := anyIP END 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 GetIP* (name: ARRAY OF CHAR; VAR IP: IPAdr); VAR hostName, hostIP: ARRAY 64 OF CHAR; res: INTEGER; done: BOOLEAN; BEGIN IF (CAP(name[0]) >= "A") & (CAP(name[0]) <= "Z") THEN GetEntry("NetSystem.Hosts.", name, hostName, hostIP); IF hostIP # "" THEN ToHost0(hostIP, SYSTEM.VAL(NetIP.Adr, IP), done) ELSE IF started THEN IF hostName # "" THEN NetDNS.HostByName(hostName, SYSTEM.VAL(NetIP.Adr, IP), res) ELSE NetDNS.HostByName(name, SYSTEM.VAL(NetIP.Adr, IP), res) END; done := (res = NetDNS.Done) ELSE done := FALSE END END ELSIF (name[0] >= "0") & (name[0] <= "9") THEN ToHost0(name, SYSTEM.VAL(NetIP.Adr, IP), done) ELSE done := FALSE END; IF ~done THEN IP := anyIP END END GetIP; (** 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 adr: NetIP.Adr; res: INTEGER; BEGIN IF started THEN adr := SYSTEM.VAL(NetIP.Adr, IP); NetDNS.HostByNumber(adr, name, res) END; IF ~started OR (res # NetDNS.Done) THEN COPY("", name) END END GetName; (** -- TCP section. *) (* Stream oriented communication *) (* PROCEDURE TCPSetState (C: Connection); BEGIN 	IF C.state IN {in, inout} THEN 		IF ~NetTCP.Connected(C.port(NetTCP.Connection)) THEN 			IF C.state = inout THEN C.state := out 			ELSIF C.state = in THEN C.state := closed 			END 		END 	END END TCPSetState; *) PROCEDURE TCPAvailable (C: Connection; VAR res: INTEGER): LONGINT; VAR len: LONGINT; BEGIN len := NetTCP.Available(C.port(NetTCP.Connection)); IF len < 0 THEN len := 0; res := error ELSE res := done END; (*TCPSetState(C);*) RETURN len END TCPAvailable; PROCEDURE TCPReceive (C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER); VAR l: LONGINT; BEGIN l := 0; REPEAT l := len; NetTCP.Receive(C.port(NetTCP.Connection), buf, beg, l); IF l > 0 THEN beg := beg + l; len := len - l END UNTIL (len = 0) OR (l < 0); IF l < 0 THEN res := error ELSE res := done END; (*TCPSetState(C)*) END TCPReceive; PROCEDURE TCPSend (C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER); BEGIN NetTCP.Send(C.port(NetTCP.Connection), buf, beg, len); IF len < 0 THEN res := error ELSE res := done END; (*TCPSetState(C)*) END TCPSend; PROCEDURE DmyAvailable (C: Connection; VAR res: INTEGER): LONGINT; BEGIN res := error; RETURN 0 END DmyAvailable; PROCEDURE DmyReceive (C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER); BEGIN res := error END DmyReceive; PROCEDURE DmySend (C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER); BEGIN res := error END DmySend; PROCEDURE ^Cleanup(c: SYSTEM.PTR); (** 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 conC: NetTCP.Connection; listC: NetTCP.Listener; remAdr: NetIP.Adr; BEGIN IF started THEN remAdr := SYSTEM.VAL(NetIP.Adr, remIP); NEW(C); IF (SYSTEM.VAL(LONGINT, remIP) = SYSTEM.VAL(LONGINT, NetIP.IPany)) OR (remPort = NetPorts.anyport) THEN NetTCP.Listen(listC, locPort, remAdr, remPort, C.res); IF C.res = NetTCP.Done THEN C.port := listC; C.state := listening; C.Available := DmyAvailable; C.Send := DmySend; C.Receive := DmyReceive; Kernel.RegisterObject(C, Cleanup, FALSE) ELSIF C.res # NetTCP.Timeout THEN C.res := error END; res := C.res ELSIF ~NetIP.IsBroadcast(remAdr) THEN NetTCP.Connect(conC, locPort, remAdr, remPort, C.res); IF C.res = NetTCP.Done THEN C.port := conC; C.state := inout; C.Available := TCPAvailable; C.Send := TCPSend; C.Receive := TCPReceive; Kernel.RegisterObject(C, Cleanup, FALSE) ELSIF C.res # NetTCP.Timeout THEN C.res := error END; res := C.res ELSE res := error END ELSE res := error 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); VAR conC: NetTCP.Connection; remAdr: NetIP.Adr; BEGIN IF ~started OR (SYSTEM.VAL(LONGINT, remIP) = SYSTEM.VAL(LONGINT, NetIP.IPany)) OR 			(remPort = NetPorts.anyport) OR NetIP.IsBroadcast(remAdr) THEN OpenConnection(C, locPort, remIP, remPort, res)	(* same as synchronous case *) ELSE	(* to do : make truly asynchronous. current same as OpenConnection. *) remAdr := SYSTEM.VAL(NetIP.Adr, remIP); NEW(C); NetTCP.Connect(conC, locPort, remAdr, remPort, C.res); IF C.res = NetTCP.Done THEN C.port := conC; C.state := inout; C.Available := TCPAvailable; C.Send := TCPSend; C.Receive := TCPReceive; Kernel.RegisterObject(C, Cleanup, FALSE) ELSIF C.res # NetTCP.Timeout THEN C.res := error END; res := C.res END END AsyncOpenConnection; (** Procedure closes the connection. Connection can not be used for send operations afterwards. *) PROCEDURE CloseConnection* (C: Connection); BEGIN IF C # NIL THEN IF C.port IS NetTCP.Listener THEN C.state := closed; NetTCP.Close(C.port(NetTCP.Listener)) ELSIF C.port IS NetTCP.Connection THEN IF C.state = inout THEN C.state := in 			ELSIF C.state = out THEN C.state := closed END; NetTCP.Disconnect(C.port(NetTCP.Connection)) ELSE HALT(99) END; C.res := done END END CloseConnection; PROCEDURE Cleanup(c: SYSTEM.PTR); VAR s: ARRAY 20 OF CHAR; BEGIN WITH c: Connection DO 		IF c.state # closed THEN IF Trace THEN Kernel.WriteString("NetSystem: Cleanup "); ToNum(SYSTEM.VAL(IPAdr, c.port.rip), s); Kernel.WriteString(s); Kernel.WriteChar(":"); Kernel.WriteInt(c.port.rport, 1); Kernel.WriteLn END; CloseConnection(c) END END END Cleanup; (** 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.port IS NetTCP.Listener) & NetTCP.Requested(C.port(NetTCP.Listener)) 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 conC: NetTCP.Connection; BEGIN res := NetTCP.NotDone; IF C.port IS NetTCP.Listener THEN NetTCP.Accept(C.port(NetTCP.Listener), conC, res); IF res = NetTCP.Done THEN NEW(newC); newC.port := conC; newC.state := inout; newC.Available := TCPAvailable; newC.Send := TCPSend; newC.Receive := TCPReceive END END; C.res := res END Accept; (** Procedure returns the state of a connection (see constant section). *) PROCEDURE State* (C: Connection): INTEGER; BEGIN IF C.state IN {in, inout} THEN IF NetTCP.Connected(C.port(NetTCP.Connection)) THEN (* skip *) ELSE IF NetTCP.Available(C.port(NetTCP.Connection)) # 0 THEN	(* workaround for client errors *) (* skip *) ELSE IF C.state = inout THEN C.state := out ELSIF C.state = in THEN C.state := closed END END END END; RETURN C.state END State; (** Returns the number of bytes which may be read without blocking. *) PROCEDURE Available* (C: Connection): LONGINT; BEGIN RETURN C.Available(C, C.res) END Available; (** Blocking read a single byte. *) PROCEDURE Read* (C: Connection; VAR ch: CHAR); BEGIN C.Receive(C, ch, 0, 1, C.res) END Read; (** Blocking read len bytes of data (beginning at pos in buf) to buf. *) PROCEDURE ReadBytes* (C: Connection; pos, len: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE); BEGIN C.Receive(C, buf, pos, len, C.res); END ReadBytes; (** Blocking read two bytes in network byte ordering. *) PROCEDURE ReadInt* (C: Connection; VAR x: INTEGER); BEGIN C.Receive(C, x, 0, 2, C.res); NetBase.NetToHost(x) END ReadInt; (** Blocking read four bytes in network byte ordering. *) PROCEDURE ReadLInt* (C: Connection; VAR x: LONGINT); BEGIN C.Receive(C, x, 0, 4, C.res); NetBase.NetLToHost(x); END ReadLInt; (** Blocking read a string terminated by ( [CR]LF | 0X ). *) PROCEDURE ReadString* (C: Connection; VAR s: ARRAY OF CHAR); VAR ch, ch0: CHAR; i: INTEGER; BEGIN i := -1; ch := 0X; REPEAT INC(i); ch0 := ch; C.Receive(C, ch, 0, 1, C.res); s[i] := ch; UNTIL (C.res = error) OR (ch = 0X) OR (ch = LF); IF (ch = LF) & (ch0 = CR) THEN s[i - 1] := 0X ELSE s[i] := 0X END END ReadString; (** Blocking write a single byte to C. *) PROCEDURE Write* (C: Connection; ch: CHAR); BEGIN C.Send(C, ch, 0, 1, C.res) END Write; (** Blocking write len bytes of data (beginning at pos in buf) to C. *) PROCEDURE WriteBytes* (C: Connection; pos, len: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE); BEGIN C.Send(C, buf, pos, len, C.res) END WriteBytes; (** Blocking write two bytes in network byte ordering to C. *) PROCEDURE WriteInt* (C: Connection; x: INTEGER); BEGIN NetBase.HostToNet(x); C.Send(C, x, 0, 2, C.res) END WriteInt; (** Blocking write four bytes in network byte ordering to C. *) PROCEDURE WriteLInt* (C: Connection; x: LONGINT); BEGIN NetBase.HostLToNet(x); C.Send(C, x, 0, 4, C.res) END WriteLInt; (** Blocking write a string without "0X" and terminated by "CRLF" to C. *) PROCEDURE WriteString* (C: Connection; s: ARRAY OF CHAR); VAR cs: ARRAY 2 OF CHAR; i: INTEGER; BEGIN i := 0; WHILE s[i] # 0X DO INC(i) END; C.Send(C, s, 0, i, C.res); cs[0] := CR; cs[1] := LF; C.Send(C, cs, 0, 2, C.res) END WriteString; (** Procedure delivers the ip-number and port number of a connection's remote partner. *) PROCEDURE GetPartner* (C: Connection; VAR remIP: IPAdr; VAR remPort: INTEGER); BEGIN remPort := C.port.rport; remIP := SYSTEM.VAL(IPAdr, C.port.rip) END GetPartner; (** -- UDP section. *) (* Datagram oriented communication *) (** 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); BEGIN IF started THEN NEW(S); NetUDP.Open(S.C, locPort, NetIP.IPany, NetPorts.anyport, S.res); IF S.res = NetUDP.Done THEN S.state := inout ELSE S.C := NIL; S.res := error END; res := S.res ELSE res := error END END OpenSocket; (** Closes the socket. You can not receive datagrams anymore. *) PROCEDURE CloseSocket* (S: Socket); BEGIN S.state := closed; NetUDP.Close(S.C); S.C := NIL; S.res := done 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); BEGIN NetUDP.Send(S.C, SYSTEM.VAL(NetIP.Adr, remIP), remPort, buf, pos, len); S.res := done 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); BEGIN NetUDP.Receive(S.C, SYSTEM.VAL(NetIP.Adr, remIP), remPort, buf, pos, len); IF len >= 0 THEN S.res := done ELSE S.res := error END END ReceiveDG; (** Returns the size of the first available datagram on the socket. *) PROCEDURE AvailableDG* (S: Socket): LONGINT; BEGIN RETURN NetUDP.Available(S.C) 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 NetBase.HostToNet(x); SYSTEM.PUT(SYSTEM.ADR(buf[pos]), x) END PutInt; (** Write 4 bytes in network byte ordering to buf[pos]. *) PROCEDURE PutLInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; x: LONGINT); BEGIN NetBase.HostLToNet(x); SYSTEM.PUT(SYSTEM.ADR(buf[pos]), x) END PutLInt; (** Read 2 bytes in network byte ordering from buf[pos]. *) PROCEDURE GetInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: INTEGER); BEGIN SYSTEM.GET(SYSTEM.ADR(buf[pos]), x); NetBase.NetToHost(x) END GetInt; (** Read 4 bytes in network byte ordering from buf[pos]. *) PROCEDURE GetLInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: LONGINT); BEGIN SYSTEM.GET(SYSTEM.ADR(buf[pos]), x); NetBase.NetLToHost(x) END GetLInt; (** -- Passwords section. *) PROCEDURE WriteURL(VAR service, user, host: ARRAY OF CHAR); BEGIN Texts.WriteString(W, "NetSystem.SetUser "); Texts.WriteString(W, service); Texts.Write(W, ":"); Texts.WriteString(W, user);  Texts.Write(W, "@"); Texts.WriteString(W, host); Texts.WriteString(W, " ~"); Texts.WriteLn(W) END WriteURL; (** 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; r: Texts.Reader;  ch: 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 # "") & (user # "") THEN IF Oberon.Log.len > 0 THEN Texts.OpenReader(r, Oberon.Log, Oberon.Log.len-1); Texts.Read(r, ch); IF ch # CHR(13) THEN Texts.WriteLn(W) END END; WriteURL(service, user, host); Texts.Append(Oberon.Log, W.buf) 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 Reboot; VAR cmd: Modules.Command; m: Modules.Module; BEGIN m := Modules.ThisMod("System"); IF m # NIL THEN cmd := Modules.ThisCommand(m, "Reboot"); IF cmd # NIL THEN cmd END END END Reboot; PROCEDURE InputRead(VAR ch: CHAR);	(* not really clean *) BEGIN WHILE Input.Available = 0 DO NetBase.Poll END; Input.Read(ch); IF ch = 0FFX THEN Reboot END 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, ":&#47;/"); 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; (** -- Initialisation section. *) PROCEDURE SetDevices; VAR T: Texts.Text; device, name, arg: ARRAY 32 OF CHAR;  i: INTEGER; F: TextFrames.Frame; BEGIN NEW(T); i := 0; device := "Device0"; GetEntry("NetSystem.Hosts.", device, name, arg); WHILE (i < NetBase.MaxDevices) & (name # "") & (name[0] # "<") DO 		Texts.Open(T, ""); Texts.WriteString(W, name); Texts.Write(W, " ");  Texts.WriteString(W, arg); Texts.WriteLn(W); Texts.Append(T, W.buf); F := TextFrames.NewText(T, 0); TextFrames.Call(F, 0, FALSE); INC(i); device[6] := CHR(i+ORD("0")); GetEntry("NetSystem.Hosts.", device, name, arg) END END SetDevices; PROCEDURE SetRoutes; VAR route: NetIP.Route; key: ARRAY 64 OF CHAR; hostname, num, device, arp, dmy, gateway: ARRAY 64 OF CHAR; i, j, devnum: LONGINT; done: BOOLEAN; dev: NetBase.Device; BEGIN key := "NetSystem.Hosts.Route0."; i := 0; GetEntry0(key, "Device", device); WHILE (i < NetIP.MaxRoutes) & (device # "") DO 		Strings.Lower(device, device); IF device = "default" THEN devnum := 0 ELSIF Strings.Prefix("device", device) & (device[6] >= "0") & (device[6] <= "9") & (device[7] = 0X) THEN devnum := ORD(device[6])-ORD("0") ELSE devnum := -1 END; dev := NetBase.FindDevice(devnum); IF dev # NIL THEN NEW(route); route.dev := dev;  (*log := FALSE;*) GetEntry0(key, "Mode", arp); IF arp = "arp" THEN INCL(route.options, NetIP.arpopt) END; GetEntry(key, "Host", hostname, num); ToHost0(num, route.adr, done); IF ~done THEN	(* try using table *) FindAddress("NetSystem.Hosts.Table", route.dev.hostAdr, hostname, num); ToHost0(num, route.adr, done); (*log := log OR done*) END; IF ~done THEN (* ok if still to be assigned, e.g. PPP *) route.adr := NetIP.IPany	(* must be assigned later *) ELSE IF i = 0 THEN	(* first host *) COPY(hostname, hostName); hostIP := SYSTEM.VAL(IPAdr, route.adr) END END; GetEntry(key, "Gateway", gateway, num); ToHost0(num, route.gway, done); IF ~done THEN	(* ok if not arp, e.g. SLIP or PPP *) route.gway := NetIP.IPany END; GetEntry(key, "Netmask", dmy, num); ToHost0(num, route.subnet, done); IF ~done THEN	(* ok if not arp, e.g. SLIP or PPP *) route.subnet := NetIP.IPany	(* all destinations local *) END; IF (SYSTEM.VAL(LONGINT, anyIP) = SYSTEM.VAL(LONGINT, route.gway)) & (SYSTEM.VAL(LONGINT, anyIP) # SYSTEM.VAL(LONGINT, route.adr)) THEN (* gateway not set, but host adr set - attempt auto setting *) FOR j := 0 TO NetIP.AdrLen-1 DO	(* take host address AND subnet mask *) route.gway[j] := SYSTEM.VAL(CHAR, SYSTEM.VAL(SET, route.adr[j]) * 							SYSTEM.VAL(SET, route.subnet[j])) END; (* add .1 at end (common convention) *) route.gway[3] := SYSTEM.VAL(CHAR, SYSTEM.VAL(SET, route.gway[3]) + {0}); (*log := TRUE*) END; (* 			IF log THEN 				ToNum(SYSTEM.VAL(IPAdr, route.adr), s); 				Texts.WriteString(W, "IP: "); Texts.WriteString(W, s); 				ToNum(SYSTEM.VAL(IPAdr, route.subnet), s); 				Texts.WriteString(W, ", Subnet: ");  Texts.WriteString(W, s); 				ToNum(SYSTEM.VAL(IPAdr, route.gway), s); 				Texts.WriteString(W, ", Gateway: ");  Texts.WriteString(W, s); 				Texts.WriteLn(W);  Texts.Append(Oberon.Log, W.buf) 			END; *) NetIP.InstallRoute(route) ELSE Texts.WriteString(W, "Device ["); Texts.WriteString(W, device); Texts.WriteString(W, "] not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END; INC(i); key[21] := CHR(i+ORD("0")); GetEntry0(key, "Device", device) END END SetRoutes; PROCEDURE SetDns; VAR name, num, dns: ARRAY 64 OF CHAR; i, nodns: INTEGER; adr: NetIP.Adr; done: BOOLEAN; BEGIN nodns := 0; dns := "DNS0"; FOR i := 0 TO 3 DO 		dns[3] := CHR(i + ORD("0")); GetEntry("NetSystem.Hosts.", dns, name, num); IF (num # "") & (num[0] # "<") THEN ToHost0(num, adr, done); IF done THEN NetDNS.InstallDNS(name, adr); INC(nodns) END END END; IF nodns = 0 THEN ToHost0("129.132.98.12", adr, done); NetDNS.InstallDNS("dns1.ethz.ch", adr) END; END SetDns; PROCEDURE PollDevices(me: Oberon.Task); BEGIN NetBase.Poll END PollDevices; (** Command NetSystem.Start ~ Start up NetSystem. *) PROCEDURE Start*; VAR name, num: ARRAY 64 OF CHAR; pos: LONGINT;  ch: CHAR; BEGIN IF ~started THEN SetDevices; IF NetBase.FindDevice(0) # NIL THEN SetRoutes; NetDNS.Init; GetEntry("NetSystem.Hosts.", "Domain", name, num); IF name # "" THEN IF hostName # "" THEN	(* check hostname *) pos := 0; Strings.Search(".", hostName, pos); IF pos = -1 THEN	(* append domain name *) Strings.AppendCh(hostName, "."); Strings.Append(hostName, name) END END; NetDNS.InstallDom(name); ELSE NetDNS.InstallDom("ethz.ch") END; SetDns; started := NetIP.nofRoutes > 0; IF started THEN NetIP.SetDirectedCast(NetIP.routes[0]); NetBase.Start; NetIP.Start; NetPorts.Init; NetUDP.Start; NetTCP.Start; NEW(task); task.safe := TRUE; task.time := Oberon.Time;  task.handle := PollDevices; Oberon.Install(task); IF (hostName = "") & (SYSTEM.VAL(LONGINT, anyIP) # (SYSTEM.VAL(LONGINT, hostIP))) THEN (*Texts.WriteString(W, "Host: "); Texts.Append(Oberon.Log, W.buf);*) GetName(hostIP, hostName); pos := 0; LOOP ch := hostName[pos]; IF ch = 0X THEN EXIT END; IF (ch >= "A") & (ch <= "Z") THEN ch := CHR(ORD(ch)+32) END; hostName[pos] := ch; INC(pos) END; IF pos = 0 THEN hostName := "x.oberon.ethz.ch" END; (*Texts.WriteString(W, hostName); Texts.WriteLn(W)*) END; Texts.WriteString(W, "NetSystem started"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) ELSE Texts.WriteString(W, "Oberon.Text - NetSystem not configured"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END ELSE Texts.WriteString(W, "Oberon.Text - No network driver configured"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END END Start; (** Command NetSystem.Stop ~ Shut down NetSystem. *) PROCEDURE Stop*; BEGIN IF Kernel.shutdown = 0 THEN IF task # NIL THEN Oberon.Remove(task); task := NIL END; NetTCP.Stop; NetUDP.Stop; NetIP.Stop; NetBase.Stop; hostName := ""; started := FALSE; Texts.WriteString(W, "NetSystem stopped"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END Stop; (** Command NetSystem.Show ~ Display status. *) PROCEDURE Show*; VAR s: ARRAY 32 OF CHAR; r: NetIP.Route;  dev: NetBase.Device;  i: LONGINT;  p: Password; BEGIN IF started THEN p := passwords; WHILE p # NIL DO WriteURL(p.service, p.user, p.host); p := p.next END; Texts.WriteString(W, "Host: "); ToNum(hostIP, s);  Texts.WriteString(W, s); Texts.WriteString(W, " / "); Texts.WriteString(W, hostName); Texts.WriteString(W, " / "); Texts.WriteString(W, NetDNS.dom[0]); Texts.WriteLn(W); i := 0; LOOP dev := NetBase.FindDevice(i); IF dev = NIL THEN EXIT END; Texts.WriteString(W, "Device"); Texts.WriteInt(W, i, 1); Texts.WriteString(W, ": "); CASE dev.state OF 				NetBase.closed: Texts.WriteString(W, "closed") |NetBase.open: Texts.WriteString(W, "open") |NetBase.pending: Texts.WriteString(W, "pending") ELSE Texts.WriteInt(W, dev.state, 1) END; Texts.Write(W, " "); AdrToStr(dev.hostAdr, s); Texts.WriteString(W, s);  Texts.WriteString(W, " / "); AdrToStr(dev.castAdr, s); Texts.WriteString(W, s); Texts.WriteLn(W); INC(i) END; FOR i := 0 TO NetIP.nofRoutes-1 DO 			r := NetIP.routes[i]; Texts.WriteString(W, "Route"); Texts.WriteInt(W, i, 1);  Texts.WriteString(W, ": "); ToNum(SYSTEM.VAL(IPAdr, r.adr), s); Texts.WriteString(W, s);  Texts.WriteString(W, " / "); ToNum(SYSTEM.VAL(IPAdr, r.subnet), s); Texts.WriteString(W, s);  Texts.WriteString(W, " / "); ToNum(SYSTEM.VAL(IPAdr, r.gway), s); Texts.WriteString(W, s);  Texts.WriteString(W, " -> "); Texts.WriteInt(W, r.dev.num, 1); IF NetIP.arpopt IN r.options THEN Texts.WriteString(W, " arp") ELSE Texts.WriteString(W, " noarp") END; Texts.WriteLn(W) END; Texts.WriteString(W, "DNS: "); FOR i := 0 TO NetDNS.nofdns-1 DO 			ToNum(SYSTEM.VAL(IPAdr, NetDNS.server[i].adr), s); Texts.WriteString(W, s); IF i = NetDNS.dns THEN Texts.Write(W, "*") END; IF i # NetDNS.nofdns-1 THEN Texts.WriteString(W, " / ") END END; Texts.WriteLn(W) END; Texts.Append(Oberon.Log, W.buf) END Show; BEGIN task := NIL; anyIP := SYSTEM.VAL(IPAdr, NetIP.IPany); allIP := SYSTEM.VAL(IPAdr, NetIP.IPall); hostName := ""; hex := "0123456789ABCDEF"; Texts.OpenWriter(W); started := FALSE; passwords := NIL; Start; Kernel.InstallTermHandler(Stop) END NetSystem. Tasks NetBase.Poll for all devices, if Available then allocate item, Receive, multiplex upcall: NetIP.ArpReceive - send arp queued packets & reply to arp request NetIP.IPReceive - queue up to 30 packets in NetIP.ipq NetIP.IPDemux for all items in NetIP.ipq, check header, multiplex upcall: NetUDP.Input - find connection c & put up to 20 items to c.rq 			NetTCP.Demux - handle some items or put up to 30 items in c.rq 	NetTCP.TcpReceive one task per connection. for all items in c.rq, call c.handle NetIP.Timer every 3 seconds, process arp cache NetTCP.Timer process events in NetTCP.sq (deleteev, sendev, retransev, persistev) Install NetIP.StartTimer NetBase.InstallProtocol(ArpReceive, arpid)	(* 806H *) timer.handle := Timer; Oberon.Install(timer) NetIP.StartIP NetBase.InstallProtocol(IPReceive, ipid)	(* 800H *) NetUDP.Start NetIP.InstallDemux(Input, NetIP.UDP)	(* 17 *) NetTCP.Start NetIP.InstallDemux(Demux, NetIP.TCP)	(* 6 *) timer.handle := Timer; Oberon.Install(timer) NetTCP.ProcListen (from NetTCP.Demux) T.handle := TcpReceive; Oberon.Install(T) NetTCP.Connect T.handle := TcpReceive; Oberon.Install(T) Modification NetSystem.TCPSetState fold into State bug: NetTCP.Poll does not check window... ? Other uses of Oberon & Texts NetSystem Oberon.Par, Oberon.Log, Oberon.OpenScanner, Texts.* SLIP.InstallDevice Oberon.Par, Texts.Scanner PPPHDLC Timeout task PPPMain Oberon.OpenScanner Connect task Connection state (old) closed, listening, in, out, inout, waitCon, errorCon inout -> out	TCPSetState	~NetTCP.Connected in -> closed	TCPSetState	~NetTCP.Connected * -> listening	OpenConnection	listening connection * -> inout	OpenConnection	talking connection * -> closed	CloseConnection	listening connection inout -> in	CloseConnection	talking connection out -> closed	CloseConnection	talking connection * -> inout	Accept	arriving connection * -> waitCon	AsyncOpenConnection waitCon -> inout waitCon -> errorCon * -> inout	OpenSocket * -> closed	CloseSocket Dialer.Dial Dialer.Hangup NetSystem.Stop System.Free NetSystem SLIP NetTCP NetDNS NetUDP NetPorts NetIP NetBase ~ NetSystem.Start Find.All ^ Find.Domain NetBase.Mod NetIP.Mod NetPorts.Mod NetUDP.Mod NetTCP.Mod NetDNS.Mod NetSystem.Mod ~ Compiler.Compile NetBase.Mod\s NetIP.Mod\s NetPorts.Mod\s NetUDP.Mod\s NetTCP.Mod\s NetDNS.Mod\s NetSystem.Mod Net3Com509.Mod ~ Compiler.Compile *\x