Oberon/ETH Oberon/2.3.7/PPPPAP.Mod
< Oberon | ETH Oberon
(* 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.