Oberon/V2/Net

MODULE Net; (*NW 3.7.88 / 25.8.91*) IMPORT SCC, Files, Viewers, Texts, TextFrames, MenuViewers, Oberon; CONST PakSize = 512; T0 = 300; T1 = 1000; (*timeouts*) ACK = 10H; NAK = 25H; NPR = 26H; (*acknowledgements*) NRQ = 34H; NRS = 35H; (*name request, response*) SND = 41H; REC = 42H; MSG = 44H; VAR W: Texts.Writer; Server: Oberon.Task; head0, head1: SCC.Header; partner, dmy: ARRAY 8 OF CHAR; protected: BOOLEAN; (*write-protection*) PROCEDURE SetPartner(VAR name: ARRAY OF CHAR); BEGIN head0.dadr := head1.sadr; COPY(name, partner) END SetPartner; PROCEDURE Send(t: SHORTINT; L: INTEGER; VAR data: ARRAY OF CHAR); BEGIN head0.typ := t; head0.len := L; SCC.SendPacket(head0, data) END Send; PROCEDURE ReceiveHead(timeout: LONGINT); VAR time: LONGINT; BEGIN time := Oberon.Time + timeout; LOOP SCC.ReceiveHead(head1); IF head1.valid THEN IF head1.sadr = head0.dadr THEN EXIT ELSE SCC.Skip(head1.len) END ELSIF Oberon.Time >= time THEN head1.typ := -1; EXIT END END END ReceiveHead; PROCEDURE FindPartner(VAR name: ARRAY OF CHAR; VAR res: INTEGER); VAR time: LONGINT; k: INTEGER; BEGIN SCC.Skip(SCC.Available); res := 0; IF name # partner THEN k := 0; WHILE name[k] > 0X DO INC(k) END ; head0.dadr := -1; Send(NRQ, k+1, name); time := Oberon.Time + T1; LOOP SCC.ReceiveHead(head1); IF head1.valid THEN IF head1.typ = NRS THEN SetPartner(name); EXIT ELSE SCC.Skip(head1.len) END ELSIF Oberon.Time >= time THEN res := 1; partner[0] := 0X; EXIT END END END END FindPartner; PROCEDURE AppendS(VAR s, d: ARRAY OF CHAR; VAR k: INTEGER); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = 0X END AppendS; PROCEDURE AppendW(s: LONGINT; VAR d: ARRAY OF CHAR; 		n: INTEGER; VAR k: INTEGER); VAR i: INTEGER; BEGIN i := 0; REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n 	END AppendW; PROCEDURE PickS(VAR s: ARRAY OF CHAR); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT SCC.Receive(ch); s[i] := ch; INC(i) UNTIL ch = 0X END PickS; PROCEDURE PickQ(VAR w: LONGINT); VAR c0, c1, c2: CHAR; s: SHORTINT; BEGIN SCC.Receive(c0); SCC.Receive(c1); SCC.Receive(c2); SCC.Receive(s); w := s; w := ((w * 100H + LONG(c2)) * 100H + LONG(c1)) * 100H + LONG(c0) END PickQ; PROCEDURE SendData(F: Files.File); VAR k: INTEGER; seqno: SHORTINT; x: CHAR; len: LONGINT; R: Files.Rider; buf: ARRAY PakSize OF CHAR; BEGIN Files.Set(R, F, 0); len := 0; seqno := 0; LOOP k := 0; LOOP Files.Read(R, x); IF R.eof THEN EXIT END ; buf[k] := x; INC(k); IF k = PakSize THEN EXIT END END ; REPEAT Send(seqno, k, buf); ReceiveHead(T1) UNTIL head1.typ # seqno + ACK; seqno := (seqno + 1) MOD 8; len := len + k; 			IF head1.typ # seqno + ACK THEN Texts.WriteString(W, " failed"); EXIT END ; IF k < PakSize THEN EXIT END END ; Texts.WriteInt(W, len, 7) END SendData; PROCEDURE ReceiveData(F: Files.File; VAR done: BOOLEAN); VAR k, retry: INTEGER; seqno: SHORTINT; x: CHAR; len: LONGINT; R: Files.Rider; BEGIN Files.Set(R, F, 0); seqno := 0; len := 0; retry := 2; LOOP IF head1.typ = seqno THEN seqno := (seqno + 1) MOD 8; len := len + head1.len; retry := 2; Send(seqno + ACK, 0, dmy); k := 0; WHILE k < head1.len DO 					SCC.Receive(x); Files.Write(R, x); INC(k) END ; IF k < PakSize THEN done := TRUE; EXIT END ELSE DEC(retry); IF retry = 0 THEN Texts.WriteString(W, " failed"); done := FALSE; EXIT END ; Send(seqno + ACK, 0, dmy) END ; ReceiveHead(T0) END ; Texts.WriteInt(W, len, 7) END ReceiveData; PROCEDURE reply(msg: INTEGER); BEGIN CASE msg OF 			0: | 1: Texts.WriteString(W, " no link") | 2: Texts.WriteString(W, " no permission") | 3: Texts.WriteString(W, " not done") | 4: Texts.WriteString(W, " not found") | 5: Texts.WriteString(W, " no response") END ; Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END reply; PROCEDURE* Serve; VAR i: INTEGER; done: BOOLEAN; ch: CHAR; F: Files.File; pw: LONGINT; Id: ARRAY 10 OF CHAR; FileName: ARRAY 32 OF CHAR; BEGIN SCC.ReceiveHead(head1); IF head1.valid THEN IF head1.typ = SND THEN PickS(Id); PickQ(pw); PickS(FileName); Texts.WriteString(W, Id); Texts.Write(W, " "); Texts.WriteString(W, FileName); F := Files.Old(FileName); IF F # NIL THEN Texts.WriteString(W, " sending"); SetPartner(Id); Texts.Append(Oberon.Log, W.buf); SendData(F) ELSE Send(NAK, 0, dmy); Texts.Write(W, "~") END ; reply(0) ELSIF head1.typ = REC THEN PickS(Id); PickQ(pw); PickS(FileName); IF ~protected THEN Texts.WriteString(W, Id); Texts.Write(W, " "); Texts.WriteString(W, FileName); F := Files.New(FileName); IF F # NIL THEN Texts.WriteString(W, " receiving"); SetPartner(Id); Texts.Append(Oberon.Log, W.buf); Send(ACK, 0, dmy); ReceiveHead(T0); ReceiveData(F, done); IF done THEN Files.Register(F) END ELSE Send(NAK, 0, dmy); Texts.Write(W, "~") END ; reply(0) ELSE Send(NPR, 0, dmy) END ELSIF head1.typ = MSG THEN i := 0; WHILE i < head1.len DO SCC.Receive(ch); Texts.Write(W, ch); INC(i) END ; Send(ACK, 0, dmy); reply(0) ELSIF head1.typ = NRQ THEN i := 0; LOOP SCC.Receive(ch); Id[i] := ch; INC(i); IF ch = 0X THEN EXIT END ; IF i = 7 THEN Id[7] := 0X; EXIT END END ; WHILE i < head1.len DO SCC.Receive(ch); INC(i) END ; IF Id = Oberon.User THEN SetPartner(Id); Send(NRS, 0, dmy) END ELSE SCC.Skip(head1.len) END END END Serve; PROCEDURE GetPar1(VAR S: Texts.Scanner); BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S) END GetPar1; PROCEDURE GetPar(VAR S: Texts.Scanner; VAR end: LONGINT); VAR T: Texts.Text; beg, tm: LONGINT; BEGIN Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, tm); IF tm >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END ELSE end := Oberon.Par.text.len END END GetPar; PROCEDURE SendFiles*; VAR k: INTEGER; end: LONGINT; S: Texts.Scanner; F: Files.File; name: ARRAY 32 OF CHAR; buf: ARRAY 64 OF CHAR; BEGIN GetPar1(S); IF S.class = Texts.Name THEN FindPartner(S.s, k); IF k = 0 THEN GetPar(S, end); LOOP IF S.class # Texts.Name THEN EXIT END ; Texts.WriteString(W, S.s); k := 0; AppendS(S.s, name, k); IF S.nextCh = ":" THEN (*prefix*) Texts.Scan(S); Texts.Scan(S); IF S.class = Texts.Name THEN name[k-1] := "."; AppendS(S.s, name, k); Texts.Write(W, ":"); Texts.WriteString(W, S.s) 						END END ; F := Files.Old(S.s); IF F # NIL THEN k := 0; AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k); AppendS(name, buf, k); Send(REC, k, buf); ReceiveHead(T0); IF head1.typ = ACK THEN Texts.WriteString(W, " sending"); Texts.Append(Oberon.Log, W.buf); SendData(F); reply(0) ELSIF head1.typ = NPR THEN reply(2); EXIT ELSIF head1.typ = NAK THEN reply(3); EXIT ELSE reply(5); EXIT END ELSE reply(4) END ; IF Texts.Pos(S) >= end THEN EXIT END ; Texts.Scan(S) END ELSE reply(1) END END END SendFiles; PROCEDURE ReceiveFiles*; VAR k: INTEGER; done: BOOLEAN; end: LONGINT; S: Texts.Scanner; F: Files.File; name: ARRAY 32 OF CHAR; buf: ARRAY 64 OF CHAR; BEGIN GetPar1(S); IF S.class = Texts.Name THEN FindPartner(S.s, k); IF k = 0 THEN GetPar(S, end); LOOP IF S.class # Texts.Name THEN EXIT END ; Texts.WriteString(W, S.s); k := 0; AppendS(S.s, name, k); IF S.nextCh = ":" THEN (*prefix*) Texts.Scan(S); Texts.Scan(S); IF S.class = Texts.Name THEN name[k-1] := "."; AppendS(S.s, name, k); Texts.Write(W, ":"); Texts.WriteString(W, S.s) 						END END ; k := 0; AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k); AppendS(name, buf, k); Send(SND, k, buf); Texts.WriteString(W, " receiving"); Texts.Append(Oberon.Log, W.buf); ReceiveHead(T1); IF head1.typ = 0 THEN F := Files.New(S.s); IF F # NIL THEN ReceiveData(F, done); IF done THEN Files.Register(F); reply(0) ELSE EXIT END ELSE reply(3); Send(NAK, 0, dmy) END ELSIF head1.typ = NAK THEN reply(4) ELSIF head1.typ = NPR THEN reply(2); EXIT ELSE reply(5); EXIT END ; IF Texts.Pos(S) >= end THEN EXIT END ; Texts.Scan(S) END ELSE reply(1) END END END ReceiveFiles; PROCEDURE SendMsg*; VAR i: INTEGER; ch: CHAR; S: Texts.Scanner; msg: ARRAY 64 OF CHAR; BEGIN GetPar1(S); IF S.class = Texts.Name THEN FindPartner(S.s, i); IF i = 0 THEN Texts.Read(S, ch); WHILE (ch >= " ") & (i < 64) DO 					msg[i] := ch; INC(i); Texts.Read(S, ch) END ; Send(MSG, i, msg); ReceiveHead(T0); IF head1.typ # ACK THEN reply(3) END ELSE reply(1) END END END SendMsg; PROCEDURE StartServer*; BEGIN protected := TRUE; SCC.Start(TRUE); Oberon.Remove(Server); Oberon.Install(Server); Texts.WriteString(W, " Server started"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END StartServer; PROCEDURE Unprotect*; BEGIN protected := FALSE END Unprotect; PROCEDURE WProtect*; BEGIN protected := TRUE END WProtect; PROCEDURE Reset*; BEGIN SCC.Start(TRUE) END Reset; PROCEDURE StopServer*; BEGIN Oberon.Remove(Server); Texts.WriteString(W, " Server stopped"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END StopServer; BEGIN Texts.OpenWriter(W); NEW(Server); Server.handle := Serve END Net.