text:
Oberon/ETH Oberon/2.3.7/PPPLCP.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 PPPLCP;	(** non-portable *) (* $VCS  4, Edgar@EdgarSchwarz.de, 9 May :0, 1:20:35 $     $Log$ $   4, Edgar@EdgarSchwarz.de, 9 May :0, 1:20:35 more debug info with auth stuff $   3, Edgar@EdgarSchwarz.de, 25 Apr :0, 10:47:30 more debug info, drop Identification code $   2, Edgar.Schwarz@z.zgs.de, 5 Sep 99, 13:49:32 minimal length for echo request set to 4 bytes $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:19:22 version for PPP 1.0.0 *) IMPORT FSM := PPPFSM, PAP := PPPPAP, HDLC := PPPHDLC, T := PPPTools, Debug := PPPDebug, SYSTEM; CONST (* Protocol Constants *) DefMRU = HDLC.MTU; MinMRU = 128; MaxMRU = HDLC.MTU; WarnLoops = 10; 				(* Warn about loop-backs this often *) LCP*=-03FDFH; (* =0C021H *) (* Configure Information Options *) Illegal0 = 0;					(*es some PPP implementations send that *) MRU = 1;						(* Maximum Receive Unit *) AsyncMap = 2;				(* Async Control Character Map *) AuthType = 3;				(* Authentication Protocol *) Quality = 4;					(* Quality Protocol *) MagicNumber = 5; (* = 6; *)                       (*es RESERVED*) PCompression = 7;		(* Protocol Field Compression *) ACCompression = 8;		(* Address And Control Field Compression *) (*es extensions from RFC1570 Jan 1994 *) (* = 9; *)                     (*es FCSAlternatives *) (* = 10; *)                   (*es Self Describing Padding *) (* = 13; *)                   (*es Callback *) (* = 15; *)                   (*es Compound Frames *) LCPConf17 = 17;          (*es* ? *) LCPConf19 = 19;          (*es* ? *) (* LCP codes *) ProtocolRej = 8;	EchoReq = 9;	EchoReply = 10;	DiscardReq = 11; (*es*)Identification = 12; TimeRemaining = 13; (**) (* Options Index *) Passive* = FSM.Passive;	(* Don't die if we get no response *) Silent* = FSM.Silent;		(* Wait for the other end to start first *) NegMRU* = 8; NegAsyncMap* = 9; NegUPap* = 10; (* Negotiate MRU, Async Map, User/Password *) NegChap = 11; NegMagicNumber* = 12; NegPComp = 13; (* Crypt-Auth, MagicNumber, PCompression *) NegACComp = 14; NegLqr = 15; (* AC-Compr., Link Quality Reports *) (* Length of the Configuration Options *) VoidLen = 2; ShortLen = 4; ChapLen = 5; LongLen = 6; LqrLen = 8; (* = Type (1 Byte) + Length (1 Byte) + Data *) TYPE Options*=RECORD O*: SET								(* Bits defined by Options Index *); MRU*:INTEGER;					(* Max. Receive Unit *) MagicNumb*:LONGINT; NumLoops*:INTEGER;		(* Magic Number Stuff *) AsyncMap*:SET; END; LCPfsm*=POINTER TO LCPfsmDesc; LCPfsmDesc=RECORD (FSM.FSMDesc) wo*, go(*es*)*(*-*),ao*, ho(*es*)*(*-*): Options; (* WantOptions, GotOptions, AllowOptions, HisOptions *) END; VAR (* Upcalls to PPP *) PPPHandleLCPUp*: PROCEDURE (U:HDLC.PPPUnit); PPPHandleLCPDown*: PROCEDURE (U:HDLC.PPPUnit); PPPHandleProtRej*: PROCEDURE (U:HDLC.PPPUnit; prot:INTEGER); (* Open - LCP can come up *) PROCEDURE Open* (f: LCPfsm); BEGIN	f.Flags:=f.wo.O*{Passive, Silent}; FSM.Open(f); END Open; (* Close - Take LCP down *) PROCEDURE Close* (f: LCPfsm); BEGIN IF (f.State=FSM.Stopped) & (f.Flags*{Passive, Silent} # {}) THEN	f.State:=FSM.Closed ELSE	FSM.Close(f) END END Close; (* LowerUp - The Lower Layer is Up *) PROCEDURE LowerUp* (f: LCPfsm); BEGIN f.HDLCConfig.MTU:=DefMRU; f.HDLCConfig.SendAsyncMap:={0..31}; (* Send Configuration *) f.HDLCConfig.MRU:=DefMRU; (* Receive Configuration *) f.ao.AsyncMap:={}; FSM.LowerUp(f) END LowerUp; (* LowerDown - The Lower Layer is Down *) PROCEDURE LowerDown* (f: LCPfsm); BEGIN FSM.LowerDown(f) END LowerDown; (* Input - New LCP Packet *) PROCEDURE Input* (f: LCPfsm; VAR p: ARRAY OF CHAR; pos, len:INTEGER); BEGIN FSM.Input(f, p, pos, len); END Input; (* SendProtRej - Send a Protocol Reject *) PROCEDURE SendProtRej* (f: LCPfsm; VAR p: ARRAY OF CHAR; pos, len:INTEGER); BEGIN INC(f.ID); FSM.SendData(f, ProtocolRej, f.ID, p, pos+2, len-2); END SendProtRej; (* ResetCI - Reset The Configuration Information *) PROCEDURE *ResetCI (f: FSM.FSM); BEGIN IF HDLC.debug THEN Debug.String("reset CI"); Debug.Ln; END; WITH f:LCPfsm DO 			f.wo.MagicNumb:=T.Magic; f.wo.NumLoops:=0;		(* WantOptions *) f.go:=f.wo;		(* GotOptions := WantOptions *) f.HDLCConfig.MTU:=HDLC.MTU			(* Max. Transmit Unit *) END END ResetCI; (* CILen - Returns Length of the Conf. Inf. *) PROCEDURE *CILen (f: FSM.FSM): INTEGER; VAR i: INTEGER; BEGIN i:=0; WITH f:LCPfsm DO 			IF (NegMRU IN f.go.O) THEN INC(i, ShortLen); END; IF (NegAsyncMap IN f.go.O) THEN INC(i, LongLen); END; IF (NegMagicNumber IN f.go.O) THEN INC(i, LongLen); END; (* To update if more Options supported *) END; RETURN i 	END CILen; (* AddCI - Add our desired Conf. Inf. to a packet (at pos) *) PROCEDURE *AddCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos: INTEGER; VAR len: INTEGER); BEGIN len:=0; IF HDLC.debug THEN FSM.OutLog("LCP.AddCI", "", f); END; WITH f:LCPfsm DO 			IF (NegMRU IN f.go.O) THEN INC(len, ShortLen); IF HDLC.debug THEN Debug.String("MRU "); END; p[pos]:=CHR(MRU); p[pos+1]:=CHR(ShortLen); T.PutInt(f.go.MRU, p, pos+2); INC(pos, ShortLen); END; IF (NegAsyncMap IN f.go.O) THEN INC(len, LongLen); IF HDLC.debug THEN Debug.String("AsyncMap "); END; p[pos]:=CHR(AsyncMap); p[pos+1]:=CHR(LongLen); T.PutSet(f.go.AsyncMap, p, pos+2); INC(pos, LongLen); END; IF (NegMagicNumber IN f.go.O) THEN INC(len, LongLen); IF HDLC.debug THEN Debug.String("MagicNumber "); END; p[pos]:=CHR(MagicNumber); p[pos+1]:=CHR(LongLen); T.PutLong(f.go.MagicNumb, p, pos+2); INC(pos, LongLen) END END;																							(* To update if more Options supported *) IF HDLC.debug THEN Debug.Ln; Debug.Ln; END END AddCI; (* AckCI - An Ack Packet has been received as answer to our req *) PROCEDURE *AckCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; VAR b:BOOLEAN; BEGIN b:=TRUE; WITH f:LCPfsm DO				(* No changes to our former req are allowed, otherwise the ack is bad *) IF (NegMRU IN f.go.O) THEN b:= b & (len>=ShortLen) & (ORD(p[pos])=MRU) & (ORD(p[pos+1])=ShortLen) & (T.GetInt(p, pos+2)=f.go.MRU); DEC(len, ShortLen); INC(pos, ShortLen); END; IF (NegAsyncMap IN f.go.O) THEN b:=b & (len>=LongLen) & (ORD(p[pos])=AsyncMap) & (ORD(p[pos+1])=LongLen) & (T.GetSet(p, pos+2)=f.go.AsyncMap); DEC(len, LongLen); INC(pos, LongLen); END; IF (NegMagicNumber IN f.go.O) THEN b:=b & (len>=LongLen) & (ORD(p[pos])=MagicNumber) & (ORD(p[pos+1])=LongLen) & (T.GetLong(p, pos+2)=f.go.MagicNumb); DEC(len, LongLen); INC(pos, LongLen); END; (* To update if more Options supported *) b:=b & (len=0); IF HDLC.debug & ~b THEN Debug.String("Received bad Ack!!"); Debug.Ln END; RETURN b 		END END AckCI; (* NakCI - A Nak Packet has been received as answer to our req *) PROCEDURE *NakCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; VAR no, try: Options;	(* no: Options with Naks, try: Options we try next time *) x, type, size:INTEGER; loopedback, b:BOOLEAN; BEGIN WITH f:LCPfsm DO				(* same order as we sent it, but only the nak'd ones *) no.O:={}; try.O:=f.go.O; 			IF (NegMRU IN f.go.O) & (len>=ShortLen) & (ORD(p[pos])=MRU) & (ORD(p[pos+1])=ShortLen) THEN x:=T.GetInt(p, pos+2); IF (x=LongLen) & (ORD(p[pos])=AsyncMap) & (ORD(p[pos+1])=LongLen) THEN INCL(no.O, NegAsyncMap); try.AsyncMap:=try.AsyncMap + T.GetSet(p, pos+2); DEC(len, LongLen); INC(pos, LongLen); 	(* Include New Chars (our receive side)*) END; IF (NegMagicNumber IN f.go.O) & (len>=LongLen) & (ORD(p[pos])=MagicNumber) & (ORD(p[pos+1])=LongLen) THEN INCL(no.O, NegMagicNumber); try.MagicNumb:=T.Magic; INC(try.NumLoops); loopedback:=TRUE; DEC(len, LongLen); INC(pos, LongLen); END; b:=TRUE;						(* there may be remaining options, but no changes possible ! (Just checking if Nak is ok) *) WHILE b & (len>VoidLen) DO 				type:=ORD(p[pos]); size:=ORD(p[pos+1]); CASE type OF 					 MRU: b:=((size=ShortLen) & ~(NegMRU IN f.go.O) & ~(NegMRU IN no.O)); | AsyncMap: b:=((size=LongLen) & ~(NegAsyncMap IN f.go.O) & ~(NegAsyncMap IN no.O)); | MagicNumber: b:=((size=LongLen) & ~(NegMagicNumber IN f.go.O) & ~(NegMagicNumber IN no.O)); | PCompression, ACCompression: b:=(size=VoidLen); | Quality: b:=(size=LqrLen); | AuthType: b:=((size=ChapLen) OR (size=ShortLen)); ELSE	(* probably an unknown Configuration Option *) END; INC(pos, size); END; b:=b & (len=0); IF b & (f.State#FSM.Opened) THEN f.go:=try;		 (* Update State *) IF loopedback & ((try.NumLoops MOD WarnLoops) = 0) THEN Debug.String("This line could be looped back!!"); Debug.Ln; END; END; RETURN b 		END END NakCI; (* RejCI - A Reject Packet has been received as answer to our req*) PROCEDURE *RejCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; VAR try: Options; (* try: Option to request next time *) BEGIN WITH f:LCPfsm DO	(* Look which options were rejected. Same order and same value! Otherwise a bad packet. *) try:=f.go; IF (NegMRU IN f.go.O) & (len>=ShortLen) & (ORD(p[pos])=MRU) & (ORD(p[pos+1])=ShortLen) & (T.GetInt(p, pos+2)=f.go.MRU) THEN DEC(len, ShortLen); INC(pos, ShortLen); EXCL(try.O, NegMRU); END; IF (NegAsyncMap IN f.go.O) & (len>=LongLen) & (ORD(p[pos])=AsyncMap) & (ORD(p[pos+1])=LongLen) & (T.GetSet(p, pos+2)=f.go.AsyncMap) THEN DEC(len, LongLen); INC(pos, LongLen); EXCL(try.O, NegAsyncMap); END; IF (NegMagicNumber IN f.go.O) & (len>=LongLen) & (ORD(p[pos])=MagicNumber) & (ORD(p[pos+1])=LongLen) & (T.GetLong(p, pos+2)=f.go.MagicNumb) THEN DEC(len, LongLen); INC(pos, LongLen); EXCL(try.O, NegMagicNumber); END; IF len#0 THEN IF HDLC.debug THEN Debug.String("Received bad Reject !"); END; RETURN FALSE ELSE	IF f.State#FSM.Opened THEN	f.go:=try; END;	(* Update the Options *) RETURN TRUE END END END RejCI; (* ReqCI - Conf. Request has arrived: Check the requested CIs and send 		appropriate response 		Returns:  ConfigureAck, ConfigureNak or ConfigureReject and modified  		packet (p, pos, length in len) 		If Mode is true, always send Reject, never Nak *) PROCEDURE ReqCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; 							VAR pos, len: INTEGER; Mode: BOOLEAN): SHORTINT; CONST Ack=0; Nak=1; Rej=2; RejAll=3; VAR type, size, posp, posw, lenp, x: INTEGER; y: LONGINT; eo, s: SET; (* eo: Error-Options: Options to Nak/Rej *) status: SHORTINT; (* Ack: Can Ack, Nak: Should Nak,  Rej: reject of 			some options needed, RejAll: serious reject: rej whole packet *) BEGIN eo:={}; (* Two steps: 		 First find out if packet can be accepted, or have to be naked or rejected  		 Second step: If nak, then modify (better proposals),  		 	if rej then send back same packet *) WITH f:LCPfsm DO 			lenp:=len; posp:=pos; status:=Ack; f.ho.O:={}; WHILE (status#RejAll) & (lenp>=VoidLen) DO 				size:=ORD(p[posp+1]); IF (sizelenp) THEN ELSE type:=ORD(p[posp]); CASE type OF 						 (*es reject 0 if a bad peer sends it *) Illegal0: status:=Rej; INCL(eo, Illegal0); IF HDLC.debug THEN Debug.String("RejIllegal0"); END; | (**) MRU: INCL(f.ho.O, NegMRU); IF (NegMRU IN f.ao.O) & (size=ShortLen) THEN x:=T.GetInt(p, posp+2); f.ho.MRU:=x; IF (xNAK *) INCL(eo, MRU); IF status=Ack THEN status:=Nak; END; END; ELSE IF HDLC.debug THEN Debug.String("RejMRU"); END; status:=Rej; INCL(eo, MRU); END; | AsyncMap: INCL(f.ho.O, NegAsyncMap); IF (NegAsyncMap IN f.ao.O) & (size=LongLen) THEN s:=T.GetSet(p, posp+2); f.ho.AsyncMap:=s; IF (f.ao.AsyncMap * (s/{0..31} (* = ~s *)) # {} ) THEN (* at least our options needed *) INCL(eo, AsyncMap); IF status=Ack THEN status:=Nak; END; END; ELSE IF HDLC.debug THEN Debug.String("RejAsyncMap"); END; status:=Rej; INCL(eo, AsyncMap); END; | MagicNumber: INCL(f.ho.O, NegMagicNumber); IF (NegMagicNumber IN f.ao.O) & (size=LongLen) THEN y:=T.GetLong(p, posp+2); f.ho.MagicNumb:=y; IF(NegMagicNumber IN f.go.O)&(y=f.go.MagicNumb)THEN (* MagicNumber MUST be different *) INCL(eo, MagicNumber); IF status=Ack THEN status:=Nak; END; END; ELSE IF HDLC.debug THEN Debug.String("RejMagic"); END; status:=Rej; INCL(eo, MagicNumber); END; | AuthType: (*es*)				 IF HDLC.debug THEN Debug.String("LCP.ReCI: AuthType"); Debug.Ln; (**)	 				END; IF size>=ShortLen THEN x := T.GetInt(p, posp+2); (*es*)				 	IF HDLC.debug THEN Debug.String("x ="); Debug.Int(x, 3); Debug.Ln; (**)	 					END; IF x = PAP.PAPProt THEN (*UPap *) IF (NegUPap IN f.ao.O) & (size >= ShortLen) THEN (* dm:1.10.96: size = ShortLen *) INCL(f.ho.O, NegUPap); (*es*)							 IF HDLC.debug THEN Debug.String("LCP.ReCI: NegUPap added to his options"); Debug.Ln; (**)	 							END; ELSE (*es*)							 IF HDLC.debug THEN Debug.String("Rej: NegUPap"); Debug.Int(size,5); Debug.Int(ShortLen,5); Debug.Ln; (**)	 							END; status := Rej; INCL(eo, AuthType); END ELSE (*es*)				 		Debug.String("LCP.ReCI: AuthType CHAP not supported"); Debug.Ln; INCL(f.ho.O, NegChap); INCL(eo, AuthType); IF status = Ack THEN status := Nak END; END ELSE IF HDLC.debug THEN Debug.String("RejAuth"); END; status := Rej; INCL(eo, AuthType); END; Debug.Ln 						| PCompression: INCL(f.ho.O, NegPComp); status:=Rej; IF HDLC.debug THEN Debug.String("RejPCComp"); END; INCL(eo, PCompression);	(* not supported *) | ACCompression: INCL(f.ho.O, NegACComp); status:=Rej; IF HDLC.debug THEN Debug.String("RejACComp"); END; INCL(eo, ACCompression);	(* not supported *) | Quality: INCL(f.ho.O, NegLqr); status:=Rej; IF HDLC.debug THEN Debug.String("RejQuality"); END; INCL(eo, Quality);	(* not supported *) (*es es fehlt weitere Info, einfach mal ablehnen *) | LCPConf17: status:=Rej; INCL(eo, LCPConf17);	(* not supported *) IF HDLC.debug THEN Debug.String("RejLCPConf17"); END; | LCPConf19: status:=Rej; IF HDLC.debug THEN Debug.String("RejLCPConf19"); END; INCL(eo, LCPConf19);	(* not supported *) (**) 					ELSE status:=Rej; (* unknown Type ->reject *) Debug.String("unknown type"); (*es*)Debug.Int(type, 5); (**) Debug.Ln; END; DEC(lenp, size); INC(posp, size); END; END; IF lenp # 0 THEN status:=RejAll; END; IF (status=RejAll) THEN RETURN FSM.ConfRej;(* len, pos are ok *) ELSIF (status=Ack) THEN RETURN FSM.ConfAck; (* len, pos are ok *) ELSE	IF Mode THEN status:=Rej; END; (* little hack *) IF status = Rej THEN EXCL(eo, AuthType) END; lenp:=len; posp:=pos; posw:=pos; WHILE lenp#0 DO 					type:=ORD(p[posp]); size:=ORD(p[posp+1]); IF (type IN eo) THEN IF status=Nak THEN 	(* make better proposals *) CASE type OF 								  MRU: T.PutInt(MinMRU, p, posp+2); (* write over old values *) | AsyncMap: T.PutSet(f.ao.AsyncMap+ f.ho.AsyncMap, p, posp+2); | MagicNumber: T.PutLong(T.Magic, p, posp+2); |AuthType: T.PutInt(PAP.PAPProt, p, posp+2); ELSE END END; IF posw # posp THEN T.CopyString(p, posp, posw, size); END; INC(posw,size); (* 'shift' it together *) END; INC(posp, size); DEC(lenp, size); END; len:=posw-pos; IF status=Rej THEN RETURN FSM.ConfRej; ELSE RETURN FSM.ConfNak; END; END END; END ReqCI; (* Up - LCP is ready *) PROCEDURE *Up (f: FSM.FSM); VAR x:INTEGER; s:SET; BEGIN WITH f: LCPfsm DO (* Configure our HDLC: Receive: MTU: Take WantOption, but not bigger than our Allow Option! *) IF (NegMRU IN f.ho.O) THEN x:=f.ho.MRU; ELSE x:=HDLC.MTU; END; IF x>f.ao.MRU THEN x:=f.ao.MRU; END; f.HDLCConfig.MTU:=x; IF (NegAsyncMap IN f.ho.O) THEN s:=f.ho.AsyncMap; ELSE s:={0..31}; END; f.HDLCConfig.SendAsyncMap:=s; (* Receive Config *) IF (NegMRU IN f.wo.O) THEN x:=f.go.MRU ELSE x:=HDLC.MTU; END; f.HDLCConfig.MRU:=x; PPPHandleLCPUp(f.HDLCConfig); 	(* PPP will inform other protocols *) END; END Up; (* Down - LCP has to close *) PROCEDURE *Down (f: FSM.FSM); BEGIN PPPHandleLCPDown(f.HDLCConfig); 	(* PPP will inform other protocols *) f.HDLCConfig.MTU:=HDLC.MTU; f.HDLCConfig.SendAsyncMap:={0..31}; f.HDLCConfig.MRU:=HDLC.MTU; END Down; (* RecProtRej - Protocol Reject received *) PROCEDURE *RecProtRej(f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len:INTEGER); VAR prot:INTEGER; BEGIN IF len>1 THEN prot:=T.GetInt(p, pos); Debug.String(" Protocol rejected: "); Debug.Int(prot, 10); Debug.Ln; IF f.State#FSM.Opened THEN Debug.String(" Protocol reject discarded "); Debug.Ln; ELSE	PPPHandleProtRej(f.HDLCConfig, prot); 	(* PPP will inform protocols *) END ELSE Debug.String("Short ProtReject received"); Debug.Ln 		END END RecProtRej; (*		To implement if we intend to send Echo-Requests 	PROCEDURE RecEchoReply(f:FSM.FSM; id:SHORTINT; VAR p:ARRAY OF CHAR; pos, len:LONGINT); BEGIN END RecEchoReply; 	*) (* ExtCode - Handle LCP-Codes *) PROCEDURE *ExtCode(f: FSM.FSM; code, id: SHORTINT; VAR p: ARRAY OF CHAR; pos, len:INTEGER): BOOLEAN; BEGIN WITH f:LCPfsm DO 			CASE code OF 				 ProtocolRej: RecProtRej(f, p, pos, len); RETURN TRUE (** es, 4 Bytes should be enough for a echo request without data (magic only) *) | EchoReq: IF len<4 THEN len:=4; END; T.PutLong(f.go.MagicNumb, p, pos); (**				| EchoReq: IF len<6 THEN len:=6; END; T.PutLong(f.go.MagicNumb, p, pos); **) FSM.SendData(f, EchoReply, id, p, pos, len); RETURN TRUE | EchoReply: (* RecEchoReply(f, id, p, pos, len); To implement if we intend to send Echo-Requests *) RETURN TRUE | DiscardReq: RETURN TRUE (* test code for a problem of Jose Francisco , 05.10.1999, es *) | Identification: (* a peer seems to choke on CodeRej, so just try to drop it. *) RETURN TRUE ELSE RETURN FALSE END END END ExtCode; (* Initialisation LCP*) PROCEDURE Init* (VAR f:LCPfsm; wo, ao:Options; C:HDLC.PPPUnit); BEGIN NEW(f); f.Protocol:=LCP; f.ProtoName:="LCP";	(* LCP Protocol *) f.ResetCI:=ResetCI; f.CILen:=CILen; f.AddCI:=AddCI; f.AckCI:=AckCI; f.NakCI:=NakCI; f.RejCI:=RejCI; f.ReqCI:=ReqCI; f.Up:=Up; f.Down:=Down; f.ExtCode:=ExtCode; f.HDLCConfig:=C; FSM.Init(f); f.wo:=wo; f.ao:=ao END Init; END PPPLCP.

title: Oberon/ETH Oberon/2.3.7/PPPLCP.Mod


text:
Oberon/ETH Oberon/2.3.7/PPPMain.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 PPPMain;	(** non-portable *)	(* Contributed by Martin Aeschlimann, Claude Knaus & Edgar Schwarz *) (* $VCS  4, Edgar@EdgarSchwarz.de, 04.06.00 19:19:56 $     $Log$ $   4, Edgar@EdgarSchwarz.de, 04.06.00 19:19:56 PAP password set with Netsystem and StartInst   $   3, Edgar@EdgarSchwarz.de, 9 May :0, 1:24:6 \silent in Oberon.Text, PAP tries $   2, Edgar.Schwarz@z.zgs.de, 18 Aug 99, 21:35:8 adapted to new PPPDebug which now logs to kernel log $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:26:14 version for PPP 1.0.0 *) (* 	ToDo: 		SendPacket ueberpruefen, falls nicht alle characters gesendet  		Spaeter: Routing von PacketTools entkoppeln *) IMPORT HDLC:=PPPHDLC, LCP:=PPPLCP, IPCP:=PPPIPCP, FSM:=PPPFSM, PAP := PPPPAP, SYSTEM, Debug := PPPDebug, T:=PPPTools, O:=Objects, PT:=(*es*)NetBase, NetIP, V24, Out, NetSystem, (*PacketTools, *) (*es*) Oberon, Texts; (* P := Peripherals, XOberon, XTexts, Base; *) CONST PPPIP = 0021H; (*es*)IPPROT(*IP*) = 0800H; ARP = 0806H; (* Protocol Constants *) DefMRU = HDLC.MTU; MinMRU = 128; MaxMRU = HDLC.MTU; (* Options Index for LCP Want-,  AllowOptions *) Silent* = LCP.Silent; Passive* = LCP.Passive; NegMRU* = LCP.NegMRU; NegAsyncMap* = LCP.NegAsyncMap; NegMagicNumber* = LCP.NegMagicNumber; NegUPap* = LCP.NegUPap; TYPE Options* = LCP.Options; (*es*) PhysAdr = ARRAY 6 OF SYSTEM.BYTE; CommDevice* = POINTER TO RECORD (PT.Device) IpAdr*, GwAdr*, NetMask*: NetIP.Adr; AdrLen*: INTEGER; Start*, Stop*, Reset*: PROCEDURE; configurated*, ptp*: BOOLEAN; c*: LONGINT; (*COM Port *) END; PPPid* = POINTER TO PPPidDesc; PPPidDesc* = RECORD (HDLC.PPPUnitDesc) running:BOOLEAN; LCPfsm: LCP.LCPfsm;		(* LCP Protocol *) IPCPfsm: IPCP.IPCPfsm;	(* IPCP Protocol *) PAPStat: PAP.PAPStat;	(* PAP Protocol *) me: (*es*)(*PT.*)CommDevice; END; VAR ppp:PPPid;	ch: (*es*)LONGINT(*P.SerialChannel*); PROCEDURE ^Start*(id:PPPid); PROCEDURE ^Stop*(id:PPPid); PROCEDURE ^SendPacket*(id:PPPid; prno: INTEGER; item: PT.Item); PROCEDURE * Connect (me: Oberon.Task); VAR prno: INTEGER; item: PT.Item; BEGIN IF V24.Available(ppp.me.c) > 0 THEN prno := 0; NEW(item); HDLC.ReceivePacket(ppp, prno, item); IF ppp.me.state = PT.open THEN Oberon.Remove(ppp.task); ppp.task := NIL; END; END; END Connect; (* --- *) (* Dummy Procedures - for Packet Tools (needs parameterless procedures!) *) PROCEDURE StartInst*; (* [ ] *) (* PAP password must be set as NetSystem.SetUser pap: [: ]@ ~ *) VAR S: Texts.Scanner; ao: Options; provider, papname, pappasswd:ARRAY 32 OF CHAR; BEGIN (* check for provider and username in case of PAP usage *) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF ~S.eot THEN COPY(S.s, provider); IF HDLC.debug THEN Debug.String("Provider: "); Debug.String(provider); Debug.Ln; END; Texts.Scan(S); COPY(S.s, papname); IF HDLC.debug THEN Debug.String("papname: "); Debug.String(papname); Debug.Ln; END; NetSystem.GetPassword("pap", provider, papname, pappasswd); IF HDLC.debug THEN Debug.String("pappasswd: "); Debug.String(pappasswd); Debug.Ln; END; IF pappasswd # "" THEN INCL(ppp.LCPfsm.ao.O, NegUPap); END; ELSE papname := ""; pappasswd := ""; END; PAP.Init(ppp.PAPStat, ppp, papname, pappasswd); (* send first request to peer *) Start(ppp); (* install task to negotiate PPP and finally open device *) NEW(ppp.task); ppp.task.safe := FALSE; ppp.task.time := 0; ppp.task.handle := Connect; Oberon.Install(ppp.task); END StartInst; PROCEDURE StopInst*; BEGIN Stop(ppp); END StopInst; (*es*) PROCEDURE * AvailableInst (dev: PT.Device): BOOLEAN; BEGIN RETURN V24.Available(dev(CommDevice).c) > 0; END AvailableInst; PROCEDURE * ReceiveInst (dev: PT.Device; VAR prno: INTEGER;  							VAR src: ARRAY OF SYSTEM.BYTE; VAR item: PT.Item); BEGIN HDLC.ReceivePacket(ppp, prno, item); END ReceiveInst; PROCEDURE SendInst* (dev: PT.Device; prno: INTEGER; 	VAR dest: ARRAY OF  SYSTEM.BYTE; item: PT.Item); BEGIN SendPacket(ppp, prno, item) END SendInst; PROCEDURE ResetInst*; BEGIN END ResetInst; (* --- *) (* Real PPP-Procedure-Interface *) (* Start - Start the PPP-Instance: active means that PPP starts sending Configure-Requests *) PROCEDURE Start*(id:PPPid); BEGIN IF ~id.running THEN id.running:=TRUE; LCP.LowerUp(id.LCPfsm); LCP.Open(id.LCPfsm); END END Start; (* Stop - Stop the PPP-Instance *) PROCEDURE Stop*(id:PPPid); BEGIN IF id.running THEN id.running:=FALSE; IPCP.Close(id.IPCPfsm); LCP.Close(id.LCPfsm); (*es, close the device *) id.me.state := PT.closed; (* hack to signal HDLC.CheckTimer to swallow log output *) id.cname := ""; END END Stop; (* Remove - Remove the PPP-Instance completely *) PROCEDURE Remove*(VAR id:PPPid); BEGIN Stop(id); (*es??? no unistall for devices in NetBase found 		id.task.UnInstall;	(* Remove Task *) 		PT.UnInstallDevice(id.me); es*) id:=NIL; END Remove; (* SendPacket - Interface for IP-Client to send Item *) PROCEDURE SendPacket*(id:PPPid; prno: INTEGER; item: PT.Item); VAR a: ARRAY HDLC.ArrayLength OF CHAR; pos: INTEGER; BEGIN IF id.running THEN IF (*es*)prno(*item.type*) = ARP THEN item.data(*.data*)[7] := 2X; SYSTEM.MOVE(SYSTEM.ADR(item.data(*.data*)[24]), SYSTEM.ADR(item.data(*.data*)[14]), NetIP.AdrLen); SYSTEM.MOVE(SYSTEM.ADR(id.me.IpAdr), SYSTEM.ADR(item.data(*.data*)[24]), NetIP.AdrLen); (*es???*) Debug.String("PT.arprec:. whatdowedo?");Debug.Ln; HALT(99); (* PT.arprec(item) *) ELSIF (*es*)prno(*item.type*) = (*es*)IPPROT(*IP*) THEN (*es*) IF id.me.state = PT.open THEN pos := HDLC.HDLCHeaderLen + HDLC.StartPos; SYSTEM.MOVE(SYSTEM.ADR(item.data[item.ofs]), 	  		  	SYSTEM.ADR(a[pos]), item.len); HDLC.SendPacket(id, PPPIP, a, pos, item.len) ELSE Debug.String("IP Packet to send discarded. Device not open."); Debug.Ln; END; (* pos := HDLC.HDLCHeaderLen + HDLC.StartPos; 				   SYSTEM.MOVE(SYSTEM.ADR(item.data.data[0]), SYSTEM.ADR(a[pos]), item.len); 					HDLC.SendPacket(id, PPPIP, a, pos, item.len) 				*) ELSE Debug.String("unknown packet. whatdowedo?"); Debug.Hex((*es*)prno(*item.type*)); Debug.Ln 			END END; (*es*)PT.RecycleItem(item); (* PT.PutItem(PT.empty, item) (* dm: 21.10.96 *) *) END SendPacket; (* Install- Install a PPP-Instance for Channel c, with specified IP-Adr:  		Null-IPAdr means no wishes 	    LCPwo: LCPWant-Options, LCPAllow-Options: See Options List *) PROCEDURE Install*(c: (*es*)LONGINT(*P.SerialChannel*); 		cname: ARRAY OF CHAR;  		VAR loginuser, loginpasswd, sstr: ARRAY OF CHAR;  		OurIP, HisIP, NetMask: NetIP.Adr; LCPwo, LCPao: Options; nretries: INTEGER; 		timeout: LONGINT; VAR id: PPPid); VAR i:INTEGER; BEGIN NEW(id); id.running:=FALSE; HDLC.Init(id, c, cname, sstr, loginuser, loginpasswd); (*es*)(* Init CommDevice *) NEW(id.me); FOR i:=0 TO NetIP.AdrLen-1 DO id.me.IpAdr[i]:=0X; id.me.GwAdr[i]:=0X; id.me.NetMask[i]:=NetMask[i] END; id.me.Start:=StartInst; id.me.Stop:=StopInst; id.me.Reset:=ResetInst; id.me.Send:=SendInst; (*es*)id.me.Receive := ReceiveInst; id.me.Available := AvailableInst; id.c := c; id.me.c := id.c; 		id.me.typ := PT.nobroadcast; id.me.sndCnt := 0; id.me.recCnt := 0; (**) id.me.AdrLen:=0; id.me.configurated:=FALSE; id.me.ptp:=TRUE; FSM.ActTimeout:=timeout*1000; FSM.ActMaxConfReqs:=nretries; LCP.Init(id.LCPfsm, LCPwo, LCPao, id); IPCP.Init(id.IPCPfsm, id, OurIP, HisIP); (* id.task.Install(HDLC.ReceivePacket); 		id.task.Notify;	(* Install Task *)*) (*es*)PT.InstallDevice(id.me); id.me.state := PT.pending; Out.String(cname); Out.String(" device installed on COM"); Out.Int(c+1, 1); Out.Ln 		(*PT.InsertDevice(id.me);*) END Install; (* --- *) (* Upcalls from LCP, IPCP, HDLC *) (*es, try to avoid that IPCP goes up as long as PAP isn't finished *) PROCEDURE LCPUp1 (U:HDLC.PPPUnit); BEGIN Debug.String("LCP is finally ready!!"); Debug.Ln; IPCP.LowerUp(U(PPPid).IPCPfsm); IPCP.Open(U(PPPid).IPCPfsm); END LCPUp1; (* LCPUp - Called by LCP when LCP is ready *) PROCEDURE * LCPUp (U:HDLC.PPPUnit); BEGIN IF LCP.NegUPap IN U(PPPid).LCPfsm.ho.O THEN (* auth is requested by peer *) Debug.String("Main.LCPUp: auth requested by peer"); PAP.LowerUp(U(PPPid).PAPStat) ELSE Debug.String("Main.LCPUp: no auth requested by peer"); LCPUp1 (U); END; END LCPUp; (** old 	(* LCPUp - Called by LCP when LCP is ready *) 	PROCEDURE * LCPUp (U:HDLC.PPPUnit); 	BEGIN 		Debug.String("LCP is finally ready!!"); Debug.Ln; 		IF LCP.NegUPap IN U(PPPid).LCPfsm.ho.O THEN (* auth is requested by peer *) 			PAP.LowerUp(U(PPPid).PAPStat) 		END; 		IPCP.LowerUp(U(PPPid).IPCPfsm); 		IPCP.Open(U(PPPid).IPCPfsm); 	END LCPUp; **) (* LCPDown - Called by LCP when LCP is closed *) PROCEDURE * LCPDown (U:HDLC.PPPUnit); BEGIN IPCP.LowerDown(U(PPPid).IPCPfsm); IF LCP.NegUPap IN U(PPPid).LCPfsm.ho.O THEN	(* auth is requested by peer *) PAP.LowerDown(U(PPPid).PAPStat) END END LCPDown; (* LCPProtRej - Called by LCP when a Protocol Reject has arrived *) PROCEDURE * LCPProtRej (U:HDLC.PPPUnit; prot:INTEGER); BEGIN WITH U:PPPid DO 			IF prot=LCP.LCP THEN	FSM.ProtReject(U.LCPfsm);	(* LCP cannot be rejected *) ELSIF prot=IPCP.IPCP THEN Debug.String("IPCP Protocol rejected!! Serious Problem!"); Debug.Ln; ELSE	Debug.String("Protocol rejected:"); Debug.Int(prot, 8); Debug.Ln; END END END LCPProtRej; (* IPCPUp - Called by IPCP when IPCP is ready *) PROCEDURE * IPCPUp (U:HDLC.PPPUnit); BEGIN WITH U:PPPid DO 			U.me.IpAdr:=U.IPCPfsm.go.OurAddress; U.me.GwAdr:=U.IPCPfsm.ho.HisAddress; (*es*)NetIP.routes[0].adr := U.IPCPfsm.go.OurAddress; NetSystem.hostIP := SYSTEM.VAL(LONGINT,U.IPCPfsm.go.OurAddress); NetSystem.ToNum(NetSystem.hostIP, NetSystem.hostName);	(* temporary *) NetIP.routes[0].gway := U.IPCPfsm.ho.HisAddress; IF U.me.state = PT.open THEN Debug.String("Warning: device already open"); Debug.Ln; END; U.me.state := PT.open; (* open device *) (**)U.me.configurated:=TRUE; Debug.String("OurAddress = "); Debug.Hex(SYSTEM.VAL(LONGINT, U.me.IpAdr)); Debug.Ln; Debug.String("HisAddress = "); Debug.Hex(SYSTEM.VAL(LONGINT, U.me.GwAdr)); Debug.Ln; IF LCP.NegUPap IN U.LCPfsm.ho.O THEN PAP.LowerUp(U.PAPStat) END END; Debug.String("IPCP is finally ready!!"); Debug.Ln; Debug.Ln; (*es*) Out.String("IPCP is finally ready. Device opened."); Out.Ln; END IPCPUp; (* IPCPDown - Called by IPCP when IPCP is closed *) PROCEDURE * IPCPDown (U:HDLC.PPPUnit); BEGIN WITH U: PPPid DO 			U.me.configurated:=FALSE; PAP.LowerDown(U.PAPStat) END END IPCPDown; (* Receive - Called by HDLC to demultiplex the protocol *) PROCEDURE * Receive (U:HDLC.PPPUnit; prot:INTEGER; 			VAR p: ARRAY OF CHAR; pos, len:INTEGER;  			VAR prno: INTEGER; VAR item: PT.Item); VAR i: INTEGER; BEGIN WITH U:PPPid DO 			IF prot=LCP.LCP THEN	LCP.Input(U.LCPfsm, p, pos, len); ELSE IF U.LCPfsm.State=FSM.Opened THEN (* No other packets unless LCP is open *) IF prot=PAP.PAPProt THEN PAP.Input(U.PAPStat, p, pos, len); (*es, check whether IPCP can go up *) IF U.PAPStat.state = PAP.Open THEN LCPUp1(U); END; (**) 					ELSE IF LCP.NegUPap IN U(PPPid).LCPfsm.ho.O THEN IF U.PAPStat.state=PAP.Open THEN (* No other packets unless Auth is completed*) IF prot=IPCP.IPCP THEN	IPCP.Input(U.IPCPfsm, p, pos, len) ELSE IF U.IPCPfsm.State=FSM.Opened THEN (* No IP packets unless IPCP is open *) IF prot=PPPIP THEN		(* only IP-Packets *) (*es*)(* Item provided by NetBase.PollDevices *) (* PT.NewItem(item); item.cd:=U.me;*) item.len:=len; (*es*)prno := IPPROT;(*item.type:= IP*); SYSTEM.MOVE(SYSTEM.ADR(p[pos]), 												SYSTEM.ADR(item.data(*.data*)[0]), len); (*es???*)Debug.String("PT.iprec 0"); (*PT.iprec(item)*) ELSE Debug.String("Unknown Protocol: "); Debug.Int(prot,8); Debug.Ln; LCP.SendProtRej(U.LCPfsm, p, pos-4, len+4); (* dm 11.10.96; pos-2, len+2 *) END END END END ELSE IF prot=IPCP.IPCP THEN IPCP.Input(U.IPCPfsm, p, pos, len) ELSE IF U.IPCPfsm.State=FSM.Opened THEN (* No IP packets unless IPCP is open *) IF prot=PPPIP THEN		(* only IP-Packets *) (*es*)(* Item provided by NetBase.PollDevices *) (* PT.NewItem(item); item.cd:=U.me;*) item.len:=len; (*es*)prno := IPPROT; (*item.type := IP*); SYSTEM.MOVE(SYSTEM.ADR(p[pos]), 											SYSTEM.ADR(item.data(*.data*)[0]), len); (*es*)Debug.String("PT.iprec 1"); Debug.Int(item.ofs, 5); Debug.Ln; (*PT.iprec(item)*) ELSE Debug.String("Unknown Protocol: "); Debug.Int(prot,8); Debug.Ln; LCP.SendProtRej(U.LCPfsm, p, pos-4, len+4); (* dm 11.10.96; pos-2, len+2 *) END END END END END END END END END Receive; (* --- *) (* PPP-User-Interface *) PROCEDURE SetIP(n0,n1,n2,n3:INTEGER; VAR ip:NetIP.Adr);	(* n1.n2.n3.n4 *) BEGIN ip[0]:=CHR(n0); ip[1]:=CHR(n1); ip[2]:=CHR(n2); ip[3]:=CHR(n3); END SetIP; PROCEDURE Hex2Set(A: ARRAY OF CHAR):SET; VAR d, i, j, k, ch, x:INTEGER; s: SET; BEGIN s:={}; i:=0; WHILE A[i]=" " DO INC(i); END; x:=31; ch:=ORD(A[i]); j:=0; WHILE (j<8) DO 			IF (ch>=ORD("0")) & (ch<=ORD("9")) THEN k:=ch-ORD("0"); ELSIF (ch>=ORD("A")) & (ch<=ORD("F")) THEN k:=ch+10-ORD("A"); ELSE RETURN {}; END; d:=8; WHILE d>0 DO IF d<=k THEN k:=k-d; INCL(s, x) END;   DEC(x); d:=d DIV 2;  END; INC(i); INC(j); ch:=ORD(A[i]); END; IF (ch=0) OR (ch=20H) THEN RETURN s; ELSE RETURN {} END END Hex2Set; (* InstPPP - Start a PPPConnection with Channel162 as Command *) (* Options:  /IP  OurIP HisIP												 8 Integers, no ".",  0 0 0 0 means no wish 						/NetMask MyNetMask									 4 Integer, no ".", default: 255 255 255 255 	 					/Silent															 If Silent, PPP does not try to connect himself 	 					/Rtr  nofRetries												Number of Retries when no or bad answer 	  				   /TO  nofTimeOuts											TimeOut Time between Retries in seconds 	  				   /MRUWant  Value (1500 usual) 				 	 Size of packets we want to sent  	   				  /MRUAllow													 Do we allow him to send smaller packets than 1500 bytes? 	   				  /AsyWant  XHexValue (p.e X00000000)		  Bitarray of ASCII-Char. from 0 to 31 we want to send with ESC-Code 	   				  /AsyAllow  XHexValue (p.e X0000FF00)          Bitarray of ASCII-Char. from 0 to 31 he must send with ESC-Cod 	   				  /MagWant													  MagicNumber wanted (for Loop-Detection) 	   				  /MagAllow													 MagicNumber allowed /LoginName "String"										loginname (used by login-procedure on Solaris) /LoginPasswd "String"									password (used by login-procedure on Solaris) /PAPName "string"										userid for PAP /PAPPasswd "string"									 password for PAP /SString "string"										   string to send to ppp-server first (Windows NT RAS Server needs it) *) 	PROCEDURE InstPPP*; 	VAR ourIP, hisIP, myNetMask: NetIP.Adr; n0,n1,n2,n3, rtr: INTEGER; 		to: LONGINT; 		wo, ao: Options; InDone:BOOLEAN; S: Texts.Scanner; 		(*es*)devName, (**) s, sstr, loginname, loginpasswd: ARRAY 32 OF CHAR; 		ok: BOOLEAN; i:INTEGER; 		(*es*)(*obj: Base.Object;*) 		PROCEDURE Cmp(t:ARRAY OF CHAR):BOOLEAN; 			VAR i,j:INTEGER; 		BEGIN i:=1; j:=0; 			WHILE (s[i]#0X) & (t[j]=s[i]) DO INC(i); INC(j); END; 			RETURN (t[j]=0X) 		END Cmp; 		PROCEDURE InInt(VAR n:INTEGER); 		BEGIN 			WHILE (S.class = Texts.Char) & (S.c = 0DX) DO Texts.Scan(S) END;  			IF S.class=Texts.Int THEN n:=SHORT(S.i); Texts.Scan(S); 			ELSE InDone:=FALSE 			END; 		END InInt; 		PROCEDURE InName(VAR u:ARRAY OF CHAR); 		BEGIN  			WHILE (S.class = Texts.Char) & (S.c = 0DX) DO Texts.Scan(S) END; 			IF S.class=Texts.String THEN COPY(S.s, u); Texts.Scan(S) 			ELSE InDone:=FALSE 			END; 		END InName; BEGIN ao.O:={}; wo.O:={}; ourIP:=IPCP.ZeroIP; hisIP:=IPCP.ZeroIP; rtr:=FSM.DefMaxConfReqs; to:=FSM.DefTimeout; loginname[0] := 0X; loginpasswd[0] := 0X; sstr[0] := 0X; FOR i := 0 TO NetIP.AdrLen - 1 DO myNetMask[i] := 0FFX END; (*es*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); LOOP Texts.Scan(S); IF S.eot THEN EXIT; END; IF (S.class = Texts.Name) & (S.s[0] = "C") THEN devName := "PPP"; IF S.s = "COM1" THEN ch := V24.COM1 ELSIF S.s = "COM2" THEN ch := V24.COM2 ELSIF S.s = "COM3" THEN ch := V24.COM3 ELSIF S.s = "COM4" THEN ch := V24.COM4 ELSE HALT(99) END; ELSIF (S.class = Texts.Char) & (S.c = "\") THEN (* an option *) Texts.Scan(S); IF S.eot THEN EXIT; END; IF S.class = Texts.Name THEN IF S.s = "silent" THEN INCL(wo.O, Silent); ELSE Debug.String("unknown option"); END; Debug.String(" \"); Debug.String(S.s); END; ELSE HALT(99); END; END; (*es*) (*MRUWant*)InInt(i); INCL(wo.O, NegMRU); wo.MRU:=1500; IF HDLC.debug THEN Debug.String("MRUWant "); Debug.Int(i, 5) END; (*MRUAllow*)INCL(ao.O, NegMRU); ao.MRU:=MaxMRU; IF HDLC.debug THEN Debug.String("MRUAllow") END; (*AsyWant*) INCL(wo.O, NegAsyncMap); wo.AsyncMap:={}; IF HDLC.debug THEN Debug.String("AsyWant "); Debug.Hex(SYSTEM.VAL(LONGINT, wo.AsyncMap)); END; (*AsyAllow*) INCL(ao.O, NegAsyncMap); ao.AsyncMap:={0..31}; IF HDLC.debug THEN Debug.String("AsyAllow "); Debug.Hex(SYSTEM.VAL(LONGINT, ao.AsyncMap)); END; (*TO*) to:=5; IF HDLC.debug THEN Debug.String("TO "); Debug.Int(to, 5) END; (*IP * SetIP(0,0,0,0, ourIP); IF HDLC.debug THEN Debug.String("ourIP "); END; *) (*IP* SetIP(0,0,0,0, hisIP); IF HDLC.debug THEN Debug.String("hisIP "); END; *) (*Netmask*) SetIP(255,255,255,0,myNetMask); IF HDLC.debug THEN Debug.String("myNetmask "); END; (* alle Parameter oben mal fest gesetzt ??? 		Texts.OpenScanner(S ,Oberon.Par.text, Oberon.Par.pos); 		(*Texts.OpenScanner(S ,XOberon.ParText, XOberon.ParPos);*)  		ok:=FALSE; Texts.Scan(S); 		InName(s); 		InDone := TRUE; 		WHILE InDone DO 			IF s[0]="/" THEN 				IF Cmp("MRUWant") THEN  					InInt(i); INCL(wo.O, NegMRU); wo.MRU:=i; 					IF HDLC.debug THEN Debug.String("MRUWant "); Debug.Int(i, 5) END 				ELSIF Cmp("MRUAllow") THEN  					INCL(ao.O, NegMRU); ao.MRU:=MaxMRU; 					IF HDLC.debug THEN Debug.String("MRUAllow") END 				ELSIF Cmp("AsyWant") THEN 					InName(s); INCL(wo.O, NegAsyncMap);  					wo.AsyncMap:=Hex2Set(s); 					IF HDLC.debug THEN Debug.String("AsyWant "); Debug.Hex(SYSTEM.VAL(LONGINT, wo.AsyncMap)) END 				ELSIF Cmp("AsyAllow") THEN 					InName(s); INCL(ao.O, NegAsyncMap);  					ao.AsyncMap:=(*es*){}(*Hex2Set(s)*); 					IF HDLC.debug THEN Debug.String("AsyAllow "); Debug.Hex(SYSTEM.VAL(LONGINT, ao.AsyncMap)) END ELSIF Cmp("MagWant") THEN INCL(wo.O, NegMagicNumber); IF HDLC.debug THEN Debug.String("MagWant") END ELSIF Cmp("MagAllow") THEN INCL(ao.O, NegMagicNumber); IF HDLC.debug THEN Debug.String("MagAllow") END ELSIF Cmp("Silent") THEN INCL(wo.O, Silent); IF HDLC.debug THEN Debug.String("Silent") END ELSIF Cmp("Rtr") THEN InInt(i); rtr:=i; IF HDLC.debug THEN Debug.String("Rtr "); Debug.Int(i, 5) END ELSIF Cmp("TO") THEN InInt(i); to:=i; IF HDLC.debug THEN Debug.String("TO "); Debug.Int(i, 5) END ELSIF Cmp("IP") THEN InInt(n0); InInt(n1); InInt(n2); InInt(n3); SetIP(n0, n1, n2, n3, ourIP); IF HDLC.debug THEN Debug.String("ourIP "); Debug.Int(n0, 5); Debug.Int(n1, 5); Debug.Int(n2, 5); Debug.Int(n3, 5); Debug.Ln END; InInt(n0); InInt(n1); InInt(n2); InInt(n3); SetIP(n0, n1, n2, n3, hisIP); IF HDLC.debug THEN Debug.String("hisIP "); Debug.Int(n0, 5); Debug.Int(n1, 5); Debug.Int(n2, 5); Debug.Int(n3, 5) END ELSIF Cmp("Netmask") THEN InInt(n0); InInt(n1); InInt(n2); InInt(n3); SetIP(n0, n1, n2, n3, myNetMask); IF HDLC.debug THEN Debug.String("myNetmask "); Debug.Int(n0, 5); Debug.Int(n1, 5); Debug.Int(n2, 5); Debug.Int(n3, 5) END ELSIF Cmp("LoginName") THEN InName(s); COPY(s, loginname); IF HDLC.debug THEN Debug.String("LoginName: "); Debug.String(loginname) END ELSIF Cmp("LoginPasswd") THEN InName(s); COPY(s, loginpasswd); IF HDLC.debug THEN Debug.String("LoginPassword: "); Debug.String(loginpasswd) END ELSIF Cmp("SString") THEN InName(s); COPY(s, sstr); IF HDLC.debug THEN Debug.String("SString "); Debug.String(sstr) END ELSE IF HDLC.debug THEN Debug.String("Illegal Option") END END; IF HDLC.debug THEN Debug.Ln END ELSE IF HDLC.debug THEN Debug.String(" No Option... "); Debug.String(s); Debug.Ln END END; InName(s); END; es*) (*es*)(* Base.GetObj("V24Channel162", obj); IF (obj#NIL) & (obj IS P.SerialChannel) THEN ch:=obj(P.SerialChannel); *) (**) 			Install(ch, devName, loginname, loginpasswd, (*es*)sstr(*str*), ourIP, hisIP, myNetMask, wo, ao, rtr, to, ppp) (*es*)(*END*) 	END InstPPP; 	(* RemovePPP - Remove PPP Connection completely *) 	PROCEDURE RemovePPP*; BEGIN Remove(ppp) 	END RemovePPP; 	(* Stats - Print Out Information in XLog *) 	PROCEDURE Stats*; 		VAR W:Texts.Writer; s: FSM.String; f:LCP.LCPfsm; g:IPCP.IPCPfsm;  			h: PAP.PAPStat; i:INTEGER; ip: NetIP.Adr; 	BEGIN 		IF ppp # NIL THEN  			f:=ppp.LCPfsm; g:=ppp.IPCPfsm; h := ppp.PAPStat; 			Texts.OpenWriter(W); Texts.WriteString(W, "PPP-beta on ");  			Texts.WriteString(W, ppp.cname);Texts.WriteLn(W); 			Texts.WriteString(W, "LCP is in state: "); FSM.GiveState(f.State, s);  			Texts.WriteString(W, s); Texts.WriteLn(W); 			IF f.State=FSM.Opened THEN 				Texts.WriteString(W, "His MRU wish: ");  				Texts.WriteInt(W, f.ho.MRU, 5); Texts.WriteLn(W); 				Texts.WriteString(W, "MTU configured to: ");  				Texts.WriteInt(W, ppp.MTU, 5); Texts.WriteLn(W); Texts.WriteString(W, "Our MRU wish: "); Texts.WriteInt(W, f.wo.MRU, 5); Texts.WriteLn(W); Texts.WriteString(W, "MRU configured to: "); Texts.WriteInt(W, ppp.MRU, 5); Texts.WriteLn(W); Texts.WriteString(W, "SendAsyncMap configured to: "); T.WriteSet(ppp.SendAsyncMap, s); Texts.WriteString(W, s); Texts.WriteLn(W); IF (NegMagicNumber IN f.ho.O) THEN Texts.WriteString(W, "He wants MagicNumber"); Texts.WriteLn(W); ELSE Texts.WriteString(W, "He doesn't want MagicNumber"); Texts.WriteLn(W); END; IF (NegMagicNumber IN f.go.O) THEN Texts.WriteString(W, "MagicNumber active"); Texts.WriteLn(W); ELSE Texts.WriteString(W, "MagicNumber disabled"); Texts.WriteLn(W); END; END; Texts.WriteString(W, "IPCP is in state: "); FSM.GiveState(g.State, s); Texts.WriteString(W, s); Texts.WriteLn(W); IF g.State=FSM.Opened THEN Texts.WriteString(W, "our Ip-Adr: "); ip:=g.go.OurAddress; FOR i:=0 TO 2 DO 					Texts.WriteInt(W, ORD(SYSTEM.VAL(CHAR, ip[i])),3); Texts.Write(W, "."); END; Texts.WriteInt(W, ORD(SYSTEM.VAL(CHAR, ip[3])),3); Texts.WriteLn(W); Texts.WriteString(W, "his Ip-Adr: "); ip:=g.ho.HisAddress; FOR i:=0 TO 2 DO 					Texts.WriteInt(W, ORD(SYSTEM.VAL(CHAR, ip[i])),3); Texts.Write(W, "."); END; Texts.WriteInt(W, ORD(SYSTEM.VAL(CHAR, ip[3])),3); Texts.WriteLn(W); (*			IF (NegVJ IN g.go.O) THEN 						Texts.WriteString(W, "He wanted VJ:    MaxSlot: ");  						Texts.WriteInt(W, g.ho.MaxSlot, 4); 					Texts.WriteString(W, "     CFlag: ");  					Texts.WriteInt(W, g.ho.CFlag, 4); Texts.WriteLn(W);  					END; 	*)		END; Texts.WriteString(W, "PAP is in state: "); PAP.GiveState(h, s); Texts.WriteString(W, s); Texts.WriteLn(W); (*es*)Texts.Append(Oberon.Log, W.buf) (*Texts.Append(XOberon.XLog, W.buf)*) END END Stats; BEGIN ppp := NIL; LCP.PPPHandleLCPUp:=LCPUp; LCP.PPPHandleLCPDown:=LCPDown; LCP.PPPHandleProtRej:=LCPProtRej; IPCP.PPPHandleIPCPUp:=IPCPUp; IPCP.PPPHandleIPCPDown:=IPCPDown; HDLC.PPPHandleReceive:=Receive; END PPPMain. System.Free PPPMain PPPLCP PPPIPCP PPPFSM PPPHDLC PPPTools PacketTools ~ XPPCCompiler.Compile PPPTools.Mod \Ns PPPHDLC.Mod \Ns PPPPAP.Mod \Ns PPPFSM.Mod \Ns PPPIPCP.Mod\Ns PPPLCP.Mod\Ns PPPMain.Mod \Ns ~ XSystem.Call Cache40.Disable~ Install fuer Windows NT XSystem.Call PPPMain.InstPPP "/TO" 5 "/IP" 0 0 0 0 0 0 0 0 "/Netmask" 255 255 255 224 "/MRUWant" 1500 "/MRUAllow" "/AsyWant" "00000000" "/AsyAllow" "00000000" "/PAPName" "ppp" "/PAPPasswd" "mopsppp" "/SString" "CLIENT" ~ Install fuer SUN XSystem.Call PPPMain.InstPPP "/TO" 5 "/IP" 0 0 0 0 0 0 0 0 "/Netmask" 255 255 255 248 "/MRUWant" 1500 "/MRUAllow" "/AsyWant" "00000000" "/AsyAllow" "00000000" "/Silent" "/LoginName" "ppp" "/LoginPasswd" "mopsppp" ~ (*es*) PPPMain.InstPPP "/TO" 5 	    "/IP" 0 0 0 0  0 0 0 0 "/Netmask" 255 255 255 248  "/MRUWant" 1500 "/MRUAllow"   						"/AsyWant" "00000000" "/AsyAllow" "00000000"         "/Silent" ~ XSystem.Call	PPPMain.Stats ~ XSystem.Call SetCD.Off "129.132.37.143" "129.132.37.129" ~ XSystem.Call TestCD.List ~ do some work XSystem.Call SetCD.On"129.132.37.143" "129.132.37.129" ~ XSystem.Call	PPPMain.RemovePPP ~ XSystem.Call RSystem.Free PPPMain ~ XSystem.Call RSystem.Free PPPLCP ~ XSystem.Call RSystem.Free PPPIPCP ~ XSystem.Call RSystem.Free PPPFSM ~ XSystem.Call RSystem.Free PPPPAP ~ XSystem.Call RSystem.Free PPPHDLC ~ XSystem.Call RSystem.Free PPPTools ~ XSystem.Call XMemTool.Dump 7E0000H 4000H T ~ XSystem.Call XMemTool.Dump 3E0000H 4000H T ~ My.Config

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/

title: Oberon/ETH Oberon/2.3.7/PPPMain.Mod


text:
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.

title: Oberon/ETH Oberon/2.3.7/PPPPAP.Mod


text:
Oberon/ETH Oberon/2.3.7/PPPTest.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 PPPTest;	(** non-portable *)	(* pjm *) (* $VCS  4, Edgar@EdgarSchwarz.de, 06.06.00 22:03:24 $     $Log$ $   4, Edgar@EdgarSchwarz.de, 06.06.00 22:03:24 better decoding of David Denny $   3, Edgar@EdgarSchwarz.de, 25 Apr :0, 11:19:10 decoding stuff added, ShowLog opens PPPDebug.Log $   2, Edgar.Schwarz@z.zgs.de, 6 Sep 99, 22:5:49 ShowLog and ShowHex removed $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 21:19:47 first versioned version, with configurable logging *) (* Test procedures for PPP *) IMPORT SYSTEM, PPPDebug, PPPHDLC, PPPFSM, Texts, Oberon, Fonts, Out; CONST MaxSize = 10000H; (* codes not exported by PPPFSM *) TermReq = 5;	(* termination request *) TermAck = 6;	(* termination ack *) CodeRej = 7;	(* code reject *) ProtRej = 8; 	(* protocol reject *) EchoReq = 9; EchoReply = 10; DiscardReq = 11; (* LCP option types *) MRU = 1; AsyncControl = 2; Authentication = 3; Quality = 4; Magic = 5; RESERVED = 6; ProtComp = 7; AddrCtrlComp = 8; (* IPCP option types *) IpAddrs = 1; IpComp = 2; IpAddr = 3; (* Authentification codes *) AuthReq = 1; AuthAck = 2; AuthNak = 3; VAR w: Texts.Writer; (* for hex numbers less than MAX(LONGINT) *) PROCEDURE HexToInt(hexStr: ARRAY OF CHAR): LONGINT; VAR pos, int: LONGINT; BEGIN pos := 0; int := 0; WHILE hexStr[pos] # 0X DO 		CASE hexStr[pos] OF 			"0".."9": int := 16 * int + ORD(hexStr[pos]) - ORD("0"); | "a".."f": int := 16 * int + ORD(hexStr[pos]) - ORD("a") + 10; | "A".."F": int := 16 * int + ORD(hexStr[pos]) - ORD("A") + 10; END; INC(pos); END; RETURN int; END HexToInt; PROCEDURE ReadHexByteString(VAR r: Texts.Reader; VAR hexStr: ARRAY OF CHAR); VAR hexPos: LONGINT; ch: CHAR; BEGIN hexPos := 0; LOOP Texts.Read(r, ch); CASE ch OF 			"0".."9", "a".."f", "A".."F": hexStr[hexPos] := ch; INC(hexPos); IF hexPos = 2 THEN hexStr[hexPos] := 0X; RETURN; END; ELSE END; END; END ReadHexByteString; PROCEDURE ReadHexByte(VAR r: Texts.Reader): LONGINT; VAR	hexPos: LONGINT; hexStr: ARRAY 3 OF CHAR; ch: CHAR; BEGIN hexPos := 0; LOOP Texts.Read(r, ch); CASE ch OF 			"0".."9", "a".."f", "A".."F": hexStr[hexPos] := ch; INC(hexPos); IF hexPos = 2 THEN hexStr[hexPos] := 0X; RETURN HexToInt(hexStr); hexPos := 0; END; ELSE END; END; END ReadHexByte; PROCEDURE WriteHex(x, width: LONGINT); VAR buf: ARRAY 9 OF CHAR; i, j: LONGINT; BEGIN buf[0] := " ";	buf[1] := 0X; IF width >= 0 THEN j := 8 ELSE j := 2; width := -width END; FOR i := j+1 TO width DO Texts.WriteString(w, buf) END; FOR i := j-1 TO 0 BY -1 DO 		buf[i] := CHR(x MOD 10H + 48); IF buf[i] > "9" THEN buf[i] := CHR(ORD(buf[i]) - 48 + 65 - 10) END; x := x DIV 10H END; buf[j] := 0X; Texts.WriteString(w, buf) END WriteHex; PROCEDURE LCPConfOpt(VAR r: Texts.Reader; VAR read: LONGINT); VAR type, len, i: LONGINT; hexStr: ARRAY 3 OF CHAR; BEGIN type := ReadHexByte(r); INC(read); CASE type OF 		MRU: Out.String(" MRU");  len := ReadHexByte(r); Out.Int(256*ReadHexByte(r) + ReadHexByte(r), 6); Out.Ln; INC(read, 3); | AsyncControl: Out.String(" AsyncControl "); len := ReadHexByte(r); FOR len := 0 TO 3 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 5); | Authentication: Out.String(" Authentication "); len := ReadHexByte(r); FOR i := 1 TO len-2 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 1+len-2); | Quality: Out.String("Quality"); | Magic: Out.String(" Magic "); len := ReadHexByte(r); FOR i := 0 TO 3 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 5); | RESERVED: Out.String("RESERVED"); | ProtComp: Out.String(" Protocol-Field-Compression"); len := ReadHexByte(r); Out.Ln; INC(read, 1); | AddrCtrlComp: Out. String(" Address-and-Control-Field-Compression"); len := ReadHexByte(r); Out.Ln; INC(read, 1); ELSE Out.String(" unknown option"); Out.Int(type, 4); len := ReadHexByte(r); Out.Int(len, 4); Out.Char(" "); FOR i := 1 TO len - 2 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 1+len-2); END; END LCPConfOpt; PROCEDURE LCPConfOptions(VAR r: Texts.Reader); VAR len, read: LONGINT; BEGIN Out.Int(ReadHexByte(r), 4); (* identifier (message number) *) len := 256*ReadHexByte(r) + ReadHexByte(r); Out.Int(len, 4); Out.Ln; read := 4; WHILE read < len DO LCPConfOpt(r, read); END; END LCPConfOptions; (* System.Free PPPTest ~ Builder.Compile * PPPTest.LCPDecode ^ *) PROCEDURE LCPDecode*; VAR text: Texts.Text; r: Texts.Reader; hexPos, beg, end, time: LONGINT; hexStr: ARRAY 10 OF CHAR; ch: CHAR; BEGIN Oberon.GetSelection(text, beg, end, time); Texts.OpenReader(r, text, beg); CASE ReadHexByte(r) OF 		  PPPFSM.ConfReq:	Out.String("ConfReq"); LCPConfOptions(r); | PPPFSM.ConfAck:	Out.String("ConfAck"); LCPConfOptions(r); | PPPFSM.ConfNak:	Out.String("ConfNak"); | PPPFSM.ConfRej:	Out.String("ConfRej"); LCPConfOptions(r); | TermReq:	Out.String("TermReq"); | TermAck:	Out.String("TermAck"); | CodeRej:	Out.String("CodeRej"); | ProtRej:	Out.String("ProtocolRej"); | EchoReq: Out.String("EchoReq"); | EchoReply: Out.String("EchoReply"); ELSE Out.String("*** illegal code ***"); END; END LCPDecode; PROCEDURE IPCPConfOpt(VAR r: Texts.Reader; VAR read: LONGINT); VAR type, len, i: LONGINT; hexStr: ARRAY 3 OF CHAR; BEGIN type := ReadHexByte(r); INC(read); CASE type OF 		IpAddrs: Out.String(" IP-Addresses");  len := ReadHexByte(r); Out.Int(256*ReadHexByte(r) + ReadHexByte(r), 6); Out.Ln; INC(read, 3); | IpComp: Out.String(" IP-Compression Protocol "); len := ReadHexByte(r); FOR len := 1 TO len-2 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 1+len-2); | IpAddr: Out.String(" IP-Address "); len := ReadHexByte(r); FOR i := 1 TO len-2 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 1+len-2); ELSE Out.String(" unknown option"); Out.Int(type, 4); len := ReadHexByte(r); Out.Int(len, 4); Out.Char(" "); FOR i := 1 TO len - 2 DO 				ReadHexByteString(r, hexStr); Out.String(hexStr); END; Out.Ln; INC(read, 1+len-2); END; END IPCPConfOpt; PROCEDURE IPCPConfOptions(VAR r: Texts.Reader); VAR len, read: LONGINT; BEGIN Out.Int(ReadHexByte(r), 4); (* identifier (message number) *) len := 256*ReadHexByte(r) + ReadHexByte(r); Out.Int(len, 4); Out.Ln; read := 4; WHILE read < len DO IPCPConfOpt(r, read); END; END IPCPConfOptions; (* System.Free PPPTest ~ Builder.Compile * PPPTest.IPCPDecode ^ *) PROCEDURE IPCPDecode*; VAR text: Texts.Text; r: Texts.Reader; hexPos, beg, end, time: LONGINT; hexStr: ARRAY 10 OF CHAR; ch: CHAR; BEGIN Oberon.GetSelection(text, beg, end, time); Texts.OpenReader(r, text, beg); CASE ReadHexByte(r) OF 		  PPPFSM.ConfReq:	Out.String("ConfReq"); IPCPConfOptions(r); | PPPFSM.ConfAck:	Out.String("ConfAck"); IPCPConfOptions(r); | PPPFSM.ConfNak:	Out.String("ConfNak"); IPCPConfOptions(r); | PPPFSM.ConfRej:	Out.String("ConfRej"); IPCPConfOptions(r); | TermReq:	Out.String("TermReq"); | TermAck:	Out.String("TermAck"); | CodeRej:	Out.String("CodeRej"); ELSE Out.String("*** illegal code ***"); END; END IPCPDecode; (* System.Free PPPTest ~ Builder.Compile * PPPTest.PAPDecode ^ *) PROCEDURE PAPDecode*; VAR text: Texts.Text; r: Texts.Reader; hexPos, beg, end, time, read, len: LONGINT; hexStr: ARRAY 10 OF CHAR; ch: CHAR; BEGIN Oberon.GetSelection(text, beg, end, time); Texts.OpenReader(r, text, beg); CASE ReadHexByte(r) OF 		  AuthReq:	Out.String("AuthReq"); Out.Int(ReadHexByte(r), 4); (* identifier (message number) *) len := 256*ReadHexByte(r) + ReadHexByte(r); Out.Int(len, 4); Out.Ln; read := 4; len := ReadHexByte(r); Out.String("Peer-ID"); Out.Int(len, 4); Out.Char(" "); FOR time := 1 TO len DO Out.Char(CHR(ReadHexByte(r))); END; Out.Ln; INC(read, 1+len); len := ReadHexByte(r); Out.String("Passwd"); Out.Int(len, 4); Out.Char(" "); FOR time := 1 TO len DO Out.Char(CHR(ReadHexByte(r))); END; Out.Ln; INC(read, 1+len); | AuthAck:	Out.String("AuthAck"); Out.Int(ReadHexByte(r), 4); (* identifier (message number) *) len := 256*ReadHexByte(r) + ReadHexByte(r); Out.Int(len, 4); Out.Ln; read := 4; len := ReadHexByte(r); Out.String("Msg"); Out.Int(len, 4); Out.Char(" "); FOR time := 1 TO len DO Out.Char(CHR(ReadHexByte(r))); END; Out.Ln; INC(read, 1+len); | AuthNak:	Out.String("AuthNak"); Out.Int(ReadHexByte(r), 4); (* identifier (message number) *) len := 256*ReadHexByte(r) + ReadHexByte(r); Out.Int(len, 4); Out.Ln; read := 4; (* ohne Msg-Length (daviddenny/elena99) *) Out.String("Msg "); FOR time := 1 TO len-4 DO Out.Char(CHR(ReadHexByte(r))); END; Out.Ln; read := len; (* laut RFC 1334 				len := ReadHexByte(r); 				Out.String("Msg"); Out.Int(len, 4); Out.Char(" "); 				FOR time := 1 TO len DO Out.Char(CHR(ReadHexByte(r))); END; Out.Ln; 				INC(read, 1+len); *) ELSE Out.String("*** illegal code ***"); END; END PAPDecode; (* not sure whether still necessary because log is now going to a Text PROCEDURE ShowLogHex*; CONST W = 16; VAR t: Texts.Text;  i, j, k, adr, size: LONGINT;  x: SHORTINT; BEGIN 	NEW(t);  Texts.Open(t, ""); 	size := PPPDebug.LogLen; 	i := 0;  adr := SYSTEM.ADR(PPPDebug.Log[0]); 	WHILE (i < size) DO 		WriteHex(adr+i, 8);  Texts.WriteString(w, "H: "); 		(* Do Hex dump. *) 		j := i; 		WHILE (j < i+W) & (j < size) DO 			SYSTEM.GET(adr+j, x); 			WriteHex(x, -3); 			INC(j) 		END; 		(* Spaces between Hex dump and ASCII dump. *) 		FOR k := j TO i+W-1 DO Texts.WriteString(w, "  ") END; 		Texts.WriteString(w, "     "); 		(* Do ASCII dump. *) 		j := i; 		WHILE (j < i+W) & (j < size) DO 			SYSTEM.GET(adr+j, x); 			IF (x > 01FH) & (x < 07FH) THEN Texts.Write(w, CHR(x)) 			ELSE Texts.Write(w, ".") END; 			INC(j) 		END; 		Texts.WriteLn(w); 		INC(i, W) 	END; 	Texts.Append(t, w.buf); 	Oberon.OpenText("", t, 400, 200) END ShowLogHex; ***) PROCEDURE ShowLog*; BEGIN Oberon.OpenText("PPP.Log", PPPDebug.Log, 400, 200) END ShowLog; (** managing the flag for logging PPP traffic for debugging. Default is off *) PROCEDURE LogState*; BEGIN IF PPPHDLC.debug THEN Out.String("PPP logging is on"); Out.Ln; ELSE Out.String("PPP logging is off"); Out.Ln; END; END LogState; PROCEDURE LogOn*; BEGIN PPPHDLC.debug := TRUE; Out.String("PPP logging turned on"); Out.Ln; END LogOn; PROCEDURE LogOff*; BEGIN PPPHDLC.debug := FALSE; Out.String("PPP logging turned off"); Out.Ln; END LogOff; BEGIN Texts.OpenWriter(w); Texts.SetFont(w, Fonts.This("Courier10.Scn.Fnt")) END PPPTest. (* PPPTest.ShowLog PPPTest.ShowLogHex *) PPPTest.LogState PPPTest.LogOn PPPTest.LogOff

title: Oberon/ETH Oberon/2.3.7/PPPTest.Mod


text:
Oberon/ETH Oberon/2.3.7/PPPTools.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 PPPTools;	(** non-portable *) (* $VCS  1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:9:47 $     $Log$ $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:9:47 version for PPP 1.0.0 *) IMPORT SYSTEM, PT := (*es*) NetBase, NetIP (*PacketTools*), Debug := PPPDebug; CONST GoodFCS = - 0F48H;	(* 0F0B8H *) InitialFCS = - 1H;	(* 0FFFFH *) VAR FCSTable: ARRAY 256 OF INTEGER; PROCEDURE XOR(a, b:INTEGER): INTEGER; BEGIN RETURN SYSTEM.VAL(INTEGER, (SYSTEM.VAL(SET, LONG(a)) / SYSTEM.VAL(SET, LONG(b)))) END XOR; (*es*) (* aktiviert *) PROCEDURE FCS (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER; VAR code, i: INTEGER;	(* we use 16 bit chksum *) BEGIN code := InitialFCS; FOR i := pos TO pos+len-1 DO 		code := XOR(SYSTEM.LSH(code, - 8), FCSTable[SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET, LONG(XOR(code, SYSTEM.VAL(SHORTINT, a[i])))) * {0..7})]) END; RETURN code END FCS; (**) PROCEDURE CalcFCS16; BEGIN END CalcFCS16; (* PROCEDURE -CalcFCS16 	43H, 0F1H, 10H, 00H,					(* LEA 0(A1, D1.W), D1 *) 	70H, 0FFH,									(* MOVEQ #-1, D0 *) 	4AH, 42H,									(* TST.W D2 *) 	67H, 14H,									(* BEQ.S end *) 	53H, 42H,									(* SUBQ.W #1, D2 *) 	12H, 19H,									(* MOVE.B (A1)+, D1 *) 	0B1H, 41H,								(* EOR.W D0, D1 *) 	0E0H, 48H,									(* LSR.W #8, D0 *) 	02H, 41H, 00H, 0FFH,				(* ANDI.W #$00FF, D1 *) 	32H, 30H, 12H, 00H,					(* MOVE.W 0(A0, D1.W*2), D1*) 	0B3H, 40H,									(* EOR.W D1, D0 *) 	60H, 0E8H;									(* BRA.S loop1 *) *) (*es*) (* PROCEDURE FCS (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER; CONST 	D0 = 0; D1 = 1; D2 = 2; A0 = 8; A1 = 9; VAR code: INTEGER;	 BEGIN 	SYSTEM.PUTREG(A0, SYSTEM.ADR(FCSTable)); SYSTEM.PUTREG(A1, SYSTEM.ADR(a)); 	SYSTEM.PUTREG(D1, pos); SYSTEM.PUTREG(D2, len); 	CalcFCS16; 	SYSTEM.GETREG(D0, code); 	RETURN code END FCS; *) (** CalcFCS - Calculates the FCS, should include Flag, Address etc., but no EscCodes, Space for FCS.. *) PROCEDURE CalcFCS* (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER; BEGIN RETURN XOR(FCS(a, pos, len), -1) END CalcFCS; (* CheckFCS - Checks a complete packet, including Flag, Address AND FCS-Code! Returns TRUE if Packet is ok *) PROCEDURE CheckFCS* (VAR a: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; BEGIN RETURN GoodFCS = FCS(a, pos, len) END CheckFCS; PROCEDURE GenerateFCSTab; CONST P = - 7BF8H;	(* 8408H *) VAR b, v, i:INTEGER; BEGIN FOR b := 0 TO 255 DO v := b; 		FOR i:= 0 TO 7 DO 			IF ODD(v) THEN v := XOR(SYSTEM.LSH(v, -1), P) ELSE v := SYSTEM.LSH(v, -1) END END; FCSTable[b] := v 	END END GenerateFCSTab; (*---*) PROCEDURE PutInt* (x: INTEGER; VAR p: ARRAY OF CHAR; pos: INTEGER); BEGIN p[pos + 0] := CHR(SYSTEM.LSH(x, -8) MOD 256); p[pos + 1] := CHR(x MOD 256) END PutInt; PROCEDURE GetInt* (VAR p: ARRAY OF CHAR; pos: INTEGER): INTEGER; BEGIN RETURN ORD(p[pos])*256 + ORD(p[pos + 1]) END GetInt; PROCEDURE PutLong *(x: LONGINT; VAR p: ARRAY OF CHAR; pos: INTEGER); BEGIN p[pos + 0] := CHR(SYSTEM.LSH(x, -24) MOD 256); p[pos + 1] := CHR(SYSTEM.LSH(x, -16) MOD 256); p[pos + 2] := CHR(SYSTEM.LSH(x, -8) MOD 256); p[pos + 3] := CHR(x MOD 256) END PutLong; PROCEDURE GetLong* (VAR p: ARRAY OF CHAR; pos: INTEGER): LONGINT; BEGIN RETURN ((LONG(ORD(p[pos]))*256 + LONG(ORD(p[pos + 1])))*256 		+ LONG(ORD(p[pos + 2])))*256 + LONG(ORD(p[pos + 3])) END GetLong; PROCEDURE GetSet* (VAR p: ARRAY OF CHAR; pos: INTEGER): SET; BEGIN RETURN SYSTEM.VAL(SET, GetLong(p, pos)) END GetSet; PROCEDURE PutSet* (x: SET; VAR p: ARRAY OF CHAR; pos: INTEGER); BEGIN PutLong(SYSTEM.VAL(LONGINT, x), p, pos) END PutSet; PROCEDURE GetIP* (VAR p: ARRAY OF CHAR; pos: INTEGER; 								   VAR x: (*es*)NetIP.Adr(*PT.IPAdr*)); VAR i: INTEGER; BEGIN FOR i := 0 TO (*es*)NetIP.AdrLen(*PT.IPAdrLen*) - 1 DO x[i] := p[pos + i] END END GetIP; PROCEDURE PutIP* (VAR x: (*es*)NetIP.Adr(*PT.IPAdr*); VAR p: ARRAY OF CHAR; pos: INTEGER); VAR i: INTEGER; BEGIN FOR i := 0 TO (*es*)NetIP.AdrLen(*PT.IPAdrLen*) - 1 DO 		p[pos + i] := SYSTEM.VAL(CHAR,x[i])(*x[i]*) END END PutIP; PROCEDURE EqualIP* (VAR p: ARRAY OF CHAR; pos: INTEGER; 									VAR x: (*es*)NetIP.Adr(*PT.IPAdr*)): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE (i # (*es*)NetIP.AdrLen(*PT.IPAdrLen*)) & ((*es*)SYSTEM.VAL(CHAR,x[i])(*x[i]*) = p[pos + i]) DO 		INC(i) END; RETURN i = (*es*)NetIP.AdrLen(*PT.IPAdrLen*) END EqualIP; PROCEDURE CopyString* (VAR a: ARRAY OF CHAR; posfrom, posto, len: INTEGER); VAR i: INTEGER; BEGIN IF posfrom > posto THEN		FOR i := 0 TO len - 1 DO a[posto + i] := a[posfrom + i] END ELSIF posfrom < posto THEN FOR i := len - 1 TO 0 BY - 1 DO a[posto + i] := a[posfrom + i] END END END CopyString; PROCEDURE Magic* : LONGINT; BEGIN RETURN 0; END Magic; PROCEDURE OutPacket* (VAR p: ARRAY OF CHAR; pos, len: INTEGER); VAR i: INTEGER; BEGIN FOR i := 0 TO len - 1 DO 		Debug.HexByte(p[pos + i]); IF i MOD  4 = 3 THEN Debug.String(" "); END; IF i MOD 16 = 15 THEN Debug.Ln END; END; (* 	FOR i := 0 TO len BY 4 DO 		Debug.Hex(SYSTEM.VAL(LONGINT, p[pos + i])); Debug.String(" "); 		IF i MOD 16 = 0 THEN Debug.Ln END 	END; 	*) Debug.Ln END OutPacket; PROCEDURE WriteSet*(s:SET; VAR a:ARRAY OF CHAR); VAR k,i:INTEGER; BEGIN k:=0; FOR i:=31 TO 0 BY -1 DO	IF (i IN s) THEN a[k]:="1"; ELSE a[k]:="0"; END; INC(k); END; a[k]:=0X; END WriteSet; BEGIN GenerateFCSTab END PPPTools.

title: Oberon/ETH Oberon/2.3.7/PPPTools.Mod


text:
Oberon/ETH Oberon/PPPLCP.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 PPPLCP;	(** non-portable *) (* $VCS  4, Edgar@EdgarSchwarz.de, 9 May :0, 1:20:35 $     $Log$ $   4, Edgar@EdgarSchwarz.de, 9 May :0, 1:20:35 more debug info with auth stuff $   3, Edgar@EdgarSchwarz.de, 25 Apr :0, 10:47:30 more debug info, drop Identification code $   2, Edgar.Schwarz@z.zgs.de, 5 Sep 99, 13:49:32 minimal length for echo request set to 4 bytes $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:19:22 version for PPP 1.0.0 *) IMPORT FSM := PPPFSM, PAP := PPPPAP, HDLC := PPPHDLC, T := PPPTools, Debug := PPPDebug, SYSTEM; CONST (* Protocol Constants *) DefMRU = HDLC.MTU; MinMRU = 128; MaxMRU = HDLC.MTU; WarnLoops = 10; 				(* Warn about loop-backs this often *) LCP*=-03FDFH; (* =0C021H *) (* Configure Information Options *) Illegal0 = 0;					(*es some PPP implementations send that *) MRU = 1;						(* Maximum Receive Unit *) AsyncMap = 2;				(* Async Control Character Map *) AuthType = 3;				(* Authentication Protocol *) Quality = 4;					(* Quality Protocol *) MagicNumber = 5; (* = 6; *)                       (*es RESERVED*) PCompression = 7;		(* Protocol Field Compression *) ACCompression = 8;		(* Address And Control Field Compression *) (*es extensions from RFC1570 Jan 1994 *) (* = 9; *)                     (*es FCSAlternatives *) (* = 10; *)                   (*es Self Describing Padding *) (* = 13; *)                   (*es Callback *) (* = 15; *)                   (*es Compound Frames *) LCPConf17 = 17;          (*es* ? *) LCPConf19 = 19;          (*es* ? *) (* LCP codes *) ProtocolRej = 8;	EchoReq = 9;	EchoReply = 10;	DiscardReq = 11; (*es*)Identification = 12; TimeRemaining = 13; (**) (* Options Index *) Passive* = FSM.Passive;	(* Don't die if we get no response *) Silent* = FSM.Silent;		(* Wait for the other end to start first *) NegMRU* = 8; NegAsyncMap* = 9; NegUPap* = 10; (* Negotiate MRU, Async Map, User/Password *) NegChap = 11; NegMagicNumber* = 12; NegPComp = 13; (* Crypt-Auth, MagicNumber, PCompression *) NegACComp = 14; NegLqr = 15; (* AC-Compr., Link Quality Reports *) (* Length of the Configuration Options *) VoidLen = 2; ShortLen = 4; ChapLen = 5; LongLen = 6; LqrLen = 8; (* = Type (1 Byte) + Length (1 Byte) + Data *) TYPE Options*=RECORD O*: SET								(* Bits defined by Options Index *); MRU*:INTEGER;					(* Max. Receive Unit *) MagicNumb*:LONGINT; NumLoops*:INTEGER;		(* Magic Number Stuff *) AsyncMap*:SET; END; LCPfsm*=POINTER TO LCPfsmDesc; LCPfsmDesc=RECORD (FSM.FSMDesc) wo*, go(*es*)*(*-*),ao*, ho(*es*)*(*-*): Options; (* WantOptions, GotOptions, AllowOptions, HisOptions *) END; VAR (* Upcalls to PPP *) PPPHandleLCPUp*: PROCEDURE (U:HDLC.PPPUnit); PPPHandleLCPDown*: PROCEDURE (U:HDLC.PPPUnit); PPPHandleProtRej*: PROCEDURE (U:HDLC.PPPUnit; prot:INTEGER); (* Open - LCP can come up *) PROCEDURE Open* (f: LCPfsm); BEGIN	f.Flags:=f.wo.O*{Passive, Silent}; FSM.Open(f); END Open; (* Close - Take LCP down *) PROCEDURE Close* (f: LCPfsm); BEGIN IF (f.State=FSM.Stopped) & (f.Flags*{Passive, Silent} # {}) THEN	f.State:=FSM.Closed ELSE	FSM.Close(f) END END Close; (* LowerUp - The Lower Layer is Up *) PROCEDURE LowerUp* (f: LCPfsm); BEGIN f.HDLCConfig.MTU:=DefMRU; f.HDLCConfig.SendAsyncMap:={0..31}; (* Send Configuration *) f.HDLCConfig.MRU:=DefMRU; (* Receive Configuration *) f.ao.AsyncMap:={}; FSM.LowerUp(f) END LowerUp; (* LowerDown - The Lower Layer is Down *) PROCEDURE LowerDown* (f: LCPfsm); BEGIN FSM.LowerDown(f) END LowerDown; (* Input - New LCP Packet *) PROCEDURE Input* (f: LCPfsm; VAR p: ARRAY OF CHAR; pos, len:INTEGER); BEGIN FSM.Input(f, p, pos, len); END Input; (* SendProtRej - Send a Protocol Reject *) PROCEDURE SendProtRej* (f: LCPfsm; VAR p: ARRAY OF CHAR; pos, len:INTEGER); BEGIN INC(f.ID); FSM.SendData(f, ProtocolRej, f.ID, p, pos+2, len-2); END SendProtRej; (* ResetCI - Reset The Configuration Information *) PROCEDURE *ResetCI (f: FSM.FSM); BEGIN IF HDLC.debug THEN Debug.String("reset CI"); Debug.Ln; END; WITH f:LCPfsm DO 			f.wo.MagicNumb:=T.Magic; f.wo.NumLoops:=0;		(* WantOptions *) f.go:=f.wo;		(* GotOptions := WantOptions *) f.HDLCConfig.MTU:=HDLC.MTU			(* Max. Transmit Unit *) END END ResetCI; (* CILen - Returns Length of the Conf. Inf. *) PROCEDURE *CILen (f: FSM.FSM): INTEGER; VAR i: INTEGER; BEGIN i:=0; WITH f:LCPfsm DO 			IF (NegMRU IN f.go.O) THEN INC(i, ShortLen); END; IF (NegAsyncMap IN f.go.O) THEN INC(i, LongLen); END; IF (NegMagicNumber IN f.go.O) THEN INC(i, LongLen); END; (* To update if more Options supported *) END; RETURN i 	END CILen; (* AddCI - Add our desired Conf. Inf. to a packet (at pos) *) PROCEDURE *AddCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos: INTEGER; VAR len: INTEGER); BEGIN len:=0; IF HDLC.debug THEN FSM.OutLog("LCP.AddCI", "", f); END; WITH f:LCPfsm DO 			IF (NegMRU IN f.go.O) THEN INC(len, ShortLen); IF HDLC.debug THEN Debug.String("MRU "); END; p[pos]:=CHR(MRU); p[pos+1]:=CHR(ShortLen); T.PutInt(f.go.MRU, p, pos+2); INC(pos, ShortLen); END; IF (NegAsyncMap IN f.go.O) THEN INC(len, LongLen); IF HDLC.debug THEN Debug.String("AsyncMap "); END; p[pos]:=CHR(AsyncMap); p[pos+1]:=CHR(LongLen); T.PutSet(f.go.AsyncMap, p, pos+2); INC(pos, LongLen); END; IF (NegMagicNumber IN f.go.O) THEN INC(len, LongLen); IF HDLC.debug THEN Debug.String("MagicNumber "); END; p[pos]:=CHR(MagicNumber); p[pos+1]:=CHR(LongLen); T.PutLong(f.go.MagicNumb, p, pos+2); INC(pos, LongLen) END END;																							(* To update if more Options supported *) IF HDLC.debug THEN Debug.Ln; Debug.Ln; END END AddCI; (* AckCI - An Ack Packet has been received as answer to our req *) PROCEDURE *AckCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; VAR b:BOOLEAN; BEGIN b:=TRUE; WITH f:LCPfsm DO				(* No changes to our former req are allowed, otherwise the ack is bad *) IF (NegMRU IN f.go.O) THEN b:= b & (len>=ShortLen) & (ORD(p[pos])=MRU) & (ORD(p[pos+1])=ShortLen) & (T.GetInt(p, pos+2)=f.go.MRU); DEC(len, ShortLen); INC(pos, ShortLen); END; IF (NegAsyncMap IN f.go.O) THEN b:=b & (len>=LongLen) & (ORD(p[pos])=AsyncMap) & (ORD(p[pos+1])=LongLen) & (T.GetSet(p, pos+2)=f.go.AsyncMap); DEC(len, LongLen); INC(pos, LongLen); END; IF (NegMagicNumber IN f.go.O) THEN b:=b & (len>=LongLen) & (ORD(p[pos])=MagicNumber) & (ORD(p[pos+1])=LongLen) & (T.GetLong(p, pos+2)=f.go.MagicNumb); DEC(len, LongLen); INC(pos, LongLen); END; (* To update if more Options supported *) b:=b & (len=0); IF HDLC.debug & ~b THEN Debug.String("Received bad Ack!!"); Debug.Ln END; RETURN b 		END END AckCI; (* NakCI - A Nak Packet has been received as answer to our req *) PROCEDURE *NakCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; VAR no, try: Options;	(* no: Options with Naks, try: Options we try next time *) x, type, size:INTEGER; loopedback, b:BOOLEAN; BEGIN WITH f:LCPfsm DO				(* same order as we sent it, but only the nak'd ones *) no.O:={}; try.O:=f.go.O; 			IF (NegMRU IN f.go.O) & (len>=ShortLen) & (ORD(p[pos])=MRU) & (ORD(p[pos+1])=ShortLen) THEN x:=T.GetInt(p, pos+2); IF (x=LongLen) & (ORD(p[pos])=AsyncMap) & (ORD(p[pos+1])=LongLen) THEN INCL(no.O, NegAsyncMap); try.AsyncMap:=try.AsyncMap + T.GetSet(p, pos+2); DEC(len, LongLen); INC(pos, LongLen); 	(* Include New Chars (our receive side)*) END; IF (NegMagicNumber IN f.go.O) & (len>=LongLen) & (ORD(p[pos])=MagicNumber) & (ORD(p[pos+1])=LongLen) THEN INCL(no.O, NegMagicNumber); try.MagicNumb:=T.Magic; INC(try.NumLoops); loopedback:=TRUE; DEC(len, LongLen); INC(pos, LongLen); END; b:=TRUE;						(* there may be remaining options, but no changes possible ! (Just checking if Nak is ok) *) WHILE b & (len>VoidLen) DO 				type:=ORD(p[pos]); size:=ORD(p[pos+1]); CASE type OF 					 MRU: b:=((size=ShortLen) & ~(NegMRU IN f.go.O) & ~(NegMRU IN no.O)); | AsyncMap: b:=((size=LongLen) & ~(NegAsyncMap IN f.go.O) & ~(NegAsyncMap IN no.O)); | MagicNumber: b:=((size=LongLen) & ~(NegMagicNumber IN f.go.O) & ~(NegMagicNumber IN no.O)); | PCompression, ACCompression: b:=(size=VoidLen); | Quality: b:=(size=LqrLen); | AuthType: b:=((size=ChapLen) OR (size=ShortLen)); ELSE	(* probably an unknown Configuration Option *) END; INC(pos, size); END; b:=b & (len=0); IF b & (f.State#FSM.Opened) THEN f.go:=try;		 (* Update State *) IF loopedback & ((try.NumLoops MOD WarnLoops) = 0) THEN Debug.String("This line could be looped back!!"); Debug.Ln; END; END; RETURN b 		END END NakCI; (* RejCI - A Reject Packet has been received as answer to our req*) PROCEDURE *RejCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; VAR try: Options; (* try: Option to request next time *) BEGIN WITH f:LCPfsm DO	(* Look which options were rejected. Same order and same value! Otherwise a bad packet. *) try:=f.go; IF (NegMRU IN f.go.O) & (len>=ShortLen) & (ORD(p[pos])=MRU) & (ORD(p[pos+1])=ShortLen) & (T.GetInt(p, pos+2)=f.go.MRU) THEN DEC(len, ShortLen); INC(pos, ShortLen); EXCL(try.O, NegMRU); END; IF (NegAsyncMap IN f.go.O) & (len>=LongLen) & (ORD(p[pos])=AsyncMap) & (ORD(p[pos+1])=LongLen) & (T.GetSet(p, pos+2)=f.go.AsyncMap) THEN DEC(len, LongLen); INC(pos, LongLen); EXCL(try.O, NegAsyncMap); END; IF (NegMagicNumber IN f.go.O) & (len>=LongLen) & (ORD(p[pos])=MagicNumber) & (ORD(p[pos+1])=LongLen) & (T.GetLong(p, pos+2)=f.go.MagicNumb) THEN DEC(len, LongLen); INC(pos, LongLen); EXCL(try.O, NegMagicNumber); END; IF len#0 THEN IF HDLC.debug THEN Debug.String("Received bad Reject !"); END; RETURN FALSE ELSE	IF f.State#FSM.Opened THEN	f.go:=try; END;	(* Update the Options *) RETURN TRUE END END END RejCI; (* ReqCI - Conf. Request has arrived: Check the requested CIs and send 		appropriate response 		Returns:  ConfigureAck, ConfigureNak or ConfigureReject and modified  		packet (p, pos, length in len) 		If Mode is true, always send Reject, never Nak *) PROCEDURE ReqCI (f: FSM.FSM; VAR p: ARRAY OF CHAR; 							VAR pos, len: INTEGER; Mode: BOOLEAN): SHORTINT; CONST Ack=0; Nak=1; Rej=2; RejAll=3; VAR type, size, posp, posw, lenp, x: INTEGER; y: LONGINT; eo, s: SET; (* eo: Error-Options: Options to Nak/Rej *) status: SHORTINT; (* Ack: Can Ack, Nak: Should Nak,  Rej: reject of 			some options needed, RejAll: serious reject: rej whole packet *) BEGIN eo:={}; (* Two steps: 		 First find out if packet can be accepted, or have to be naked or rejected  		 Second step: If nak, then modify (better proposals),  		 	if rej then send back same packet *) WITH f:LCPfsm DO 			lenp:=len; posp:=pos; status:=Ack; f.ho.O:={}; WHILE (status#RejAll) & (lenp>=VoidLen) DO 				size:=ORD(p[posp+1]); IF (sizelenp) THEN ELSE type:=ORD(p[posp]); CASE type OF 						 (*es reject 0 if a bad peer sends it *) Illegal0: status:=Rej; INCL(eo, Illegal0); IF HDLC.debug THEN Debug.String("RejIllegal0 "); END; | (**) MRU: INCL(f.ho.O, NegMRU); IF (NegMRU IN f.ao.O) & (size=ShortLen) THEN x:=T.GetInt(p, posp+2); f.ho.MRU:=x; IF (xNAK *) INCL(eo, MRU); IF status=Ack THEN status:=Nak; END; END; ELSE IF HDLC.debug THEN Debug.String("RejMRU "); END; status:=Rej; INCL(eo, MRU); END; | AsyncMap: INCL(f.ho.O, NegAsyncMap); IF (NegAsyncMap IN f.ao.O) & (size=LongLen) THEN s:=T.GetSet(p, posp+2); f.ho.AsyncMap:=s; IF (f.ao.AsyncMap * (s/{0..31} (* = ~s *)) # {} ) THEN (* at least our options needed *) INCL(eo, AsyncMap); IF status=Ack THEN status:=Nak; END; END; ELSE IF HDLC.debug THEN Debug.String("RejAsyncMap "); END; status:=Rej; INCL(eo, AsyncMap); END; | MagicNumber: INCL(f.ho.O, NegMagicNumber); IF (NegMagicNumber IN f.ao.O) & (size=LongLen) THEN y:=T.GetLong(p, posp+2); f.ho.MagicNumb:=y; IF(NegMagicNumber IN f.go.O)&(y=f.go.MagicNumb)THEN (* MagicNumber MUST be different *) INCL(eo, MagicNumber); IF status=Ack THEN status:=Nak; END; END; ELSE IF HDLC.debug THEN Debug.String("RejMagic "); END; status:=Rej; INCL(eo, MagicNumber); END; | AuthType: (*es*)				 IF HDLC.debug THEN Debug.String("LCP.ReCI: AuthType"); Debug.Ln; (**)	 				END; IF size>=ShortLen THEN x := T.GetInt(p, posp+2); (*es*)				 	IF HDLC.debug THEN Debug.String("x ="); Debug.Int(x, 3); Debug.Ln; (**)	 					END; IF x = PAP.PAPProt THEN (*UPap *) IF (NegUPap IN f.ao.O) & (size >= ShortLen) THEN (* dm:1.10.96: size = ShortLen *) INCL(f.ho.O, NegUPap); (*es*)							 IF HDLC.debug THEN Debug.String("LCP.ReCI: NegUPap added to his options"); Debug.Ln; (**)	 							END; ELSE (*es*)							 IF HDLC.debug THEN Debug.String("RejNegUPap "); Debug.Int(size,5); Debug.Int(ShortLen,5); Debug.Ln; (**)	 							END; status := Rej; INCL(eo, AuthType); END ELSE (*es*)				 		Debug.String("LCP.ReCI: AuthType CHAP not supported"); Debug.Ln; INCL(f.ho.O, NegChap); INCL(eo, AuthType); IF status = Ack THEN status := Nak END; END ELSE IF HDLC.debug THEN Debug.String("RejAuth "); END; status := Rej; INCL(eo, AuthType); END; Debug.Ln 						| PCompression: INCL(f.ho.O, NegPComp); status:=Rej; IF HDLC.debug THEN Debug.String("RejPFComp "); END; INCL(eo, PCompression);	(* not supported *) | ACCompression: INCL(f.ho.O, NegACComp); status:=Rej; IF HDLC.debug THEN Debug.String("RejACComp "); END; INCL(eo, ACCompression);	(* not supported *) | Quality: INCL(f.ho.O, NegLqr); status:=Rej; IF HDLC.debug THEN Debug.String("RejQuality "); END; INCL(eo, Quality);	(* not supported *) (*es es fehlt weitere Info, einfach mal ablehnen *) | LCPConf17: status:=Rej; INCL(eo, LCPConf17);	(* not supported *) IF HDLC.debug THEN Debug.String("RejLCPConf17 "); END; | LCPConf19: status:=Rej; IF HDLC.debug THEN Debug.String("RejLCPConf19 "); END; INCL(eo, LCPConf19);	(* not supported *) (**) 					ELSE status:=Rej; (* unknown Type ->reject *) Debug.String("unknown type"); (*es*)Debug.Int(type, 5); (**) Debug.Ln; END; DEC(lenp, size); INC(posp, size); END; END; IF lenp # 0 THEN status:=RejAll; END; IF (status=RejAll) THEN RETURN FSM.ConfRej;(* len, pos are ok *) ELSIF (status=Ack) THEN RETURN FSM.ConfAck; (* len, pos are ok *) ELSE	IF Mode THEN status:=Rej; END; (* little hack *) IF status = Rej THEN EXCL(eo, AuthType) END; lenp:=len; posp:=pos; posw:=pos; WHILE lenp#0 DO 					type:=ORD(p[posp]); size:=ORD(p[posp+1]); IF (type IN eo) THEN IF status=Nak THEN 	(* make better proposals *) CASE type OF 								  MRU: T.PutInt(MinMRU, p, posp+2); (* write over old values *) | AsyncMap: T.PutSet(f.ao.AsyncMap+ f.ho.AsyncMap, p, posp+2); | MagicNumber: T.PutLong(T.Magic, p, posp+2); |AuthType: T.PutInt(PAP.PAPProt, p, posp+2); ELSE END END; IF posw # posp THEN T.CopyString(p, posp, posw, size); END; INC(posw,size); (* 'shift' it together *) END; INC(posp, size); DEC(lenp, size); END; len:=posw-pos; IF status=Rej THEN RETURN FSM.ConfRej; ELSE RETURN FSM.ConfNak; END; END END; END ReqCI; (* Up - LCP is ready *) PROCEDURE *Up (f: FSM.FSM); VAR x:INTEGER; s:SET; BEGIN WITH f: LCPfsm DO (* Configure our HDLC: Receive: MTU: Take WantOption, but not bigger than our Allow Option! *) IF (NegMRU IN f.ho.O) THEN x:=f.ho.MRU; ELSE x:=HDLC.MTU; END; IF x>f.ao.MRU THEN x:=f.ao.MRU; END; f.HDLCConfig.MTU:=x; IF (NegAsyncMap IN f.ho.O) THEN s:=f.ho.AsyncMap; ELSE s:={0..31}; END; f.HDLCConfig.SendAsyncMap:=s; (* Receive Config *) IF (NegMRU IN f.wo.O) THEN x:=f.go.MRU ELSE x:=HDLC.MTU; END; f.HDLCConfig.MRU:=x; PPPHandleLCPUp(f.HDLCConfig); 	(* PPP will inform other protocols *) END; END Up; (* Down - LCP has to close *) PROCEDURE *Down (f: FSM.FSM); BEGIN PPPHandleLCPDown(f.HDLCConfig); 	(* PPP will inform other protocols *) f.HDLCConfig.MTU:=HDLC.MTU; f.HDLCConfig.SendAsyncMap:={0..31}; f.HDLCConfig.MRU:=HDLC.MTU; END Down; (* RecProtRej - Protocol Reject received *) PROCEDURE *RecProtRej(f: FSM.FSM; VAR p: ARRAY OF CHAR; pos, len:INTEGER); VAR prot:INTEGER; BEGIN IF len>1 THEN prot:=T.GetInt(p, pos); Debug.String(" Protocol rejected: "); Debug.Int(prot, 10); Debug.Ln; IF f.State#FSM.Opened THEN Debug.String(" Protocol reject discarded "); Debug.Ln; ELSE	PPPHandleProtRej(f.HDLCConfig, prot); 	(* PPP will inform protocols *) END ELSE Debug.String("Short ProtReject received"); Debug.Ln 		END END RecProtRej; (*		To implement if we intend to send Echo-Requests 	PROCEDURE RecEchoReply(f:FSM.FSM; id:SHORTINT; VAR p:ARRAY OF CHAR; pos, len:LONGINT); BEGIN END RecEchoReply; 	*) (* ExtCode - Handle LCP-Codes *) PROCEDURE *ExtCode(f: FSM.FSM; code, id: SHORTINT; VAR p: ARRAY OF CHAR; pos, len:INTEGER): BOOLEAN; BEGIN WITH f:LCPfsm DO 			CASE code OF 				 ProtocolRej: RecProtRej(f, p, pos, len); RETURN TRUE (** es, 4 Bytes should be enough for a echo request without data (magic only) *) | EchoReq: IF len<4 THEN len:=4; END; T.PutLong(f.go.MagicNumb, p, pos); (**				| EchoReq: IF len<6 THEN len:=6; END; T.PutLong(f.go.MagicNumb, p, pos); **) FSM.SendData(f, EchoReply, id, p, pos, len); RETURN TRUE | EchoReply: (* RecEchoReply(f, id, p, pos, len); To implement if we intend to send Echo-Requests *) RETURN TRUE | DiscardReq: RETURN TRUE (* test code for a problem of Jose Francisco , 05.10.1999, es *) | Identification: (* a peer seems to choke on CodeRej, so just try to drop it. *) RETURN TRUE ELSE RETURN FALSE END END END ExtCode; (* Initialisation LCP*) PROCEDURE Init* (VAR f:LCPfsm; wo, ao:Options; C:HDLC.PPPUnit); BEGIN NEW(f); f.Protocol:=LCP; f.ProtoName:="LCP";	(* LCP Protocol *) f.ResetCI:=ResetCI; f.CILen:=CILen; f.AddCI:=AddCI; f.AckCI:=AckCI; f.NakCI:=NakCI; f.RejCI:=RejCI; f.ReqCI:=ReqCI; f.Up:=Up; f.Down:=Down; f.ExtCode:=ExtCode; f.HDLCConfig:=C; FSM.Init(f); f.wo:=wo; f.ao:=ao END Init; END PPPLCP.

title: Oberon/ETH Oberon/PPPLCP.Mod


text:
Oberon/ETH Oberon/PPPTools.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 PPPTools;	(** non-portable *) (* $VCS  1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:9:47 $     $Log$ $   1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:9:47 version for PPP 1.0.0 *) IMPORT SYSTEM, PT := (*es*) NetBase, NetIP (*PacketTools*), Debug := PPPDebug; CONST GoodFCS = - 0F48H;	(* 0F0B8H *) InitialFCS = - 1H;	(* 0FFFFH *) VAR FCSTable: ARRAY 256 OF INTEGER; PROCEDURE XOR(a, b:INTEGER): INTEGER; BEGIN RETURN SYSTEM.VAL(INTEGER, (SYSTEM.VAL(SET, LONG(a)) / SYSTEM.VAL(SET, LONG(b)))) END XOR; (*es*) (* aktiviert *) PROCEDURE FCS (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER; VAR code, i: INTEGER;	(* we use 16 bit chksum *) BEGIN code := InitialFCS; FOR i := pos TO pos+len-1 DO 		code := XOR(SYSTEM.LSH(code, - 8), FCSTable[SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET, LONG(XOR(code, SYSTEM.VAL(SHORTINT, a[i])))) * {0..7})]) END; RETURN code END FCS; (**) PROCEDURE CalcFCS16; BEGIN END CalcFCS16; (* PROCEDURE -CalcFCS16 	43H, 0F1H, 10H, 00H,					(* LEA 0(A1, D1.W), D1 *) 	70H, 0FFH,									(* MOVEQ #-1, D0 *) 	4AH, 42H,									(* TST.W D2 *) 	67H, 14H,									(* BEQ.S end *) 	53H, 42H,									(* SUBQ.W #1, D2 *) 	12H, 19H,									(* MOVE.B (A1)+, D1 *) 	0B1H, 41H,								(* EOR.W D0, D1 *) 	0E0H, 48H,									(* LSR.W #8, D0 *) 	02H, 41H, 00H, 0FFH,				(* ANDI.W #$00FF, D1 *) 	32H, 30H, 12H, 00H,					(* MOVE.W 0(A0, D1.W*2), D1*) 	0B3H, 40H,									(* EOR.W D1, D0 *) 	60H, 0E8H;									(* BRA.S loop1 *) *) (*es*) (* PROCEDURE FCS (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER; CONST 	D0 = 0; D1 = 1; D2 = 2; A0 = 8; A1 = 9; VAR code: INTEGER;	 BEGIN 	SYSTEM.PUTREG(A0, SYSTEM.ADR(FCSTable)); SYSTEM.PUTREG(A1, SYSTEM.ADR(a)); 	SYSTEM.PUTREG(D1, pos); SYSTEM.PUTREG(D2, len); 	CalcFCS16; 	SYSTEM.GETREG(D0, code); 	RETURN code END FCS; *) (** CalcFCS - Calculates the FCS, should include Flag, Address etc., but no EscCodes, Space for FCS.. *) PROCEDURE CalcFCS* (VAR a: ARRAY OF CHAR; pos, len: INTEGER): INTEGER; BEGIN RETURN XOR(FCS(a, pos, len), -1) END CalcFCS; (* CheckFCS - Checks a complete packet, including Flag, Address AND FCS-Code! Returns TRUE if Packet is ok *) PROCEDURE CheckFCS* (VAR a: ARRAY OF CHAR; pos, len: INTEGER): BOOLEAN; BEGIN RETURN GoodFCS = FCS(a, pos, len) END CheckFCS; PROCEDURE GenerateFCSTab; CONST P = - 7BF8H;	(* 8408H *) VAR b, v, i:INTEGER; BEGIN FOR b := 0 TO 255 DO v := b; 		FOR i:= 0 TO 7 DO 			IF ODD(v) THEN v := XOR(SYSTEM.LSH(v, -1), P) ELSE v := SYSTEM.LSH(v, -1) END END; FCSTable[b] := v 	END END GenerateFCSTab; (*---*) PROCEDURE PutInt* (x: INTEGER; VAR p: ARRAY OF CHAR; pos: INTEGER); BEGIN p[pos + 0] := CHR(SYSTEM.LSH(x, -8) MOD 256); p[pos + 1] := CHR(x MOD 256) END PutInt; PROCEDURE GetInt* (VAR p: ARRAY OF CHAR; pos: INTEGER): INTEGER; BEGIN RETURN ORD(p[pos])*256 + ORD(p[pos + 1]) END GetInt; PROCEDURE PutLong *(x: LONGINT; VAR p: ARRAY OF CHAR; pos: INTEGER); BEGIN p[pos + 0] := CHR(SYSTEM.LSH(x, -24) MOD 256); p[pos + 1] := CHR(SYSTEM.LSH(x, -16) MOD 256); p[pos + 2] := CHR(SYSTEM.LSH(x, -8) MOD 256); p[pos + 3] := CHR(x MOD 256) END PutLong; PROCEDURE GetLong* (VAR p: ARRAY OF CHAR; pos: INTEGER): LONGINT; BEGIN RETURN ((LONG(ORD(p[pos]))*256 + LONG(ORD(p[pos + 1])))*256 		+ LONG(ORD(p[pos + 2])))*256 + LONG(ORD(p[pos + 3])) END GetLong; PROCEDURE GetSet* (VAR p: ARRAY OF CHAR; pos: INTEGER): SET; BEGIN RETURN SYSTEM.VAL(SET, GetLong(p, pos)) END GetSet; PROCEDURE PutSet* (x: SET; VAR p: ARRAY OF CHAR; pos: INTEGER); BEGIN PutLong(SYSTEM.VAL(LONGINT, x), p, pos) END PutSet; PROCEDURE GetIP* (VAR p: ARRAY OF CHAR; pos: INTEGER; 								   VAR x: (*es*)NetIP.Adr(*PT.IPAdr*)); VAR i: INTEGER; BEGIN FOR i := 0 TO (*es*)NetIP.AdrLen(*PT.IPAdrLen*) - 1 DO x[i] := p[pos + i] END END GetIP; PROCEDURE PutIP* (VAR x: (*es*)NetIP.Adr(*PT.IPAdr*); VAR p: ARRAY OF CHAR; pos: INTEGER); VAR i: INTEGER; BEGIN FOR i := 0 TO (*es*)NetIP.AdrLen(*PT.IPAdrLen*) - 1 DO 		p[pos + i] := SYSTEM.VAL(CHAR,x[i])(*x[i]*) END END PutIP; PROCEDURE EqualIP* (VAR p: ARRAY OF CHAR; pos: INTEGER; 									VAR x: (*es*)NetIP.Adr(*PT.IPAdr*)): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE (i # (*es*)NetIP.AdrLen(*PT.IPAdrLen*)) & ((*es*)SYSTEM.VAL(CHAR,x[i])(*x[i]*) = p[pos + i]) DO 		INC(i) END; RETURN i = (*es*)NetIP.AdrLen(*PT.IPAdrLen*) END EqualIP; PROCEDURE CopyString* (VAR a: ARRAY OF CHAR; posfrom, posto, len: INTEGER); VAR i: INTEGER; BEGIN IF posfrom > posto THEN		FOR i := 0 TO len - 1 DO a[posto + i] := a[posfrom + i] END ELSIF posfrom < posto THEN FOR i := len - 1 TO 0 BY - 1 DO a[posto + i] := a[posfrom + i] END END END CopyString; PROCEDURE Magic* : LONGINT; BEGIN RETURN 0; END Magic; PROCEDURE OutPacket* (VAR p: ARRAY OF CHAR; pos, len: INTEGER); VAR i: INTEGER; BEGIN FOR i := 0 TO len - 1 DO 		Debug.HexByte(p[pos + i]); IF i MOD  4 = 3 THEN Debug.String(" "); END; IF i MOD 16 = 15 THEN Debug.Ln END; END; (* 	FOR i := 0 TO len BY 4 DO 		Debug.Hex(SYSTEM.VAL(LONGINT, p[pos + i])); Debug.String(" "); 		IF i MOD 16 = 0 THEN Debug.Ln END 	END; 	*) IF i MOD 16 # 0 THEN Debug.Ln END (* Avoid redundant line break. *) (* Debug.Ln *) END OutPacket; PROCEDURE WriteSet*(s:SET; VAR a:ARRAY OF CHAR); VAR k,i:INTEGER; BEGIN k:=0; FOR i:=31 TO 0 BY -1 DO	IF (i IN s) THEN a[k]:="1"; ELSE a[k]:="0"; END; INC(k); END; a[k]:=0X; END WriteSet; BEGIN GenerateFCSTab END PPPTools.

title: Oberon/ETH Oberon/PPPTools.Mod


text:
History of video games/Platforms/miniStation

History
The miniStation was developed as a collaboration between Tencent and Skyworth Digital. Lenovo manufactured at least some units. Development occurred in the span of about a year.

Tencent launched the miniStation on December 23rd, 2015. In 2016 the system sold for either 499 or 699 Chinese yuan. The system was promoted by Rockchip at trade shows.

The miniStation won the iF design award in 2016 for it's minimalist cubic product design.

Compute
The system was powered by a Rockchip RK3288, containing a quad core ARM A17 CPU clocked at 1.8 gigahertz and a either a Mali T764 GPU or a Mali T720 GPU. The system had 2 gigabytes of DDR3 RAM. The system had either 8 or 16 gigabytes of onboard eMMC storage.

The system ran a modified version of Android 4.4 called TencentOS, and used a custom storefront.

Hardware
The system had an Ethernet jack, as well as an HDMI 2.0 port. The system also sported a USB 2.0 port.

For wireless communication the system had dual band radios for Wi-Fi AC, as well as for Bluetooth 4.1.

The system was enclosed in a cubic case with a square hole occupying the center. The casing was capable of generating lighting effects. A different model featuring a conventional flat box design was also produced.

The system drew 5 volts of power at 3 amps.

The system primarily used smartphones as touchscreen input devices through an app. An official controller was available.

The system had a model number of LenovoVXC10 and a CMIIT ID of 2015AP5115.

Games

 * Implosion
 * N.O.V.A. 3
 * Infinity Blade
 * Asphalt 8
 * Modern Combat 5

Case colors

 * Black
 * Purple
 * Cyan
 * Red
 * Tan (Render only)
 * Lime Green
 * White


text:
User talk:Ted52

Welcome!
Welcome to Wikibooks, Ted52!

 First steps tutorial Wikibooks is for collaborative development of free textbooks.

You do not need technical skills to contribute. You can easily change most books. Please introduce yourself, and let us know what interests you.

If you already contribute at other Wikimedia projects, our Wikimedia Orientation should quickly get you started. (Would you like to provide feedback on this message?)

  Getting help   Made a mistake?   Goodies, tips and tricks
 * Read the Using Wikibooks book for a friendly introduction to the project, or our help pages for more information.
 * You can get friendly help from the community in the user assistance room or our IRC channel.
 * Upload freely licensed files to Wikimedia Commons. You may request permission to upload fair use files locally. Please include author and source information and a non-free use rationale for non-free files.
 * You can restore a previously saved version.
 * Pages should follow the  naming convention.
 * Need to rename a page? Use the move tab (is available once your account is 4 days old - until then, ask for help).
 * To request a page be deleted, add to the top of the page.
 * Was a page you made deleted? Please read the deletion policy, and check the deletion log to find out why. Also check the RFD archives if applicable. You can request undeletion at WB:RFU, or ask the administrator who deleted the page.
 * Please fill in the edit summary and preview your edits before saving.
 * Sign your name on discussion pages by typing ~~~~
 * User scripts can make many tasks easier. Look at the Gadgets tab of my preferences; check off the boxes for the scripts you want, and hit save!

-- Jules (Mrjulesd) 12:02, 27 March 2021 (UTC)

title: User talk:Ted52


text:
User talk:Bilorv

Welcome!
Welcome to Wikibooks, Bilorv!

 First steps tutorial Wikibooks is for collaborative development of free textbooks.

You do not need technical skills to contribute. You can easily change most books. Please introduce yourself, and let us know what interests you.

If you already contribute at other Wikimedia projects, our Wikimedia Orientation should quickly get you started. (Would you like to provide feedback on this message?)

  Getting help   Made a mistake?   Goodies, tips and tricks
 * Read the Using Wikibooks book for a friendly introduction to the project, or our help pages for more information.
 * You can get friendly help from the community in the user assistance room or our IRC channel.
 * Upload freely licensed files to Wikimedia Commons. You may request permission to upload fair use files locally. Please include author and source information and a non-free use rationale for non-free files.
 * You can restore a previously saved version.
 * Pages should follow the  naming convention.
 * Need to rename a page? Use the move tab (is available once your account is 4 days old - until then, ask for help).
 * To request a page be deleted, add to the top of the page.
 * Was a page you made deleted? Please read the deletion policy, and check the deletion log to find out why. Also check the RFD archives if applicable. You can request undeletion at WB:RFU, or ask the administrator who deleted the page.
 * Please fill in the edit summary and preview your edits before saving.
 * Sign your name on discussion pages by typing ~~~~
 * User scripts can make many tasks easier. Look at the Gadgets tab of my preferences; check off the boxes for the scripts you want, and hit save!

-- Jules (Mrjulesd) 11:48, 27 March 2021 (UTC)

title: User talk:Bilorv


text:
User:RacoonyRE/huggle.yaml.js

--- enable: true version: "3.4.10 build: 3880 3.4.10" report-summary: "Reporting $1" confirm-multiple: false confirm-talk: true confirm-self-revert: true confirm-whitelist: true revert-on-multiple-edits: true automatically-resolve-conflicts: true software-rollback: false enforce-months-as-headers: true history-load: true on-next: 1 delete-edits-after-revert: true skip-to-last-edit: false preferred-provider: 2 remove-oldest-queue-edits: false truncate-edits: false talkpage-freshness: 20 remove-after-trusted-edit: true retrieve-founder: false display-title: false check-tp: true manual-warning: false summary-mode: false automatic-reports: false han-html: false han-display-user-talk: true han-display-bots: false han-display-user: true watchlist: "watch" automatically-group: false queue-id: "default" page-empty-queue: "" enable-max-score: false max-score: 0 enable-min-score: false min-score: 0 automatic-refresh: true automatically-watchlist-warned-users: false shortcut-hash: "" show-warning-if-not-on-last-revision: true number-dropdown-menu-items: true insert-edits-of-rolled-user-to-queue: true confirm-on-recent-warning: true recent-warning-time-span: 120 confirm-warning-on-very-old-edits: true skip-warning-on-confirm: true queues:
 * 1) // This is a configuration of huggle, do not change it unless you know what you are doing.
 * 1) // Last version of huggle that wrote into this configuration file (sanity check)
 * 1) // This option will change the behaviour of automatic resolution, be carefull
 * 1) // Get original creator of every page so that you can G7 instead of reverting the page
 * 1) // Periodically check if you received new messages and display a notification box if you get them
 * 1) // HAN
 * 1) // Whether edits made by same user should be grouped up together in page
 * 1) // Location of page (wiki page name, for example WP:Huggle) that should be displayed when you hit next and queue is empty. Leave empty for default page.
 * 1) // If true you will not warn users who received a warning recently
 * 1) // If warning was sent less than N seconds ago it's considered too recent
 * 1) // If true, the options above will not generate confirmation, but instead will be silently accepted (warning will not be sent)

title: User:RacoonyRE/huggle.yaml.js