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