// IfsNameRare.bcpl - Name lookup server
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified December 5, 1981 3:00 PM by Taft
get "Pup0.decl"
get "Pup1.decl"
get Lock from "Ifs.decl"
get "IfsNameServ.decl"
get "IfsServEFTP.decl"
get "IfsDirs.decl"
get "IfsRs.decl"
external
[
// outgoing procedures
CreateNameServ; EnableNameServ; NameServUncommon; CheckNetDirChecksum
NameServEvent; SendNetDir; ReceiveNetDir
// incoming procedures
InstallNetworkDirectory
OpenLevel1Socket; CloseLevel1Socket
GetPBI; ReleasePBI; CompletePup
PupServSend; PupServReceive
CreateEvent; QueueEvent; CreateJob; DestroyJob
LnPageSize; Closes; Resets
FileLength; SetFilePos; KsBufferAddress
CreateStringStream; PutTemplate
SetTimer; TimerHasExpired; Block; Dequeue; IFSError
Min; Max; DoubleDifference; DoubleIncrement
SysAllocateZero; SysFree; Usc; MoveBlock; Zero; Noop
// incoming statics
@ns; system; CtxRunning
]
//----------------------------------------------------------------------------
structure NameCtx:
//----------------------------------------------------------------------------
[
@RSCtx
reqPort @Port = // port of guy who wants our directory
[
ftp word // -> FTP structure for receiving net dir
version word // version we expect to receive
]
]
manifest lenNameCtx = size NameCtx/16
//----------------------------------------------------------------------------
let CreateNameServ() be
//----------------------------------------------------------------------------
[
ns = SysAllocateZero(lenNS)
ns>>NS.stats.version = nameStatsVersion
ns>>NS.bcstInterval = 12 // 1 hour between broadcasts
CreateEvent(NameServEvent)
]
//----------------------------------------------------------------------------
and EnableNameServ(value) be ns>>NS.externalLock = not value
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and NameServUncommon(pbi) be
//----------------------------------------------------------------------------
// Handles uncommon Name protocol pbis that pop out of the Miscellaneous
// socket. Note that an ExchangePorts has already been done.
[
switchon pbi>>PBI.pup.type into
[
case ptNetDirVersion:
switchon Usc(pbi>>PBI.pup.words↑1, ns>>NS.version) into
[
case -1: // tell him we have a later version
if ns>>NS.globalLocks eq 0 & ns>>NS.tree ne 0 then
[
pbi>>PBI.pup.words↑1 = ns>>NS.version
CompletePup(pbi, ptNetDirVersion, pupOvBytes+2)
return
]
endcase
case 1: // he claims to have a later version
CreateNameCtx(ReceiveNetDir)
endcase
// case 0: // our versions are the same
// endcase
]
endcase
case ptSendNetDir:
if ns>>NS.globalLocks eq 0 then
CreateNameCtx(SendNetDir, lv pbi>>PBI.pup.words↑1)
endcase
case ptNetDirStatsRequest:
MoveBlock(lv pbi>>PBI.pup.words, lv ns>>NS.stats, size Stats/16)
CompletePup(pbi, ptNetDirStatsReply, pupOvBytes+size Stats/8)
return
case ptNetDirLockRequest:
case ptNetDirUnlockRequest:
[
if pbi>>PBI.pup.id↑1 eq 27182 & pbi>>PBI.pup.sPort.host ne 0 then
[
let unlock = pbi>>PBI.pup.type eq ptNetDirUnlockRequest
ns>>NS.bcstTimer = 0
EnableNameServ(unlock)
CompletePup(pbi, (unlock? ptNetDirUnlockReply, ptNetDirLockReply),
pupOvBytes)
return
]
endcase
]
]
ReleasePBI(pbi)
]
//----------------------------------------------------------------------------
and NameServEvent(ecb) be
//----------------------------------------------------------------------------
[
ns>>NS.bcstTimer = Max(ns>>NS.bcstTimer-1, 0)
if ns>>NS.bcstTimer eq 0 then
CreateNameCtx(ReceiveNetDir)
QueueEvent(ecb, 30000) // 5 minutes
]
//----------------------------------------------------------------------------
and CreateNameCtx(Proc, reqPort) be
//----------------------------------------------------------------------------
[
if ns>>NS.ctx ne 0 return
let ctx = CreateJob(Proc, jobTypeNameUpdate, lenNameCtx-3)
if ctx ne 0 then
[
ns>>NS.ctx = ctx
ctx>>NameCtx.userInfo = system
MoveBlock(lv ctx>>NameCtx.reqPort, reqPort, lenPort)
]
]
//----------------------------------------------------------------------------
and SendNetDir(ctx) be // a context
//----------------------------------------------------------------------------
[
let ftp = vec lenFTP
Zero(ftp, lenFTP)
ftp>>FTP.frnPort = lv ctx>>NameCtx.reqPort
ftp>>FTP.realName = "Pup-Network.directory"
ftp>>FTP.timeOut1 = 1000
ftp>>FTP.timeOut2 = 1000
if PupServSend(ftp) then DoubleIncrement(lv ns>>NS.stats.dirReqs)
ns>>NS.ctx = 0
DestroyJob()
]
//----------------------------------------------------------------------------
and ReceiveNetDir(ctx) be // a context
//----------------------------------------------------------------------------
// Probe all name servers on all directly connected networks.
// If we locate a newer version, get it.
[
ns>>NS.bcstTimer = ns>>NS.bcstInterval
// When IFS is first started up, the directory is not yet installed, so...
if ns>>NS.tree eq 0 then InstallNetworkDirectory()
let soc = vec lenPupSoc
OpenLevel1Socket(soc, 0, table [ 0; 0; socketMiscServices ], true)
let pbi = GetPBI(soc)
pbi>>PBI.pup.words↑1 = ns>>NS.globalLocks eq 0? ns>>NS.version, 0
CompletePup(pbi, ptNetDirVersion, pupOvBytes+2)
let bestSoFar = ns>>NS.version
let timer = nil; SetTimer(lv timer, 1000) //10 seconds
let frnPort = vec lenPort
[
Block()
until soc>>PupSoc.iQ.head eq 0 do
[
let pbi = Dequeue(lv soc>>PupSoc.iQ)
if pbi>>PBI.pup.type eq ptNetDirVersion &
pbi>>PBI.pup.words↑1 ugr bestSoFar then
[
bestSoFar = pbi>>PBI.pup.words↑1
MoveBlock(frnPort, lv pbi>>PBI.pup.sPort, lenPort)
]
ReleasePBI(pbi)
]
] repeatuntil TimerHasExpired(lv timer)
CloseLevel1Socket(soc)
if bestSoFar ugr ns>>NS.version then
[
let ftp = vec lenFTP; Zero(ftp, lenFTP)
ftp>>FTP.frnPort = frnPort
let realName = vec 15
ftp>>FTP.realName = realName // NSEndProc will generate the realName
ftp>>FTP.tempName = "Pup-Network.temp"
ftp>>FTP.timeOut1 = 100
ftp>>FTP.timeOut2 = 3000 // 30 seconds
ftp>>FTP.proc1 = NSStartProc
ftp>>FTP.proc2 = NSEndProc
ctx>>NameCtx.ftp = ftp // so NSEndProc can find it
ctx>>NameCtx.version = bestSoFar
if PupServReceive(ftp) then
if InstallNetworkDirectory() then loop // notify world
]
ns>>NS.ctx = 0
DestroyJob()
] repeat
//----------------------------------------------------------------------------
and NSStartProc(soc) be
//----------------------------------------------------------------------------
[
let pbi = GetPBI(soc, true); if pbi ne 0 then
[
MoveBlock(lv pbi>>PBI.pup.words, lv soc>>PupSoc.lclPort, lenPort)
CompletePup(pbi, ptSendNetDir, pupOvBytes + lenPort*2)
]
]
//----------------------------------------------------------------------------
and NSEndProc(stream) = valof
//----------------------------------------------------------------------------
[
Resets(stream)
unless KsBufferAddress(stream)>>Hdr.version eq CtxRunning>>NameCtx.version &
CheckNetDirChecksum(stream) resultis false
let ss = CreateStringStream(CtxRunning>>NameCtx.ftp>>FTP.realName, 30)
PutTemplate(ss, "Pup-Network.directory!$UD", CtxRunning>>NameCtx.version)
Closes(ss)
resultis true
]
//----------------------------------------------------------------------------
and CheckNetDirChecksum(stream) = valof
//----------------------------------------------------------------------------
// stream should be a stream open on the file.
// Returns true iff the file's checksum is ok.
// Leaves the stream positioned at end-of-file.
[
let length = vec 1
FileLength(stream, length)
let pageLength = 2 lshift LnPageSize(stream)
let buffer = KsBufferAddress(stream)
let checksum = 0
let fileChecksum = nil
let pos = vec 1
Zero(pos, 2)
[ // repeat
SetFilePos(stream, pos)
let remainder = DoubleDifference(length, pos)
if remainder eq 0 break
let byteCount = Min(remainder, pageLength)
let wordCount = byteCount rshift 1
if remainder le pageLength then
[ // this is the last (non-empty) page of the file
wordCount = wordCount-1
fileChecksum = buffer!wordCount
]
if wordCount gr 0 then
checksum = (table
[
55001b // sta 3 1 2
35003b // lda 3 3 2
63000b // pupChecksum
35001b // lda 3 1 2
1401b // jmp 1 3
])(checksum, buffer, wordCount)
DoubleIncrement(pos, byteCount)
] repeat
resultis checksum eq fileChecksum
]