Oberon/ETH Oberon/2.3.7/PPPMain.Mod
< Oberon | ETH Oberon
(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)
MODULE 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 <provider> <name>
$ 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*; (* [ <provider> <papname> ] *)
(* PAP password must be set as NetSystem.SetUser pap:<papname>[:<pappasswd>]@<provider> ~ *)
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