// DLSDialOutServer.bcpl -- Telnet server providing dial-out capability // Last modified August 22, 1982 12:33 PM by Taft // Last modified January 15, 1985 11:22 AM by Diebert get "DLSDriver.decl" get "Pup.decl" get "DLSControl.decl" external [ // Outgoing procedures DLSSocketNotFound; TelnetRendezvousServer; DialOutTop; SendAbort; GetNumber OtherPupProc; // Incoming procedures NetToDialOutLine; DialOutLineToNet; WizardMode; OnListCheck; DialOutCall HangUp; Echo; Confirm; Error; GetString; LeaveRemoteMode; DialOut; OpenPortForCtx ControlOut; SetDLSLineSpeed; DLSOutput7; DLSResetInput; DLSResetOutput DLSInputIdle; WaitForBitTimes; 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; DialOutBSPError 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; dlsOutList; dlsWizardList @lbTable; ctxTable; mainCtx; CtxRunning; postedNotice; crlf; ndbQ; sysZone logstream; ] static [ strayPupQ ] 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 DLSSocketNotFound(pbi) be Enqueue(strayPupQ, pbi) // --------------------------------------------------------------------------- // Called from Pup level 1 with packet for unknown local socket. // --------------------------------------------------------------------------- and TelnetRendezvousServer() be // --------------------------------------------------------------------------- // Context that catches stray Pups (ones not for any existing socket) // and creates a Telnet server when an RFC arrives. // The following "rendezvous sockets" are defined: // 1 Hunt for any 300-baud dial-out line // 212 Hunt for any Bell 212 dial-out line // 300 Hunt for any Bell 103 dial-out line // 1200 Hunt for any Vadic 3400 dial-out line // 100000+n Connect to line n, if it exists and is a DLS data line [ Dismiss(1) while strayPupQ!0 ne 0 do HandleRSPup(Dequeue(strayPupQ)) ] repeat // --------------------------------------------------------------------------- and HandleRSPup(pbi) be // --------------------------------------------------------------------------- [ let modemWanted, line = -1, nil // Check for Whereuser if pbi>>PBI.pup.type eq typeWhereUserRequest & pbi>>PBI.pup.dPort.host ne 0 do [ ExchangePorts(pbi) CompletePup(pbi, typeWhereUserReply, pupOvBytes) return ] // Require it to be an RFC and not broadcast. if pbi>>PBI.pup.type eq typeRFC & pbi>>PBI.pup.dPort.host ne 0 & pbi>>PBI.pup.dPort.socket^1 eq 0 then switchon pbi>>PBI.pup.dPort.socket^2 into [ case 1: case 300b: modemWanted = ltBell103; endcase case 212b: modemWanted = ltBell212; endcase case 1200b: modemWanted = ltVadic3400; endcase default: line = pbi>>PBI.pup.dPort.socket^2 - 100000b if line uls numLines & (lbTable!line)>>LBH.lineType ge ltData then modemWanted = ltIllegal ] if modemWanted eq -1 then [ PupError(pbi, 2, "No such port"); return ] // Default net field of foreign connection port let connPort = lv pbi>>PBI.pup.words if connPort>>Port.net eq 0 then connPort>>Port.net = pbi>>PBI.pup.sPort.net let ctx = 0 test modemWanted eq ltIllegal ifso [ // Asking for specific line if TestDuplicate(pbi, line) then return // Duplicate RFC ctx = ctxTable!line unless ctx>>CTX.lineState le lineStateOn do [ SendAbort(pbi, "Line is busy"); return ] ] ifnot [ // Asking for any line of specific type // Check for duplicate RFC by searching for a connection with the same // foreign port and connection ID. Also search for a dial-out line that // is not presently in use and that has the correct type of modem. for testLine = 0 to numLines-1 do [ if TestDuplicate(pbi, testLine) then return // Duplicate RFC let dlb = lbTable!testLine if dlb>>DLB.lineType eq ltDataSet & dlb>>DLB.dclm ne 0 & (ctxTable!testLine)>>CTX.lineState eq lineStateOff do [ if modemWanted eq dlb>>DLB.modemType do [ line = testLine; ctx = ctxTable!line ] // free correct type ] ] // Reject the request if did not find a free dial-out line if ctx eq 0 then [ SendAbort(pbi, "No dial-out lines available"); return ] ] // HandleRSPup (cont'd) // Open the BSP connection let soc = OpenPortForCtx(ctx, connPort) OpenRTPSocket(soc, 0, modeImmediateOpen, lv pbi>>PBI.pup.id) CreateBSPStream(soc) ctx>>CTX.socketOpen = true // Tell the context to be a dial-out server ctx>>CTX.lineState = lineStateDialOut if modemWanted ne ltIllegal then SetDLSLineSpeed(ctx>>CTX.dlb, selecton modemWanted into [ case ltBell103: 300 case ltBell212: case ltVadic3400: 1200 ]) // Send answering RFC SendRFC(pbi, lv ctx>>CTX.socket) ] // --------------------------------------------------------------------------- and TestDuplicate(pbi, line) = valof // --------------------------------------------------------------------------- [ let ctx = ctxTable!line let dlb = lbTable!line if dlb>>LBH.lineType ge ltData & ctx>>CTX.socketOpen & MultEq(lv ctx>>CTX.socket.frnPort, lv pbi>>PBI.pup.words, lenPort) & MultEq(lv ctx>>CTX.socket.connID, lv pbi>>PBI.pup.id) then [ SendRFC(pbi, lv ctx>>CTX.socket); resultis true ] // Duplicate RFC resultis false ] // --------------------------------------------------------------------------- and SendRFC(pbi, soc) be // --------------------------------------------------------------------------- [ MoveBlock(lv pbi>>PBI.pup.words, lv soc>>PupSoc.lclPort, lenPort) ExchangePorts(pbi) CompletePup(pbi, typeRFC, pupOvBytes+6) ] // --------------------------------------------------------------------------- and SendAbort(pbi, string) be // --------------------------------------------------------------------------- [ pbi>>PBI.pup.words^1 = 0 AppendStringToPup(pbi, 3, string) ExchangePorts(pbi) CompletePup(pbi, typeAbort) ] // --------------------------------------------------------------------------- and DialOutTop(ctx) be // --------------------------------------------------------------------------- // DLSTop calls this procedure when the line is being // controlled from a server Telnet connection. [ // Manufacture server Telnet stream let tstr = vec lST SetBlock(tstr, SysErr, lST) tstr>>ST.par1 = ctx // -> owning context tstr>>ST.gets = TelnetGets tstr>>ST.endof = TelnetEndofs tstr>>ST.reset = TelnetResets tstr>>ST.puts = TelnetPuts ctx>>CTX.socket.error = DialOutBSPError let dlb = ctx>>CTX.dlb if dlb>>DLB.carrierOff then [ // Drop Data Terminal Ready so the modem won't auto-answer ControlOut(dlb>>DLB.otherLine, false) dlb>>DLB.puts = DLSOutput7 // No padding! ] DLSResetInput(dlb) DLSResetOutput(dlb) // Give greeting PutTemplate(tstr, "$S*n*l$S Line #$O, ($D Baud), Escape character = ", dlsName, valof [ switchon dlb>>DLB.lineType into [ case ltHardwired: resultis "Hardwired" case ltTelenet: resultis "Telenet" case ltDataSet: resultis selecton dlb>>DLB.modemType into [ case ltBell103: "Bell 103 Dial Out" case ltBell212: "Bell 212a Dial Out" case ltVadic3400: "Vadic 3400 Dial Out" default: "?" ] default: resultis "?" ] ], dlb>>DLB.line, dlb>>DLB.baud) Echo(tstr, ctx>>CTX.escapeChar) Wss(tstr, crlf) if postedNotice ne 0 then PutTemplate(tstr, "*007****** $S*n*l", postedNotice) // Call server Telnet command interpreter DialOutCommand(ctx, tstr) // Return to DLSTop, which will close connection and hang up modem. // If the Telnet connection breaks, ReturnFrom(DialOutTop) is done. ] // --------------------------------------------------------------------------- and DialOutCommand(ctx, tstr) be // --------------------------------------------------------------------------- [ let dlb = ctx>>CTX.dlb Puts(tstr, $>) // Prompt let char = Gets(tstr) switchon char into [ case $8: Wss(tstr, "Set line to 8 bit no parity ") if Confirm(tstr) then [ dlb>>DLB.eightBit = 1; dlb>>DLB.flowControl = false ] endcase case $7: Wss(tstr, "Set line to 7 bit even parity ") if Confirm(tstr) then [ dlb>>DLB.eightBit = 0; dlb>>DLB.flowControl = true ] endcase case $B: case $b: [ Wss(tstr, "Baud rate = ") if dlb>>DLB.baud eq 1200 & dlb>>DLB.dclm ne 0 then [ Error(tstr, "1200, cannot be changed*n*l"); endcase ] let baud = GetNumber(tstr) if baud ge 0 do test baud ge 110 & baud le 2400 & (dlb>>DLB.dclm eq 0 % baud le 300) ifso [ SetDLSLineSpeed(dlb, baud) if dlb>>DLB.dclm ne 0 then dlb>>DLB.puts = DLSOutput7 // No padding! ] ifnot Error(tstr, "? Illegal baud rate for this line*n*l") endcase ] case $C: case $c: [ test dlb>>DLB.dclm ne 0 & dlb>>DLB.carrierOff ifso [ if ctx>>CTX.name eq 0 do [ Wss(tstr, "Call phone number*n*lLogin required. *n*l") endcase ] Wss(tstr, "Call phone number: ") if DialOutCall(ctx, tstr) then [ DialOutRemote(ctx, tstr) Set7BitProcs(dlb) if dlb>>DLB.carrierOff then PutTemplate(tstr, "Length of call was $UD min.*n*l", TimeCallStop(ctx)) ] ] ifnot [ Wss(tstr, "Connect!*n*l"); DialOutRemote(ctx, tstr); Set7BitProcs(dlb) ] endcase ] case $D: case $d: [ Wss(tstr, "Disconnect [Confirm] ") if Confirm(tstr) then [ HangUp(dlb, false) if dlb>>DLB.dclm ne 0 then PutTemplate(tstr, "Length of call was $UD min.*n*l", TimeCallStop(ctx)) ] endcase ] case $E: case $e: [ Wss(tstr, "Escape character currently = ") Echo(tstr, ctx>>CTX.escapeChar) Wss(tstr, " Change to ") char = Gets(tstr) if char eq $*n % char eq $*l % char eq #177 then [ Error(tstr, " ?*n*l"); endcase ] Echo(tstr, char); Puts(tstr, $*s) if Confirm(tstr) then ctx>>CTX.escapeChar = char endcase ] case $I: case $i: Wss(dlb, "Ignore escape character ") if Confirm(dlb) then [ Wss(dlb, "Number of seconds to ignore for? ") ctx>>CTX.escapeTime = GetNumber(dlb) if ctx>>CTX.escapeTime le 0 then [ ctx>>CTX.escapeTime = 0; endcase ] ctx>>CTX.escapeDisabled = 1 SetTimer(lv ctx>>CTX.escapeCharTimer, 100) ] endcase case $L: case $l: [ Wss(tstr, "Login ...") Login(ctx, tstr, dlsOutList, "Dial Out Login") endcase ] case $Q: case $q: [ Wss(tstr, "Quit [Confirm] ") if Confirm(tstr) then [ HangUp(dlb, false) return ] endcase ] case $R: case $r: [ Wss(tstr, "Resume connection ") if dlb>>DLB.carrierOff then [ Error(tstr, "*n*lSorry, DLS line is disconnected.*n*l"); endcase ] if Confirm(tstr) then [ DialOutRemote(ctx, tstr) Set7BitProcs(dlb) if dlb>>DLB.carrierOff then PutTemplate(tstr, "Length of call was $UD min.*n*l", TimeCallStop(ctx)) ] endcase ] case $X: case $x: PutTemplate(tstr, "Xon/Xoff (Flow Control) $S ", (dlb>>DLB.flowControl? "off", "on")) if Confirm(tstr) then dlb>>DLB.flowControl = not dlb>>DLB.flowControl endcase case $W: case $w: if ctx>>CTX.name eq 0 do [ Wss(tstr, "Wizard mode*n*lLogin required. *n*l") endcase ] if dlb>>DLB.lineType ne ltHardwired do unless dlb>>DLB.carrierOff then [ Wss(tstr, "Wizard mode*n*lYou must break connection first!!!*n*l") endcase ] Wss(tstr, "Wizard mode [Confirm] ") if Confirm(tstr) then if OnListCheck(ctx, tstr, dlsWizardList) then WizardMode(ctx, tstr) endcase case #177: // delete Wss(tstr, " XXX") case $*n: case $*l: case $*s: [ Wss(tstr, crlf); endcase ] default: [ PutTemplate(tstr, "? Commands are: Baud, $S, Disconnect, Escape, Ignore escape char, Login, Quit*n*lResume, Xon/Xoff, 7 bit, 8 bit.*n*l", (dlb>>DLB.dclm ne 0? "Call", "Connect")) ] ] ] repeat // --------------------------------------------------------------------------- and DialOutRemote(ctx, tstr) be // --------------------------------------------------------------------------- [ let dlb = ctx>>CTX.dlb BSPForceOutput(lv ctx>>CTX.socket) test dlb>>DLB.eightBit eq 1 ifso [ dlb>>DLB.gets = DLSInput dlb>>DLB.puts = DLSOutput ] ifnot Set7BitProcs(dlb) let auxCtx = vec 150 Enqueue(mainCtx, InitializeContext(auxCtx, 150, DialOutLineToNet, size AuxCtx/16 - 3)) auxCtx>>AuxCtx.mainCtx = ctx ctx>>CTX.auxCtx = auxCtx ctx>>CTX.returnFrame = MyFrame() dlb>>DLB.error = DialOutDLSError NetToDialOutLine(ctx, tstr) Unqueue(mainCtx, auxCtx) ctx>>CTX.auxCtx = 0 Set7BitProcs(dlb) Wss(tstr, crlf) if dlb>>DLB.carrierOff then [ Wss(tstr, "> [Dial-out connection broken]*n*l") HangUp(dlb, false) ] ] // --------------------------------------------------------------------------- and DialOutDLSError(dlb) be LeaveRemoteMode(ctxTable!(dlb>>DLB.line)) // --------------------------------------------------------------------------- // Called if dial-out connection breaks while we are talking to it. // --------------------------------------------------------------------------- and OtherPupProc(pbi) be // --------------------------------------------------------------------------- // Procedure called for non-RTP, non-BSP Pups [ let soc = pbi>>PBI.socket let ctx = soc-offset CTX.socket/16 let dlb = ctx>>CTX.dlb let firstByte = nil switchon pbi>>PBI.pup.type into [ case typeInterrupt: ctx>>CTX.syncCount = ctx>>CTX.syncCount+1 endcase case typeAbort: Wss(dlb, "*n*l> [Abort] ") firstByte = 3 docase -1 case typeError: if soc>>BSPSoc.state eq stateAbort then [ Wss(dlb, "*n*l> [Error] "); firstByte = 25; docase -1 ] endcase case -1: for i = firstByte to pbi>>PBI.pup.length-pupOvBytes do Puts(dlb, pbi>>PBI.pup.bytes^i) Wss(dlb, crlf) endcase ] ReleasePBI(pbi) ]