// DLSUtilb.bcpl -- Utility and program overflow procs for Alto DLS
// Last modified January 15, 1985 9:07 AM by Diebert
get "DLSDriver.decl"
get "Pup.decl"
get "DLSControl.decl"
get "AltoDefs.d"
get "Grapevine.decl"
get "DLSUtil.decl"
external
[
// outgoing procedures
GetString; Echo; Confirm; Error; Ws; Wss; Wns; Login; Set7BitProcs; DLSReturnFrom
HangUp; DLSCommandError; DLSTopAbort; CheckConnection; DLSCommand; LoginServer
StatusToLog; OtherPupProc; DialOutBSPError; TimeCallStart; TimeCallStop
GetNumber; Grapevine; OnListCheck
// Procedures defined in other packages
Dismiss; PutTemplate; PutNum; SendAbort; ControlOut; UpdateCarrierOn
MakeKey; Authenticate; GVDestroyStream; InitGrapevine; IsMemberClosure
DLSInput7; DLSOutputTI; DLSOutput7; Block; LeaveRemoteMode; ReleasePBI
DialOutTop; Unqueue; UDiv; BSPForceOutput; FindServer; MakeBSP
// Procedures defined in operating system
Gets; Puts; Endofs; Resets; Allocate; Free; AddToZone; Zero;
CallSwat; MyFrame; GotoFrame; ReturnFrom; Noop; DefaultArgs; ReadCalendar; DoubleAdd
// incoming statics
dlsName; dlsRegistry; dlsWizardList
@lbTable; ctxTable; mainCtx; CtxRunning; postedNotice; crlf; ndbQ
sysZone; loginServerCB; logstream
]
// ---------------------------------------------------------------------------
let GetString(stream, string, maxChars, endOnSpace, echoOff; numargs n) = valof
// ---------------------------------------------------------------------------
// Input and edit a string of length up to maxChars.
// Return true if terminated by return, false if by delete.
[
DefaultArgs(lv n, 3, false, false)
let i = 0
[
let char = Gets(stream)
if endOnSpace & (char eq $*S) then char = $*n
switchon char into
[
case $*n: case $*l:
string>>String.length = i
unless endOnSpace then Wss(stream, crlf)
resultis true
case 177B: // Delete
case 3: //Control-C because the fucking IBM PC does not have a Del key!!
Wss(stream, " XXX*n*l")
resultis false
case $A-100B: case $H-100B: // Control-A, backspace
test i gr 0
ifso
[
Puts(stream, $\)
test echoOff
ifso Puts(stream, $**)
ifnot Echo(stream, string>>String.char↑i)
i = i - 1
]
ifnot Puts(stream, $*007) // Ding
endcase
default:
test i ls maxChars
ifso
[
test echoOff
ifso Puts(stream, $**)
ifnot Echo(stream, char)
i = i + 1
string>>String.char↑i = char
]
ifnot Wss(stream, " [too long]")
]
] repeat
]
// ---------------------------------------------------------------------------
and Confirm(stream) = valof
// ---------------------------------------------------------------------------
// Wait for user to confirm command with carriage return or y Y
// Return true if so, false if cancelled with Delete
[
let char = Gets(stream)
switchon char into
[
case $Y: case $y:
case $*n: case $*l:
Wss(stream, " Yes*n*l")
resultis true
case $?:
Wss(stream, "? Confirm with carriage return, Y or y ")
endcase
default:
Wss(stream, " XXX*n*l")
resultis false
]
] repeat
// ---------------------------------------------------------------------------
and Echo(stream, char) be
// ---------------------------------------------------------------------------
// Print char on str in a manner suitable for echoing
[
if char ls 40B then
[ Puts(stream, $↑); char = char+100B ]
Puts(stream, char)
]
// ---------------------------------------------------------------------------
and Error(stream, string, char; numargs na) be
// ---------------------------------------------------------------------------
// Output string to terminal dlb, then clear input buffer.
// If char is supplied, it is printed before the string
// (this is useful for echoing the character that caused the error)
[
if na ge 3 then Echo(stream, char)
Wss(stream, string)
Dismiss(40) // Pause for 400 ms
Resets(stream)
]
// ---------------------------------------------------------------------------
and Wss(s, str) be
// ---------------------------------------------------------------------------
for i = 1 to str>>String.length do Puts(s, str>>String.char↑i)
//// ---------------------------------------------------------------------------
//and Ws(str) be Wss(keyDsp, str)
//// ---------------------------------------------------------------------------
// ---------------------------------------------------------------------------
and Wns(s, num, wid, rdx; numargs na) be
// ---------------------------------------------------------------------------
[
DefaultArgs(lv na, -2, 1, -10)
// Use unadvertised procedure in Template package.
// *** Beware: the following 5 variables must be declared in this order.
let radix = (rdx gr 0? rdx, -rdx)
let width = wid
let signed = rdx ls 0
let double = false
let fill = $*s
PutNum(s, num, lv radix)
]
// ---------------------------------------------------------------------------
and Grapevine(ctx) = valof
// ---------------------------------------------------------------------------
[
if ctx>>CTX.socketOpen then
[ Error(ctx>>CTX.dlb, " Connection already open*n*l"); resultis false ]
until loginServerCB>>LSCB.ctx eq 0 do Block()
loginServerCB>>LSCB.Function = ltFindGrapevine
loginServerCB>>LSCB.ec = 0
loginServerCB>>LSCB.ctx = ctx
until loginServerCB>>LSCB.ctx eq 0 do Dismiss(1)
if loginServerCB>>LSCB.ec ne 0 do
[ Wss(ctx>>CTX.dlb, "*n*lAll servers are down, try latter.*n*l"); resultis false ]
resultis true
]
// ---------------------------------------------------------------------------
and OnListCheck(ctx, tstr, list) = valof
// ---------------------------------------------------------------------------
[
let lclName = ctx>>CTX.name
if lclName eq 0 then resultis false
Wss(tstr, "Checking to see if you are on list ... ")
BSPForceOutput(lv ctx>>CTX.socket) // this may take a while let the user know
until loginServerCB>>LSCB.ctx eq 0 do Block()
loginServerCB>>LSCB.Function = ltCheckOnList
loginServerCB>>LSCB.Name = lclName
loginServerCB>>LSCB.ec = 0
loginServerCB>>LSCB.List = list
loginServerCB>>LSCB.ctx = ctx
until loginServerCB>>LSCB.ctx eq 0 do Dismiss(1)
PutTemplate(tstr, "$S*n*l", selecton loginServerCB>>LSCB.ec into
[
case ecIndividual:
case ecIsMember: "ok"
case ecBadRName: "Invalid name"
case ecBadPassword: "Invalid password"
case ecAllDown: "All R-Servers are down"
case ecIsNotMember: "*n*lSorry you are not on list"
default: "Unknown response from Grapevine"
])
if loginServerCB>>LSCB.ec eq ecIsMember do resultis true
resultis false
]
// ---------------------------------------------------------------------------
and Login(ctx, tstr, list, message) = valof
// ---------------------------------------------------------------------------
[
let char = nil
let findOgin = true
let lcogin = "ogin"
let fubar = ctx>>CTX.name
if fubar ne 0 do
[
Free(sysZone, fubar); ctx>>CTX.name = 0
findOgin = false
]
fubar = ctx>>CTX.password
if fubar ne 0 do
[
Free(sysZone, fubar); ctx>>CTX.password = 0
findOgin = false
]
let lclName = vec maxRNameLength/2 + 1
let password = vec maxRNameLength/2 + 1
PutTemplate(tstr, "*n*lYour name please (include registry if not $S): ",
dlsRegistry)
unless GetString(tstr, lclName, maxRNameLength, true, false) do resultis false
let oginFound = false
if findOgin then
if lclName>>String.length eq 4 then
[
oginFound = true
for i = 1 to 4 then
if lclName>>String.char↑i ne lcogin>>String.char↑i then oginFound = false
]
if oginFound do
[
Wss(tstr, "← ")
unless GetString(tstr, lclName, maxRNameLength, true, false) do
resultis false
]
let periodSeen = false
for i = 1 to lclName>>String.length do
if lclName>>String.char↑i eq $. then periodSeen = true
unless periodSeen do
[
let last = lclName>>String.length
if (last + dlsRegistry>>String.length) gr maxRNameLength do
[ Wss(tstr, "User name too long.*n*l"); resultis false ]
lclName>>String.char↑(last + 1) = $.; Puts(tstr, $.)
for i = 1 to dlsRegistry>>String.length do
[
lclName>>String.char↑(last + 1 + i) = dlsRegistry>>String.char↑i
Puts(tstr, dlsRegistry>>String.char↑i)
]
lclName>>String.length = last + 1 + dlsRegistry>>String.length
]
Wss(tstr, "*n*lYour password: ")
unless GetString(tstr, password, maxRNameLength, true, true) do
resultis false
if oginFound do
until char eq $*n do char = Gets(tstr)
Wss(tstr, " ... Grapevine ")
BSPForceOutput(lv ctx>>CTX.socket) // this may take a while let the user know
until loginServerCB>>LSCB.ctx eq 0 do Block()
loginServerCB>>LSCB.Function = ltNameAuthenticate
loginServerCB>>LSCB.Name = lclName
loginServerCB>>LSCB.Password = password
loginServerCB>>LSCB.List = list
loginServerCB>>LSCB.ec = 0
loginServerCB>>LSCB.ctx = ctx
Wss(tstr, "... ")
BSPForceOutput(lv ctx>>CTX.socket) // this may take a while let the user know
until loginServerCB>>LSCB.ctx eq 0 do Dismiss(1)
oginFound = selecton loginServerCB>>LSCB.ec into
[
case ecIndividual:
case ecIsMember: "ok"
case ecBadRName: "Invalid name"
case ecBadPassword: "Invalid password"
case ecAllDown: "All R-Servers are down"
case ecIsNotMember: "*n*lSorry you are not on the access list"
default: "Unknown response from Grapevine"
]
if (loginServerCB>>LSCB.ec eq ecIndividual) % (loginServerCB>>LSCB.ec eq ecIsMember) do
[
let name = Allocate(sysZone, lclName>>String.length/2 + 1)
for i = 1 to lclName>>String.length do
name>>String.char↑i = lclName>>String.char↑i
name>>String.length = lclName>>String.length
ctx>>CTX.name = name
name = Allocate(sysZone, password>>String.length/2 + 1)
for i = 1 to password>>String.length do
name>>String.char↑i = password>>String.char↑i
name>>String.length = password>>String.length
ctx>>CTX.password = name
StatusToLog(ctx, message)
PutTemplate(tstr, "$S*n*l", oginFound)
resultis true
]
PutTemplate(tstr, "$S*n*l", oginFound)
resultis false
]
// ---------------------------------------------------------------------------
and LoginServer() be
// ---------------------------------------------------------------------------
[
until loginServerCB>>LSCB.ctx ne 0 do Block()
let lclName = loginServerCB>>LSCB.Name
switchon (loginServerCB>>LSCB.Function) into
[
case ltNameAuthenticate:
[ let key = vec lenPassword
MakeKey(loginServerCB>>LSCB.Password, key)
let ec = Authenticate(lclName, key)
if ec eq ecIndividual do
if loginServerCB>>LSCB.List ne 0 do
ec = IsMemberClosure(loginServerCB>>LSCB.List, lclName)
loginServerCB>>LSCB.ec = ec
endcase ]
case ltFindGrapevine:
[ loginServerCB>>LSCB.ec = FindServer("Lily↑.ms", 53B, MakeBSP, loginServerCB>>LSCB.ctx)
endcase ]
case ltCheckOnList:
[ loginServerCB>>LSCB.ec = IsMemberClosure(loginServerCB>>LSCB.List, lclName)
endcase ]
]
loginServerCB>>LSCB.ctx = 0
] repeat
// ---------------------------------------------------------------------------
and Set7BitProcs(dlb) be
// ---------------------------------------------------------------------------
[
dlb>>DLB.gets = DLSInput7
dlb>>DLB.puts = (dlb>>DLB.baud eq 300 & dlb>>DLB.noPad eq 0) ? DLSOutputTI, DLSOutput7
]
// ---------------------------------------------------------------------------
and HangUp(dlb, raiseDTR) be
// ---------------------------------------------------------------------------
// If this is a dial-up or Telenet line, drop Data Terminal Ready to hang
// up the connection, then raise it again if raiseDTR is true.
if dlb>>DLB.lineType ne ltHardwired then
[
let controlLine = dlb>>DLB.otherLine
ControlOut(controlLine, false)
Dismiss(50) // Keep DTR low for at least 500 ms
if raiseDTR then ControlOut(controlLine, true)
UpdateCarrierOn(Noop) // Ensure carrierOff flag is up to date
]
// ---------------------------------------------------------------------------
and StatusToLog(ctx, reason) be
// ---------------------------------------------------------------------------
[
until logstream>>DLB.logBusy eq 0 do Dismiss(10)
logstream>>DLB.logBusy = ctx
PutTemplate(logstream, "Line #$O $D baud $S $S*n*l", ctx>>CTX.dlb>>DLB.line, ctx>>CTX.dlb>>DLB.baud, ctx>>CTX.name, reason)
logstream>>DLB.logBusy = 0
]
// ---------------------------------------------------------------------------
and TimeCallStart(ctx) be
// ---------------------------------------------------------------------------
[
let time = vec 2
time = ReadCalendar(time)
ctx>>CTX.startTime = time!1
ctx>>CTX.callInProgress = 1
]
// ---------------------------------------------------------------------------
and TimeCallStop(ctx) = valof
// ---------------------------------------------------------------------------
[
if ctx>>CTX.callInProgress eq 0 then resultis 0
let Now = vec 2
Now = ReadCalendar(Now)
let Then = vec 2
Then!0 = 0
Then!1 = ctx>>CTX.startTime
Then!1 = Now!1 - Then!1
let dur = UDiv(Then, 60, Then) + 1
until logstream>>DLB.logBusy eq 0 do Dismiss(10)
PutTemplate(logstream, "Line #$O $S duration = $UD min.*n*l", ctx>>CTX.dlb>>DLB.line,
ctx>>CTX.name, dur)
logstream>>DLB.logBusy = 0
ctx>>CTX.callInProgress = 0
resultis dur
]
// ---------------------------------------------------------------------------
and GetNumber(tstr) = valof
// ---------------------------------------------------------------------------
// Returns -1 if aborted by delete, -2 if illegal number
[
let string = vec 10
unless GetString(tstr, string, 20) resultis -1
let num = -2
for i = 1 to string>>String.length do
[
let digit = string>>String.char↑i - $0
if digit ls 0 % digit gr 9 resultis -2
if num eq -2 then num = 0
num = 10*num + digit
]
resultis num
]