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