// 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
]