Oberon/ETH Oberon/2.3.7/Dialer.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 Dialer; (** non-portable *) (* 26.08.96 mg *)
IMPORT
Oberon, NetSystem, Strings, Texts, Input, V24, NetBase, Modules, TextFrames;
CONST
RI = 5; DCD = 6; (* input *)
Service = "dialup";
GrabPort = TRUE; (* take over com port by force, if already in use *)
VAR
W: Texts.Writer;
script: Oberon.Task;
host: ARRAY 64 OF CHAR;
waitStr: ARRAY 32 OF CHAR;
waitPos: INTEGER;
waitTime: LONGINT;
err, open: BOOLEAN;
S: Texts.Scanner;
port: INTEGER;
dev: NetBase.Device;
PROCEDURE Delay (i: LONGINT);
VAR t: LONGINT;
BEGIN
t := Input.Time();
WHILE Input.Time() - t < i DO END
END Delay;
PROCEDURE Hang(port: INTEGER);
BEGIN
V24.ClearMC(port, {V24.DTR});
Delay(Input.TimeUnit DIV 6);
V24.SetMC(port, {V24.DTR})
END Hang;
PROCEDURE InitComPort (port: INTEGER; baud: LONGINT);
VAR ok: BOOLEAN; res: LONGINT;
BEGIN
ok := TRUE;
V24.Start(port, baud, 8, V24.ParNo, 1, res);
IF GrabPort & (res = 1) THEN
V24.Stop(port); V24.Start(port, baud, 8, V24.ParNo, 1, res)
END;
ok := FALSE;
IF res = 0 THEN ok := TRUE
ELSIF res = 3 THEN
Texts.WriteString(W,"Dialer: Baudrate not supported"); Texts.WriteLn(W)
ELSIF res = 1 THEN
Texts.WriteString(W,"Dialer: Port already in use"); Texts.WriteLn(W)
ELSE
Texts.WriteString(W,"Dialer: Init error "); Texts.WriteInt(W, res, 1); Texts.WriteLn(W)
END;
Texts.Append(Oberon.Log, W.buf);
IF ~ok THEN err := TRUE END
END InitComPort;
PROCEDURE SendStr(str: ARRAY OF CHAR);
VAR ch: CHAR; i: INTEGER; res: LONGINT;
BEGIN
i := 0;
WHILE str[i] # 0X DO ch := str[i];
IF ch = "~" THEN Delay(300)
ELSE V24.Send(port, ch, res)
END;
INC(i)
END;
V24.Send(port, 0DX, res)
END SendStr;
PROCEDURE WaitStr(str: ARRAY OF CHAR; timeOut: LONGINT);
BEGIN
COPY(str, waitStr);
waitPos := 0; waitTime := Input.Time() + timeOut
END WaitStr;
PROCEDURE StartLine;
BEGIN
IF open THEN Texts.Write(W, "}"); open := FALSE END;
Texts.WriteLn(W)
END StartLine;
PROCEDURE SendUser(use: BOOLEAN; VAR err: BOOLEAN);
VAR user, passwd: ARRAY 64 OF CHAR;
BEGIN
user := "";
NetSystem.GetPassword(Service, host, user, passwd);
IF (user # "") & (passwd # "") THEN
StartLine; Texts.WriteString(W, "Sending ");
IF use THEN Texts.WriteString(W, "USER ["); Texts.WriteString(W, user); SendStr(user)
ELSE Texts.WriteString(W, "PASSWORD [not printed"); SendStr(passwd)
END;
Texts.WriteString(W, "]"); Texts.Append(Oberon.Log, W.buf);
Texts.Scan(S)
ELSE
StartLine; Texts.WriteString(W, "NetSystem.SetUser ");
Texts.WriteString(W, Service); Texts.WriteString(W, ":<user>@<server> ~ required");
err := TRUE
END
END SendUser;
PROCEDURE Call(cmd: ARRAY OF CHAR);
VAR F: TextFrames.Frame; par: Oberon.ParList; T: Texts.Text;
BEGIN
IF Oberon.Par = NIL THEN par := NIL
ELSE NEW(par); par^ := Oberon.Par^
END;
NEW(T); Texts.Open(T, "");
Texts.WriteString(W, cmd); Texts.WriteLn(W);
Texts.Append(T, W.buf);
F := TextFrames.NewText(T, 0); TextFrames.Call(F, 0, FALSE);
IF (par # NIL) & (Oberon.Par # NIL) THEN Oberon.Par^ := par^ END
END Call;
PROCEDURE DoScript(me: Oberon.Task);
VAR timo, res: LONGINT; any: BOOLEAN; ch: CHAR;
BEGIN
err := FALSE;
IF waitPos >= 0 THEN (* wait for response *)
any := FALSE;
WHILE (waitPos >= 0) & (V24.Available(port) > 0) DO
any := TRUE; V24.Receive(port, ch, res);
IF ch = 0AX THEN (* skip *)
ELSIF ch = 0DX THEN Texts.Write(W, "|")
ELSIF (ch >= 20X) & (ch <= 7EX) THEN Texts.Write(W, ch)
ELSE Texts.Write(W, CHR(147))
END;
IF waitPos >= 0 THEN
IF CAP(ch) = CAP(waitStr[waitPos]) THEN
INC(waitPos);
IF waitStr[waitPos] = 0X THEN waitPos := -1 END (* matched! *)
ELSE
waitPos := 0 (* restart *)
END
END
END;
IF any THEN Texts.Append(Oberon.Log, W.buf) END;
IF (waitPos >= 0) & (Input.Time() - waitTime > 0) THEN
StartLine; Texts.WriteString(W, "Dialer: Timed out");
err := TRUE
END
ELSE (* execute next script statement *)
IF S.class = Texts.Name THEN
IF S.s = "USER" THEN SendUser(TRUE, err)
ELSIF S.s = "PASSWORD" THEN SendUser(FALSE, err)
ELSIF S.s = "START" THEN
StartLine; Texts.WriteString(W, "Enabling device"); Texts.Append(Oberon.Log, W.buf);
IF (dev # NIL) & (dev.state = NetBase.pending) THEN dev.state := NetBase.open END;
dev := NIL; Texts.Scan(S)
ELSIF S.s = "CALL" THEN
Texts.Scan(S);
IF (S.class = Texts.String) OR (S.class = Texts.Name) THEN
StartLine; Texts.WriteString(W, "Calling ["); Texts.WriteString(W, S.s);
Texts.WriteString(W, "]"); Texts.Append(Oberon.Log, W.buf);
Call(S.s); Texts.Scan(S)
ELSE
StartLine; Texts.WriteString(W, "Dialer: Command expected after CALL");
err := TRUE
END
ELSE
StartLine; Texts.WriteString(W, "Dialer: Unknown keyword ["); Texts.WriteString(W, S.s);
Texts.Write(W, "]");
err := TRUE
END
ELSIF S.class = Texts.String THEN
StartLine; Texts.WriteString(W, "Sending ["); Texts.WriteString(W, S.s);
Texts.WriteString(W, "]"); Texts.Append(Oberon.Log, W.buf);
SendStr(S.s); Texts.Scan(S)
ELSIF S.class = Texts.Int THEN
timo := S.i * Input.TimeUnit; Texts.Scan(S);
IF S.class = Texts.String THEN
StartLine; Texts.WriteString(W, "Waiting "); Texts.WriteInt(W, timo DIV Input.TimeUnit, 1);
Texts.WriteString(W, "s for ["); Texts.WriteString(W, S.s); Texts.WriteString(W, "] {");
open := TRUE; Texts.Append(Oberon.Log, W.buf);
WaitStr(S.s, timo); Texts.Scan(S)
ELSE
StartLine; Texts.WriteString(W, "Dialer: Wait string expected after integer");
err := TRUE
END
ELSIF S.class = Texts.Char THEN
IF S.c = "}" THEN
StartLine; Texts.WriteString(W, "End of script");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Oberon.Remove(script); script := NIL; dev := NIL
ELSE
StartLine; Texts.WriteString(W, "Dialer: Unexpected character in script");
err := TRUE
END
ELSE HALT(99)
END
END;
IF err THEN
Oberon.Remove(script); script := NIL; dev := NIL;
Hang(port);
Texts.WriteLn(W); Texts.WriteString(W, "Dialer: Script aborted");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END DoScript;
PROCEDURE GetDevice(device: ARRAY OF CHAR; VAR devnum: LONGINT);
BEGIN
Strings.Lower(device, device);
IF device = "default" THEN devnum := 0
ELSIF Strings.Prefix("device", device) & (device[6] >= "0") & (device[6] <= "9") & (device[7] = 0X) THEN
devnum := ORD(device[6])-ORD("0")
ELSE devnum := -1
END
END GetDevice;
PROCEDURE Dial*; (** config device {config.Host is used to find password, config.Init for port, config.Dial for script} *)
VAR S0: Texts.Scanner; prefix, path: ARRAY 64 OF CHAR; err: BOOLEAN; devnum: LONGINT;
BEGIN err := FALSE;
Texts.OpenScanner(S0, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S0);
IF S0.class = Texts.Name THEN
COPY(S0.s, prefix); COPY(prefix, host);
Texts.Scan(S0);
IF S0.class = Texts.Name THEN
GetDevice(S0.s, devnum);
dev := NetBase.FindDevice(devnum);
IF dev # NIL THEN
IF dev.state = NetBase.open THEN
dev.state := NetBase.pending;
Texts.WriteString(W, "Warning: "); Texts.WriteString(W, S0.s);
Texts.WriteString(W, " device is already open"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
COPY(prefix, path); Strings.Append(path, ".Init");
Oberon.OpenScanner(S, path);
IF S.class = Texts.Name THEN
IF S.s = "COM1" THEN port := V24.COM1
ELSIF S.s = "COM2" THEN port := V24.COM2
ELSIF S.s = "COM3" THEN port := V24.COM3
ELSIF S.s = "COM4" THEN port := V24.COM4
ELSE HALT(99)
END;
Texts.Scan(S);
IF S.class = Texts.Int THEN InitComPort(port, S.i);
COPY(prefix, path); Strings.Append(path, ".Dial");
Oberon.OpenScanner(S, path);
IF script # NIL THEN Oberon.Remove(script)
ELSE NEW(script)
END;
waitPos := -1; script.safe := FALSE;
script.time := 0; script.handle := DoScript;
Texts.WriteString(W, "Dial script started"); open := FALSE;
Texts.Append(Oberon.Log, W.buf);
Oberon.Install(script)
ELSE Texts.WriteString(W, "Init syntax error"); err := TRUE
END
ELSE Texts.WriteString(W, "Init syntax error"); err := TRUE
END
ELSE Texts.WriteString(W, S0.s); Texts.WriteString(W, " device not found"); err := TRUE
END
ELSE Texts.WriteString(W, "Dial syntax error"); err := TRUE
END
ELSE Texts.WriteString(W, "Dial syntax error"); err := TRUE
END;
IF err THEN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END
END Dial;
PROCEDURE GetPort(VAR port: INTEGER; VAR devnum: LONGINT);
VAR S, R: Texts.Scanner; i: LONGINT;
BEGIN
devnum := -1;
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
Texts.Scan(S);
IF S.class = Texts.Name THEN
Strings.Append(S.s, ".Init");
Oberon.OpenScanner(R, S.s);
IF R.s = "COM1" THEN port := V24.COM1
ELSIF R.s = "COM2" THEN port := V24.COM2
ELSIF R.s = "COM3" THEN port := V24.COM3
ELSIF R.s = "COM4" THEN port := V24.COM4
ELSE HALT(99)
END;
Texts.Scan(S);
IF S.class = Texts.Name THEN GetDevice(S.s, devnum) END
ELSE HALT(99)
END
END GetPort;
PROCEDURE Hangup*;
VAR port: INTEGER; devnum: LONGINT;
BEGIN
GetPort(port, devnum);
IF script # NIL THEN
Texts.WriteLn(W); Texts.WriteString(W, "Script aborted");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Oberon.Remove(script); script := NIL; dev := NIL
END;
Hang(port)
END Hangup;
PROCEDURE State*;
VAR port: INTEGER; devnum: LONGINT; s: SET;
BEGIN
GetPort(port, devnum);
V24.GetMC(port, s);
IF DCD IN s THEN (* carrier detected *)
Texts.WriteString(W, "Modem on-line")
ELSE
Texts.WriteString(W, "Modem off-line")
END;
IF devnum # -1 THEN
dev := NetBase.FindDevice(devnum);
Texts.WriteString(W, ", device "); Texts.WriteInt(W, devnum, 1);
IF dev = NIL THEN
Texts.WriteString(W, " not installed")
ELSE
IF dev.state = NetBase.closed THEN
Texts.WriteString(W, " closed")
ELSIF dev.state = NetBase.open THEN
Texts.WriteString(W, " open")
ELSIF dev.state = NetBase.pending THEN
Texts.WriteString(W, " link pending")
ELSE
Texts.WriteString(W, " in state"); Texts.WriteInt(W, dev.state, 1)
END
END
END;
Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END State;
PROCEDURE Cleanup;
BEGIN
IF script # NIL THEN Oberon.Remove(script); script := NIL END
END Cleanup;
BEGIN
Texts.OpenWriter(W);
script := NIL; dev := NIL; port := 1;
Modules.InstallTermHandler(Cleanup)
END Dialer.
System.Free Dialer ~
NetSystem.SetUser dialup:pmullerppp@ETHPPP ~
Dialer.Dial ETHPPP default
Dialer.State ETHPPP default
Dialer.Hangup ETHPPP