// GateConServ.bcpl -- Gateway control server
// Last modified December 26, 1981 10:30 PM by Boggs
get "PupEFTP.decl"
get "PupServEftp.decl"
get "GateConServ.decl"
external
[
// outgoing procedures
GateConServCtx; HaltGateway
// incoming procedures
LockNameServ; UnlockNameServ; GetTime
LockBootServ; UnlockBootServ
GatewayFinish; PupServReceive; PupServSend
InitializeContext; Block
Allocate; Free; MoveBlock; Zero
Enqueue; Dequeue; Unqueue; QueueLength
SetTimer; TimerHasExpired
GetPBI; ReleasePBI; CompletePup; SetPupID
ExchangePorts
// outgoing statics
@gcs
// incoming statics
sysZone; ctxQ; versionText; CtxRunning
pbiFreeQ; gatewayGoingDown
]
static @gcs
manifest
[
restart = 1000
quit = 12345b
]
structure GCTX: // GateControl CTX
[
blank word 3
pbi word
]
manifest GCTXextra = size GCTX/16 -3
//---------------------------------------------------------------------------
let HaltGateway() be
//---------------------------------------------------------------------------
[
gcs>>GCS.quitCode = quit
gatewayGoingDown = true
// Dally for 15 seconds while we broadcast routing tables that say we are
// a terrible route to everywhere so that people can find ways around us.
SetTimer(lv gcs>>GCS.restartTimer, 1500)
]
//---------------------------------------------------------------------------
and GateConServCtx() be
//---------------------------------------------------------------------------
[
[ // idle loop
Block()
if gcs>>GCS.stats.startTime↑0 eq 0 then
GetTime(lv gcs>>GCS.stats.startTime)
if gcs>>GCS.eftpCtx ne 0 & gcs>>GCS.stats.eftpStatus ne statusBusy then
[
Free(sysZone, gcs>>GCS.eftpCtx)
gcs>>GCS.eftpCtx = 0
]
if gcs>>GCS.quitCode ne 0 & gcs>>GCS.eftpCtx eq 0 &
TimerHasExpired(lv gcs>>GCS.restartTimer) then
[
LockBootServ()
LockNameServ()
GatewayFinish(gcs>>GCS.quitCode)
]
] repeatuntil gcs>>GCS.soc>>PupSoc.iQ.head ne 0
let pbi = Dequeue(lv gcs>>GCS.soc>>PupSoc.iQ)
if pbi>>PBI.pup.dPort.host eq 0 % pbi>>PBI.pup.id↑1 ne gcPassword then
[ ReleasePBI(pbi); loop ]
ExchangePorts(pbi) //do this here rather than in each case
switchon pbi>>PBI.pup.type into
[
case ptExamine:
[
//examine a block of words whose starting address
//and length are given in the first 2 words of the
//request Pup. return the block starting in word 3.
MoveBlock(lv pbi>>PBI.pup.words↑3, pbi>>PBI.pup.words↑1,
pbi>>PBI.pup.words↑2)
CompletePup(pbi, ptAck, pbi>>PBI.pup.words↑2 lshift 1 + pupOvBytes+4)
endcase
]
case ptDeposit:
[
//deposit a block of words whose starting address
//and length are given in the first 2 words of the
//request Pup. the data starts at word 3.
MoveBlock(pbi>>PBI.pup.words↑1, lv pbi>>PBI.pup.words↑3,
pbi>>PBI.pup.words↑2)
CompletePup(pbi, ptAck, pupOvBytes)
endcase
]
case ptHalt:
[
//halt the gateway program
HaltGateway()
CompletePup(pbi, ptAck, pupOvBytes)
endcase
]
case ptRestart:
[
//restart the Gateway program
gcs>>GCS.quitCode = restart
SetTimer(lv gcs>>GCS.restartTimer, 500) // dally for 5 seconds
CompletePup(pbi, ptAck, pupOvBytes)
endcase
]
// GateConServ (cont'd)
case ptStore:
//Store a file on the gateway disk whose name is given
// in the Pup contents. The server responds with an ack
// containing the port to which the file should be EFTP'ed.
case ptRetrieve:
//Retrieve a file from the gateway disk whose name is given
// in the Pup contents. The server generates no ack: it just starts
// EFTPing the file to the source port of the incoming packet.
[
if gcs>>GCS.eftpCtx eq 0 & gcs>>GCS.quitCode eq 0 then
[
let ctx = Allocate(sysZone, 1200, true)
if ctx ne 0 then
[
gcs>>GCS.eftpCtx = ctx
gcs>>GCS.stats.eftpStatus = statusBusy
ctx>>GCTX.pbi = pbi
for i = pbi>>PBI.pup.length-pupOvBytes to 1 by -1 do
pbi>>PBI.pup.bytes↑(i+1) = pbi>>PBI.pup.bytes↑i
pbi>>PBI.pup.bytes↑1 = pbi>>PBI.pup.length-pupOvBytes
Enqueue(ctxQ, InitializeContext(ctx, 1200,
(pbi>>PBI.pup.type eq ptStore? GCSStore, GCSRetrieve),
GCTXextra))
endcase
]
]
ReleasePBI(pbi)
endcase
]
case ptStats:
[
let stats = lv pbi>>PBI.pup.words
MoveBlock(stats, lv gcs>>GCS.stats, lenStats)
stats>>Stats.freePBIs = QueueLength(pbiFreeQ)
let lenVersionText = versionText>>String.length rshift 1 +1
MoveBlock(lv stats>>Stats.versionText, versionText, lenVersionText)
CompletePup(pbi, ptAck, pupOvBytes+(lenStats+lenVersionText)*2)
endcase
]
default:
ReleasePBI(pbi)
]
] repeat
//---------------------------------------------------------------------------
and GCSStore(ctx) be
//---------------------------------------------------------------------------
// A separate context that does the file transfer.
// It signals that it is done by changing gcs>>GCS.stats.eftpStatus
// to anything other than statusBusy.
[
let pbi = ctx>>GCTX.pbi
let eftp = vec lenEFTP; Zero(eftp, lenEFTP)
eftp>>EFTP.frnPort = lv pbi>>PBI.pup.dPort
Zero(lv pbi>>PBI.pup.sPort.socket, 2) //let OpenLevel1Socket pick the socket
eftp>>EFTP.lclPort = lv pbi>>PBI.pup.sPort //but use net,host in request pup
eftp>>EFTP.realName = lv pbi>>PBI.pup.bytes
eftp>>EFTP.tempName = "TEMP.GC"
eftp>>EFTP.timeOut1 = 100
eftp>>EFTP.timeOut2 = 2000 //20 seconds
eftp>>EFTP.proc1 = GateConStart
eftp>>EFTP.proc2 = GateConEnd
let status = PupServReceive(eftp)? statusYes, statusNo
if status eq statusYes then
[
UnlockBootServ(lv pbi>>PBI.pup.bytes)
UnlockNameServ()
]
ReleasePBI(pbi)
Unqueue(ctxQ, ctx)
gcs>>GCS.stats.eftpStatus = status //signal that we are done
// returning from a context causes an implicit Block()
]
//---------------------------------------------------------------------------
and GateConStart(soc) be
//---------------------------------------------------------------------------
// This is where the ack containing the EFTP port gets generated.
[
let pbi = GetPBI(soc, true); if pbi ne 0 then
[
SetPupID(pbi, lv CtxRunning>>GCTX.pbi>>PBI.pup.id)
MoveBlock(lv pbi>>PBI.pup.words, lv soc>>PupSoc.lclPort, lenPort)
CompletePup(pbi, ptAck, pupOvBytes+lenPort*2)
]
]
//---------------------------------------------------------------------------
and GateConEnd(stream) be
//---------------------------------------------------------------------------
[
LockBootServ()
LockNameServ()
]
//---------------------------------------------------------------------------
and GCSRetrieve(ctx) be
//---------------------------------------------------------------------------
// A separate context that does the file transfer.
// It signals that it is done by changing gcs>>GCS.stats.eftpStatus
// to anything other than statusBusy.
[
let pbi = ctx>>GCTX.pbi
let eftp = vec lenEFTP; Zero(eftp, lenEFTP)
eftp>>EFTP.frnPort = lv pbi>>PBI.pup.dPort
Zero(lv pbi>>PBI.pup.sPort.socket, 2) //let OpenLevel1Socket pick the socket
eftp>>EFTP.lclPort = lv pbi>>PBI.pup.sPort //but use net,host in request pup
eftp>>EFTP.realName = lv pbi>>PBI.pup.bytes
eftp>>EFTP.timeOut1 = 500 //5 seconds
eftp>>EFTP.timeOut2 = 2000 //20 seconds
let status = PupServSend(eftp)? statusYes, statusNo
ReleasePBI(pbi)
Unqueue(ctxQ, ctx)
gcs>>GCS.stats.eftpStatus = status //signal that we are done
// returning from a context causes an implicit Block()
]