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