Oberon/ETH Oberon/2.3.7/PPPPAP.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 PPPPAP;	(** non-portable *) (* $VCS  2, Edgar@EdgarSchwarz.de, 9 May :0, 1:19:15 $     $Log$ $   2, Edgar@EdgarSchwarz.de, 9 May :0, 1:19:15 log message of PAP NAK $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:18:18 version for PPP 1.0.0 *) IMPORT HDLC:=PPPHDLC, T:=PPPTools, Debug:=PPPDebug, SYSTEM; CONST (* Protocol Constants *) PAPProt* = -3FDDH;	(* = 0C023H*) PAPReq = 1; PAPAck = 2; PAPNak = 3; Initial* = 0;			(* Connection down *) Closed* = 1;		(*Connection up, haven't requested auth *) Pending* = 2;		(* Connection down, have requested auth *) AuthReq* = 3;	(* We have send an Auth-Request *) Open* = 4;		(* We've received an Ack *) BadAuth* = 5;	(* We've received an Nak *) PAPHeaderLen = 4;		(* code + id + len *) StartPos = HDLC.StartPos + HDLC.HDLCHeaderLen; DefTimeout = 30000; Defnrmaxtransmit = 10; TYPE PAPStat* = POINTER TO PAPStatDesc; MyParams = POINTER TO MyParamsDesc; MyParamsDesc = RECORD (HDLC.ParamsDesc) f: PAPStat END; PAPStatDesc* = RECORD PPPid: HDLC.PPPUnit; user, passwd: ARRAY 32 OF CHAR; timeout: LONGINT; userlen, passwdlen, nrtransmit, nrmaxtransmit: INTEGER; state*, id: SHORTINT; params: MyParams; END; PROCEDURE ^SendAuthReq(f: PAPStat); PROCEDURE ^ReceiveAuthAck(f: PAPStat; VAR p: ARRAY OF CHAR; pos, size: INTEGER); PROCEDURE ^ReceiveAuthNak(f: PAPStat; VAR p: ARRAY OF CHAR; pos, size: INTEGER); PROCEDURE Timeout(p: HDLC.Params); BEGIN WITH p: MyParams DO 			IF p.f.state = AuthReq THEN IF p.f.nrtransmit < p.f.nrmaxtransmit THEN SendAuthReq(p.f); ELSE p.f.state := BadAuth END END END END Timeout; (* LowerUp - The Lower Layer is Up *) PROCEDURE LowerUp*(f: PAPStat); BEGIN IF f.state = Initial THEN (* little hack *) f.nrtransmit := 0; SendAuthReq(f) (*f.state := Closed*) ELSE IF f.state = Pending THEN f.nrtransmit := 0; SendAuthReq(f) END END END LowerUp; (* LowerDown - The Lower Layer is Down *) PROCEDURE LowerDown*(f: PAPStat); BEGIN IF f.state = AuthReq THEN HDLC.UNTIMEOUT(f.PPPid, Timeout) END; f.state := Initial END LowerDown; (* Input *) PROCEDURE Input* (f: PAPStat; VAR p: ARRAY OF CHAR; pos, len:INTEGER); VAR code, id: SHORTINT; size: INTEGER; BEGIN IF len >= PAPHeaderLen THEN code := SHORT(ORD(p[pos])); id := SHORT(ORD(p[pos + 1])); size := T.GetInt(p, pos + 2); IF (size > PAPHeaderLen) & (size <= len) THEN DEC(size, PAPHeaderLen); CASE code OF 					|PAPReq: (* we never wanted to receive a request *) |PAPAck: ReceiveAuthAck(f, p, pos + PAPHeaderLen, size) |PAPNak: ReceiveAuthNak(f, p, pos + PAPHeaderLen, size) ELSE IF HDLC.debug THEN Debug.String("unknown AuthCode"); Debug.Ln END END END END END Input; PROCEDURE ReceiveAuthAck(f: PAPStat; VAR p: ARRAY OF CHAR; pos, size: INTEGER); VAR msglen: SHORTINT; BEGIN IF f.state = AuthReq THEN IF size > 0 THEN msglen := SHORT(ORD(p[pos])); (* print message from p[pos + 1] to p[pos + 1 + msglen] *) f.state := Open; END END END ReceiveAuthAck; PROCEDURE ReceiveAuthNak(f: PAPStat; VAR p: ARRAY OF CHAR; pos, size: INTEGER); VAR msglen: SHORTINT; (*es*) i: INTEGER; BEGIN IF f.state = AuthReq THEN IF size > 0 THEN msglen := SHORT(ORD(p[pos])); (* print message from p[pos + 1] to p[pos + 1 + msglen] *) (*es printing added, p[pos] seems to be the first character of message *) FOR i := 0 TO size-1 DO Debug.Char(p[pos + i]); END; Debug.Ln; (**) 				f.state := BadAuth; END END END ReceiveAuthNak; PROCEDURE SendAuthReq(f: PAPStat); VAR p: ARRAY HDLC.ArrayLength OF CHAR; i, len: INTEGER; BEGIN i := StartPos; p[i] := CHR(PAPReq); INC(i); INC(f.id); p[i] := CHR(f.id); INC(i); len := PAPHeaderLen + 2 + f.userlen + f.passwdlen; T.PutInt(len, p, i); INC(i, 2); p[i] := CHR(f.userlen); INC(i); SYSTEM.MOVE(SYSTEM.ADR(f.user), SYSTEM.ADR(p[i]), f.userlen); INC(i, f.userlen); p[i] := CHR(f.passwdlen); INC(i); SYSTEM.MOVE(SYSTEM.ADR(f.passwd), SYSTEM.ADR(p[i]), f.passwdlen); INC(i, f.passwdlen); HDLC.SendPacket(f.PPPid, PAPProt, p, StartPos, len); INC(f.nrtransmit); HDLC.TIMEOUT(f.PPPid, Timeout, f.params, f.timeout); f.state := AuthReq END SendAuthReq; PROCEDURE GiveState*(f: PAPStat; VAR s: ARRAY OF CHAR); BEGIN CASE f.state OF 			|Initial: COPY("Initial", s) 			|Closed: COPY("Closed", s) 			|Pending: COPY("Pending", s) 			|AuthReq: COPY("AuthReq", s) 			|Open: COPY("Open", s) 			|BadAuth: COPY("BadAuth", s) 		ELSE COPY("unknown state", s) 		END END GiveState; (* Init Object *) PROCEDURE Init*(VAR f: PAPStat; id: HDLC.PPPUnit; username, passwd: ARRAY OF CHAR); VAR i: INTEGER; BEGIN NEW(f); f.PPPid := id; i := 0; WHILE (i < LEN(f.user) - 1) & (i < LEN(username)) & (username[i] # 0X) DO f.user[i] := username[i]; INC(i) END; f.user[i] := 0X; f.userlen := i; 		i := 0; WHILE (i < LEN(f.passwd) - 1) & (i < LEN(passwd)) & (passwd[i] # 0X) DO f.passwd[i] := passwd[i]; INC(i) END; f.passwd[i] := 0X; f.passwdlen := i; 		NEW(f.params); f.params.f := f; 		f.timeout := DefTimeout; f.nrtransmit := 0; f.nrmaxtransmit := Defnrmaxtransmit; f.id := 0; f.state := Initial END Init; END PPPPAP.