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.