// GateConServ.bcpl -- Gateway control server
// Last modified March 7, 1979 4:11 PM by Boggs
get "PupEFTP.decl"
get "PupServFtp.decl"
get "GateConServ.decl"
external
[
// outgoing procedures
GateConServCtx; HaltGateway
// incoming procedures
LockNameServ; UnlockNameServ; GetTime
LockBootServ; UnlockBootServ; StringCompare
GatewayFinish; Chatr; PupServReceive; PupServSend
InitializeContext; Block
Allocate; Free; MoveBlock; Zero
Enqueue; Dequeue; Unqueue; QueueLength
SetTimer; TimerHasExpired
GetPBI; ReleasePBI; CompletePup; SetPupID
ExchangePorts; AppendStringToPup
// outgoing statics
@gcs
// incoming statics
sysZone; ctxQ; versionText; CtxRunning
pbiTQ; pbiFreeQ; gatewayGoingDown; lenPup
]
static @gcs
manifest
[
// DOS .ertn codes
quit = 12345
restart = 1000
]
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.ftpCtx ne 0 & gcs>>GCS.stats.ftpStatus ne statusBusy then
[
compiletest nova
ifso [ ReleasePBI(gcs>>GCS.ftpCtx-offset PBI.pup/16) ]
ifnot [ Free(sysZone, gcs>>GCS.ftpCtx) ]
gcs>>GCS.ftpCtx = 0
]
if gcs>>GCS.quitCode ne 0 & gcs>>GCS.ftpCtx 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.ftpCtx eq 0 & gcs>>GCS.quitCode eq 0 then
[
let ctx = alto? Allocate(sysZone, 1200, true), valof
[
let pbi = GetPBI(gcs>>GCS.soc, true)
resultis pbi eq 0? 0, lv pbi>>PBI.pup
]
if ctx ne 0 then
[
gcs>>GCS.ftpCtx = ctx
gcs>>GCS.stats.ftpStatus = 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, (alto? 1200, lenPup),
(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.ftpStatus
// to anything other than statusBusy.
[
let pbi = ctx>>GCTX.pbi
let ftp = vec lenFTP; Zero(ftp, lenFTP)
ftp>>FTP.frnPort = lv pbi>>PBI.pup.dPort
Zero(lv pbi>>PBI.pup.sPort.socket, 2) //let OpenLevel1Socket pick the socket
ftp>>FTP.lclPort = lv pbi>>PBI.pup.sPort //but use net,host in request pup
ftp>>FTP.realName = lv pbi>>PBI.pup.bytes
ftp>>FTP.tempName = "TEMP.GC"
ftp>>FTP.timeOut1 = 100
ftp>>FTP.timeOut2 = 2000 //20 seconds
ftp>>FTP.proc1 = GateConStart
ftp>>FTP.proc2 = GateConEnd
let status = PupServReceive(ftp)? statusYes, statusNo
if status eq statusYes then
[
UnlockBootServ(lv pbi>>PBI.pup.bytes)
UnlockNameServ()
]
ReleasePBI(pbi)
Unqueue(ctxQ, ctx)
gcs>>GCS.stats.ftpStatus = 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
//---------------------------------------------------------------------------
[
compileif nova then
[
let fn = lv CtxRunning>>GCTX.pbi>>PBI.pup.bytes
if StringCompare(fn, ".SV", fn>>String.length-2) eq 0 then
Chatr(stream, 20000b) // set "S" attribute for .SV file
]
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.ftpStatus
// to anything other than statusBusy.
[
let pbi = ctx>>GCTX.pbi
let ftp = vec lenFTP; Zero(ftp, lenFTP)
ftp>>FTP.frnPort = lv pbi>>PBI.pup.dPort
Zero(lv pbi>>PBI.pup.sPort.socket, 2) //let OpenLevel1Socket pick the socket
ftp>>FTP.lclPort = lv pbi>>PBI.pup.sPort //but use net,host in request pup
ftp>>FTP.realName = lv pbi>>PBI.pup.bytes
ftp>>FTP.timeOut1 = 500 //5 seconds
ftp>>FTP.timeOut2 = 2000 //20 seconds
let status = PupServSend(ftp)? statusYes, statusNo
ReleasePBI(pbi)
Unqueue(ctxQ, ctx)
gcs>>GCS.stats.ftpStatus = status //signal that we are done
// returning from a context causes an implicit Block()
]