Oberon/ETH Oberon/PPPHDLC.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) (* $VCS  1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:13:54 $ *) MODULE PPPHDLC;	(** non-portable *) (* $Log$ $  1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:13:54 version for PPP 1.0.0 *) IMPORT Debug := PPPDebug, SYSTEM, T:=PPPTools, (*es*) Oberon, Ker:=Kernel, V24, PT := NetBase, Input, Out, Strings; (* Ker:=PPCXOKernel, P:=Peripherals; *) CONST HDLCAddress=0FFX; HDLCControl=03X; HDLCHeaderLen* = 4;	(* Flag + Address, Protocol (2 Byte) *) EscSymbol = 7DX; FlagSymbol = 7EX; MTU*=1500; StartPos*=4;	(* even if we received a packed Packet, we can send back an unpacked one, using the same array *) ArrayLength* = MTU+100;	(* some bytes more needed *) TYPE Params* = POINTER TO ParamsDesc; ParamsDesc* = RECORD END; CallbackProc*=PROCEDURE (p:Params); TimeOut = POINTER TO TimeOutDesc; TimeOutDesc = RECORD time: LONGINT; callback: CallbackProc;	params: Params; next: TimeOut; END; PPPUnit* = POINTER TO PPPUnitDesc; MyTask* = POINTER TO MyTaskDesc; MyTaskDesc = RECORD (*es*) (Oberon.TaskDesc) (* (Ker.MainEventDesc) (* Oberon.TaskDesc *) *) Config*:PPPUnit; END; PPPUnitDesc* = RECORD MTU*, MRU*:INTEGER;		(* Maximum Transmit Unit, how big our packets are; M Receive U, how big he may send*) SendAsyncMap*:SET;		(* Transmit AsyncMap; What characters have to be stuffed *) (*es*) c*: LONGINT; (* c*: P.SerialChannel; *) cname*:ARRAY 32 OF CHAR; task*: MyTask; data, data2*: ARRAY ArrayLength OF CHAR; TOqueue: TimeOut; TOempty: BOOLEAN; END; VAR (*es*) debug*: BOOLEAN; TOtask: Oberon.Task; (* check for timeout *) TOunit: PPPUnit; (* instead of extending task *) (*TOrecycle: TimeOut;*) FrameCount: INTEGER; (* pe: number frames for reference. *) (*es*) (* Save incomplete frames between calls to Receive *) receiveFrame: RECORD active: BOOLEAN; (* ready to receive data *) (*deadline: LONGINT; (* until we want to receive the end *)*) i: INTEGER; (* index of last received byte in receive buffer *) esc: BOOLEAN; (* last byte received was EscSymbol *) END; (**)PPPHandleReceive*: PROCEDURE (U:PPPUnit; prot:INTEGER; VAR p: ARRAY OF CHAR; 			pos, len:INTEGER; VAR prno: INTEGER; VAR item: PT.Item); PROCEDURE SendString(c: (*es*)LONGINT(*P.SerialChannel*); 												VAR s: ARRAY OF CHAR); VAR l0, l1, start: LONGINT; (*es*)res: LONGINT;(**) BEGIN l0 := 0; WHILE s[l0] # 0X DO INC(l0) END; l1 := l0; start := 0; (*es*) WHILE l0 > 0 DO 			V24.SendBytes(c, s, l1, res); DEC(l0, l1); END (*	WHILE l0 > 0 DO 			c.Write(s, start, l1); 			DEC(l0, l1); INC(start, l1) 		END *) END SendString; (* Init *) PROCEDURE Init* (Config:PPPUnit; 									c:(*es*)LONGINT(* P.SerialChannel*);  						VAR cname, sstr, loginname, loginpasswd: ARRAY OF CHAR); VAR to:TimeOut; l: LONGINT; temp: ARRAY 4 OF CHAR; cr: ARRAY 2 OF CHAR; (*es*)res: LONGINT;(**) BEGIN Config.c := c; COPY(cname, Config.cname); (*es??? die V24 und Loginsachen macht doch der Dialer. Oder ? 	(* V24 login is handled by the Dialer, isn't it? *) 		WHILE V24.Available(c) > 0 DO V24.Receive(c, temp[0],res); END; 		(* WHILE c.Available > 0 DO l := 1; c.Read(temp, 0, l) END; *) 		(* send start string *) 		IF sstr[0] # 0X THEN 			SendString(c, sstr); 			(* consume some bytes (they contain the reply string from server) *) 			REPEAT 				WHILE c.Available > 0 DO l := 1; c.Read(temp, 0, l) END; 				Ker.Sleep(1, Ker.ONEsec) 			UNTIL c.Available = 0 		END; 		IF loginname[0] # 0X THEN	(* start normal unix-login procedure *) 			cr[0] := 0DX; cr[1] := 0X; 			(* send two CR *) 			SendString(c, cr); Ker.Sleep(1, Ker.ONEsec); 			SendString(c, cr); Ker.Sleep(5,Ker.ONEsec); 			(* send loginname *) 			SendString(c, loginname); SendString(c, cr); 			Ker.Sleep(1, Ker.ONEsec); 			(* send loginpasswd *) 			SendString(c, loginpasswd); SendString(c, cr); 			Ker.Sleep(1, Ker.ONEsec); 		END; 		REPEAT 			WHILE c.Available > 0 DO  				l := 1; c.Read(temp, 0, l); Debug.Int(ORD(temp[0]),4); IF (temp[0] >= 20X) & (temp[0] <= 7FX) THEN Debug.Char(9X); Debug.Char(temp[0]) END; Debug.Ln; END; Ker.Sleep(5,Ker.ONEsec); Debug.Ln; UNTIL c.Available = 0; es*) 		Debug.String("Starting receiving-loop"); Debug.Ln; 		NEW(Config.task); Config.task.Config:=Config;	 		(*es???*) Debug.String("Pustekuchen, macht Devicepolling"); Debug.Ln; 		(* pe *) Debug.String("Begin communicating with the remote system."); Debug.Ln; 		Debug.String("Configure the timeout."); Debug.Ln; 		(*Ker.InitMain(Config.task);*) 		NEW(to); Config.TOqueue:=to; to.next:=to; 		to.time:=MAX(LONGINT); Config.TOempty:=TRUE;	(* sentinel *) 	END Init; 	PROCEDURE CheckTimer((*es*)me: Oberon.Task(*C: PPPUnit*)); 	(* Called only when TOqueue is not empty *) 		VAR cur:TimeOut; 	BEGIN 		cur:=(*es*)TOunit(*C*).TOqueue;  		IF cur.time < (*es*)Input.Time(*Ker.Time*) THEN   (*es*)  Oberon.Remove(me);  			IF TOunit.cname # "" THEN 				(* output only if ppp is still running. See PPPMain.StopInst *) 				Out.String("PPP timeout"); Out.Ln; 			END; (**) 			(*es*)TOunit(*C*).TOempty:=TRUE; 			cur.callback(cur.params); 		END 	END CheckTimer; 	(* TimeOut Handling *) 	PROCEDURE TIMEOUT* (C: PPPUnit; callb:CallbackProc; p:Params; msec:LONGINT); (* msec: in microS-sec *) 	VAR cur:TimeOut; 	BEGIN 		cur:=C.TOqueue; cur.callback:=callb; cur.params:=p; 		cur.time:=(*es*) Input.Time(*Ker.Time*)+msec;	 		C.TOempty:=FALSE; 		(*es install timer task *) 		TOtask.safe := FALSE; TOtask.time := 0; 		TOtask.handle := CheckTimer; 		Oberon.Install(TOtask); 		TOunit := C; 		(**) 	END TIMEOUT; 	PROCEDURE UNTIMEOUT* (C: PPPUnit; callb:CallbackProc); 	BEGIN	 		C.TOempty:=TRUE; 		(*es*) Oberon.Remove(TOtask); (**) 	END UNTIMEOUT; 	(* CheckPacket - Check  a HDLC-Packet *) 	PROCEDURE CheckPacket(Config: PPPUnit; VAR p: ARRAY OF CHAR; pos, len:INTEGER; VAR prno: INTEGER; VAR item: PT.Item);    (*es*)VAR timeStr: ARRAY 16 OF CHAR; time, date: LONGINT;(**) 	BEGIN 		IF debug THEN 			(* pe *) Debug.String('->->-> Frame '); Debug.Int(FrameCount, 5);  			Debug.String(' received from peer.'); Debug.Ln; 			INC(FrameCount); (* pe *) 			Oberon.GetClock(time, date); 			Strings.TimeToStr(time,timeStr);  			Debug.String(timeStr);  			Debug.String('CheckPacket: len = '); Debug.Int(len, 5); Debug.Ln;  			T.OutPacket(p, pos, len); 		END; 		IF len > HDLCHeaderLen+2 THEN  			(*[HDLC_Address+HDLC-Control+Protocol] + Checksum (2 Bytes)*) 			IF T.CheckFCS(p, pos, len) THEN  				(* CheckSum ok? The whole packet needed! *) 				IF (p[pos] = HDLCAddress) & (p[pos+1] = HDLCControl) THEN 					PPPHandleReceive(Config, T.GetInt(p, pos+2), p, pos+4, len-6, prno, item); 				ELSE (* silently discarded *) 					IF debug THEN 						Debug.String("Address, Code wrong"); Debug.Ln;  					END; 				END 			ELSE 				IF debug THEN Debug.String("Checksum failure"); Debug.Ln END 			END 		ELSE  			IF debug & (len > 0) THEN  				Debug.String("Length too short, length: ");  				Debug.Int(len, 6); Debug.Ln;  			END; 		END 	END CheckPacket; 	PROCEDURE XOR20(ch:LONGINT):LONGINT; 	BEGIN RETURN SYSTEM.VAL(LONGINT, (SYSTEM.VAL(SET, ch) / {5} )); 	END XOR20; 	(* ReceivePacket - ReceiveLoop: Task, needs extended Event (including PPPUnit)*) (*es*) (* ReceivePacket is indirectly called by NetBase.Polldevices when characters at the serial interface are available. So just read the characters into a buffer (Config.data) and return prno=0 (no handler installed for this 	protocol hopefully). When you get end of frame (FlagSymbol) then check it and return the stuff. *) (**)PROCEDURE ReceivePacket*(Config: PPPUnit; VAR prno: INTEGER; VAR item: PT.Item); 	VAR (*es*) (*i:INTEGER;*) 		ch: ARRAY 4 OF CHAR; l: LONGINT; 		(*es*)c, res, endTime: LONGINT; timeOut : TimeOut; 		(* c: P.SerialChannel; *) 	BEGIN 		c:=Config.c; 		(*es*)(* i:=StartPos; ch[0]:=0X;	(* not Esc-Symbol *) *) (*es*)IF receiveFrame.active THEN 			prno := 0; 		ELSE 			(*receiveFrame.deadline := Input.Time + 10(*s*) * Input.TimeUnit;*) 			receiveFrame.i := StartPos; 			receiveFrame.active := TRUE; 			receiveFrame.esc := FALSE; 			ch[0]:=0X; 		END; 		IF receiveFrame.esc THEN ch[0] := EscSymbol ELSE ch[0]:=0X; END; (**) LOOP 			IF (*es*)V24.Available(c)(*c.Available*)>0 THEN		 				(* New chars in buffer ? *) 				IF ch[0] (* last received *) #EscSymbol THEN 					(*es*) V24.Receive(c, ch[0], res); 					(*l := 1; c.Read(ch, 0, l);*) 					IF ch[0] = FlagSymbol THEN (* end of frame received *) 						CheckPacket(Config, Config.data, StartPos, receiveFrame.i-StartPos, prno, item); (*es*)			 (* data now in item *) receiveFrame.active := FALSE; RETURN; 						(* receiveFrame.i:=StartPos; *) 					ELSE 						IF ch[0] # EscSymbol THEN  							Config.data[receiveFrame.i]:=ch[0];  							INC(receiveFrame.i) ; (*es*)				 receiveFrame.esc := FALSE; 						ELSE 							receiveFrame.esc := TRUE; (**) 				END 					END; 				ELSE 					(*es*) V24.Receive(c, ch[0], res); receiveFrame.esc := FALSE; 					(*l := 1; c.Read(ch, 0, l);*) 					Config.data[receiveFrame.i]:=CHR(XOR20(ORD(ch[0]))); 					INC(receiveFrame.i); ch[0]:=0X; (* not Esc-,or Flag-Symbol *) 				END; 				IF receiveFrame.i>=ArrayLength THEN  					Debug.String("Array Overflow!!");  					 (* HALT(99); *)  					receiveFrame.active := FALSE; RETURN 				END; 			ELSE 				RETURN; (* pause until more characters are available *) (**) 			END; 		END 	END ReceivePacket; 	(* SendPacket - Send a packet to the V24 *) PROCEDURE SendPacket* (Config: PPPUnit; prot:INTEGER; 						VAR p:ARRAY OF CHAR; pos, len:INTEGER); VAR minpos, code, k, begin: INTEGER; ch: ARRAY 4 OF CHAR; l0, l1, start: LONGINT; x: CHAR; (*es*)c, res: LONGINT; timeStr: ARRAY 16 OF CHAR; time, date: LONGINT; (*c: P.SerialChannel;*) BEGIN c:=Config.c; 		minpos:=HDLCHeaderLen; IF pos<minpos THEN T.CopyString(p, pos, minpos, len); pos:=minpos; END;	(* More space needed *) DEC(pos, HDLCHeaderLen); INC(len, HDLCHeaderLen); p[pos]:=0FFX; p[pos+1]:=03X;		(* pos + 0: HDLC_Address = 0FFX; pos + 1: HDLC_Control =3X *) T.PutInt(prot, p, pos+2);				(* pos + 2: Protocol *) code:=T.CalcFCS(p, pos, len); p[pos+len]:=CHR(code MOD 256); p[pos+len+1]:=CHR(SYSTEM.LSH(code, -8)); INC(len, 2); (* insert the checksum *) IF debug THEN (* pe *) Debug.String('<-<-<- Frame '); Debug.Int(FrameCount, 5); Debug.String(' going to peer.'); Debug.Ln; INC(FrameCount); (* pe *) Oberon.GetClock(time, date); Strings.TimeToStr(time,timeStr); Debug.String(timeStr); Debug.String(' SendPacket: len = '); Debug.Int(len, 5); Debug.Ln; T.OutPacket(p, pos, len); Debug.Ln 		END; (* send it to the V24 *) ch[0]:=FlagSymbol; l0 := 1; l1 := l0; start := 0; WHILE l0 > 0 DO 			(*es*)V24.Send(c,ch[start], res); (* c.Write(ch, start, l1); *) DEC(l0, l1); INC(start, l1) END; (* es auskommentiert: der Trick ist irgendwie alle Zeichen zu sammeln, 	die man ohne Maskierung (EscSymbol) senden kann. Wenn man dann 	auf eines trifft, verpackt man es und schickt die Dinger von zuvor 	auf weg. Das ist mir etwas zu undurchsichtig. 	Translation & remark from T.F.  	Section commented out: The trick is to somehow collect all the  	characters that can be sent without escaping (EscSymbol).  Once we  	come across a character that needs escaping, we send all the previously  	collected characters followed by the escaped character.  	It is probably some kind of "optimized code" that was translated and when  	it did not work was finally replaced by the version below the  	commented-out code.  From what I can tell the active code is better  	anyways (simpler).  If optimization is needed, AosIO could be used to collect  	the characters in a much simpler way. *) (*	begin:=pos; 		FOR k:=pos TO pos+len-1 DO	x:=p[k]; 			IF ((ORD(x)<20H) & (ORD(x) IN Config.SendAsyncMap)) 			OR (x=EscSymbol) OR (x=FlagSymbol) THEN 				l0 :=k-begin; l1 := l0; start := begin; 				WHILE l0 > 0 DO c.Write(p, start, l1); DEC(l0,l1); INC(start,l1);END; 				begin:=k+1; 				ch[0]:=EscSymbol; ch[1]:=CHR(XOR20(ORD(x)));  				l0 := 2; l1 := l0; start := 0; 				WHILE l0 > 0 DO c.Write(ch, start, l1); DEC(l0,l1); INC(start,l1);END;  			END; 		END; 		p[pos+len]:=FlagSymbol; l0 := pos+len+1-begin; l1 := l0; start := begin;  		WHILE l0 > 0 DO c.Write(p, start, l1); DEC(l0, l1); INC(start, l1); END; *) (*es*) FOR k:=pos TO pos+len-1 DO 			x:=p[k]; IF ((ORD(x)<20H) & (ORD(x) IN Config.SendAsyncMap)) OR (x=EscSymbol) OR (x=FlagSymbol) THEN V24.Send(c,EscSymbol, res); IF res # 0 THEN HALT(99); END; V24.Send(c,CHR(XOR20(ORD(x))), res); IF res # 0 THEN HALT(99); END; ELSE V24.Send(c, x, res); IF res # 0 THEN HALT(99); END; END; END; (* frame complete: send end flag *) V24.Send(c,FlagSymbol, res); IF res # 0 THEN HALT(99); END; (**) 	END SendPacket; BEGIN (* pe *) FrameCount := 0; debug := FALSE; (*es*) receiveFrame.active := FALSE; NEW(TOtask); (*NEW(TOrecycle); TOrecycle.next:=TOrecycle; (* Sentinel *)*) END PPPHDLC.