// DLSDialOutServer1.bcpl -- Telnet server providing dial-out capability

// Last modified August 22, 1982  12:33 PM by Taft
// Last modified January 17, 1985  11:30 AM by Diebert

get "DLSDriver.decl"
get "Pup.decl"
get "DLSControl.decl"

external
[
// Outgooing procedures
NetToDialOutLine; DialOutLineToNet; DialOutBSPError; DialOutCall

// Incoming procedures
HangUp; Echo; Confirm; Error; GetString; LeaveRemoteMode; DialOut; OpenPortForCtx
ControlOut; SetDLSLineSpeed; DLSOutput7; DLSResetInput; DLSResetOutput
DLSInputIdle; WaitForBitTimes; PrintLogLine
ExchangePorts; AppendStringToPup; CompletePup; ReleasePBI; PupError
OpenRTPSocket; CreateBSPStream; BSPGetMark; BSPPutMark; BSPForceOutput
InitializeContext; Block; Dismiss
Enqueue; Dequeue; Unqueue; SetTimer; TimerHasExpired; MultEq
Gets; Puts; Endofs; Errors; Wss; PutTemplate
MoveBlock; SetBlock; SysErr; ReturnFrom; MyFrame; DialOutTop
DLSInput; DLSInput7; DLSOutput; ControlIn
Login; DialOutDialIn; Free; StatusToLog; CallSwat
GenerateLongSpace; TelnetGets; InnerGets; TelnetEndofs; TelnetResets
TelnetPuts
TimeCallStart; TimeCallStop; Set7BitProcs

// Outgoing statics
strayPupQ

// Incoming statics
dlsName; dlsRegistry; dlsAuthorizationList;  
@lbTable; ctxTable; mainCtx; CtxRunning; postedNotice; crlf; ndbQ; sysZone
logstream; 
]


manifest
[
// Telnet mark types
markSync = 1
markLineWidth = 2
markPageLength = 3
markTerminalType = 4
markTiming = 5
markTimingReply = 6
]

structure AuxCtx:	// Auxiliary (DialOutLineToNet) context
[
blank word 3		// usual Ctx stuff
mainCtx word		// -> main context for line
active word		// true if recent activity in net -> line direction
]

// ---------------------------------------------------------------------------
let NetToDialOutLine(ctx, tstr) be
// ---------------------------------------------------------------------------
// This procedure is called within the line's main context.
// It copies characters from the Telnet connection to the DLS dial-out line.
// It returns if either the escape character is typed or the connection
// is broken.
[ // repeat
let char = Gets(tstr, true)  // remoteMode = true
ctx>>CTX.auxCtx>>AuxCtx.active = true
test ctx>>CTX.escapeDisabled
   ifso [
      test TimerHasExpired(lv ctx>>CTX.escapeCharTimer)
         ifso test ctx>>CTX.escapeTime le 0
            ifso [ ctx>>CTX.escapeDisabled = 0 ]
            ifnot [ ctx>>CTX.escapeTime = ctx>>CTX.escapeTime - 1;
               SetTimer(lv ctx>>CTX.escapeCharTimer, 100)  ]
            ifnot [ ]
         ]
      ifnot [ if char eq ctx>>CTX.escapeChar do return ]
test char eq 0
   ifnot Puts(ctx>>CTX.dlb, char)
   ifso GenerateLongSpace(ctx>>CTX.dlb, 20)  // "break" for 2 character times
] repeat

// ---------------------------------------------------------------------------
and DialOutLineToNet(ctx) be
// ---------------------------------------------------------------------------
// This is the auxCtx whose only purpose is to copy characters from the
// DLS dial-out line to the Telnet connection.
[
let mainCtx = ctx>>AuxCtx.mainCtx  // Get main context for line
let dlb = mainCtx>>CTX.dlb
let bspStr = lv mainCtx>>CTX.socket.bspStr

// This code accumulates characters and sends them only when the line goes
// idle, there is activity in the reverse direction (i.e., user typein),
// or one second elapses from the beginning of a burst, whichever
// occurs first.  This attempts to maximize the number of characters per Pup
// during sustained activity without introducing excessive echoing delays.
   [ // repeat
   let timer = nil
   ctx>>AuxCtx.active = false
   Puts(bspStr, Gets(dlb))  // wait here for first character of burst
   SetTimer(lv timer, 100)

      [ // repeat
      if Endofs(dlb) then
         [
         if ctx>>AuxCtx.active % TimerHasExpired(lv timer) then break
         WaitForBitTimes(dlb, 2)  // wait for next char to start if it's going to
         if DLSInputIdle(dlb) then break
         ]
      Puts(bspStr, Gets(dlb))
      ] repeat

   // sendNow if forcing due to timeout -- because the next ForceOut
   // is also likely to be invoked by a timeout, and one second is more
   // than the Pup package's timeout before requesting acknowledgment.
   BSPForceOutput(lv mainCtx>>CTX.socket, TimerHasExpired(lv timer))
   ] repeat
]

// ---------------------------------------------------------------------------
and DialOutBSPError(str, ec) = valof
// ---------------------------------------------------------------------------
// The BSP stream error procedure for the Telnet connection.
// Returns -1 for ecMarkEncountered; aborts everything for any other error.
[
if ec eq ecMarkEncountered resultis -1
let ctx = str - offset CTX.socket.bspStr/16
test CtxRunning eq ctx
   ifso
      [  // Running in the main context, just abort out
      DLSResetInput(ctx>>CTX.dlb)
      DLSResetOutput(ctx>>CTX.dlb)
      if ctx>>CTX.auxCtx ne 0 then
         [ Unqueue(mainCtx, ctx>>CTX.auxCtx); ctx>>CTX.auxCtx = 0 ]
      ReturnFrom(DialOutTop)
      ]
   ifnot
      [  // Running in the auxiliary context, force the main context to abort
      LeaveRemoteMode(ctx)
      ]
]
// ---------------------------------------------------------------------------
and DialOutCall(ctx, tstr) = valof
// ---------------------------------------------------------------------------
[
unless ctx>>CTX.dlb>>DLB.carrierOff do
   [
   Error(tstr, " ? Dial-out call already in progress.*n*l")
   resultis false
   ]
let phoneNumberString = vec 10
unless GetString(tstr, phoneNumberString, 20) resultis false
let phoneNumber = vec 15
let pni = 0
for i = 1 to phoneNumberString>>String.length do
   [
   let char = phoneNumberString>>String.char↑i
   if char eq $- % char eq $( % char eq $) % char eq $*s loop
   let digit = char-$0
   if char eq $** then digit = 10
   if char eq $# then digit = 11
   if digit ls 0 % digit gr (ctx>>CTX.dlb>>DLB.dclm>>DCLM.diallerType eq 1? 11, 9)
      % pni ge 15 then [ pni = 0; break ]
   pni = pni+1
   phoneNumber!pni = digit
   ]
if pni eq 0 then
   [
   Error(tstr, "? Number must be in form 123-4567 or (123) 456-7890*n*l")
   resultis false
   ]
phoneNumber!0 = pni
let retryCount = 0

   [ // repeat
   Wss(tstr, " Dialling.. ")
   BSPForceOutput(lv ctx>>CTX.socket)  // Since we won't do a Gets for a while
   let retry = false
   let ec = DialOut(ctx>>CTX.dlb, phoneNumber)
   switchon ec into
      [
      case 0:
      case ecDiallerNoAnswer:
         Wss(tstr, " Logging call.. ")
         BSPForceOutput(lv ctx>>CTX.socket)  // Since we won't do a Puts for a while
         if ec eq 0 do [ StatusToLog(ctx, phoneNumberString) ]
         if ec ne 0 then
            [ Wss(tstr, "*n*lFailed to establish data connection.*n*l")
            resultis false
            ]
         TimeCallStart(ctx)
         Wss(tstr, " Call completed.*n*l")
         resultis true

      case ecDiallerInUse:
         Wss(tstr, "Auto-dialler is busy, please wait...*n*l")
         Dismiss(500)  // 5 seconds
         unless ctx>>CTX.socket.state eq stateOpen & Endofs(tstr) do
            resultis false
         endcase

      default:
         Wss(tstr, "Dialler or phone system malfunction.   ")
         retry = true
         retryCount = retryCount + 1
         if retryCount gr 10 then [ Wss(tstr, crlf); resultis false ]
      ]
   if retry do
      [ Wss(tstr, "Redial? ")
      unless Confirm(tstr) then resultis false
      ]
   ] repeat
]