// CopyDiskNet.bcpl // Copyright Xerox Corporation 1979, 1980, 1981 // Last modified November 3, 1981 11:30 PM by Boggs get "Pup.decl" get "AltoDefs.d" get "CopyDisk.decl" get "CopyDiskNet.decl" external [ // outgoing procedures InitCopyDiskNet; MakeNetSS // incoming procedures from OS and packages CreateBSPStream; CloseBSPSocket; OpenRTPSocket; CloseRTPSocket OpenLevel1Socket; CloseLevel1Socket; GetPBI; ReleasePBI InitPupLevel1; CompletePup; GetPartner; HLookup InvertLine; GetLinePos; SetBitPos Puts; Resets; Closes; PutTemplate ExtractSubstring; CopyString; CreateStringStream Block; InitializeContext; Dismiss; SetTimer; TimerHasExpired TruePredicate; FalsePredicate; ReadCalendar Allocate; Free; Zero; MoveBlock Dequeue; Enqueue; Unqueue // incoming procedures from CopyDisk NetCompatible; NetPrintDA; NetCompare NetReader; NetWriter; NetPrintBlock; PrintPort GetBlock; PutBlock; PutString; PrintDiskParams MakeSS; DoIt; Wss; GetNamePass // incoming statics sysZone; CtxRunning; ctxQ; versionText debugFlag; writeProtectFlag; defaultTimeout userName; userPass; connName; connPass dsp; titleDsp; controlLock; pupRT; ndbQ ] static [ ourName; otherPupQ ] //---------------------------------------------------------------------------- let InitCopyDiskNet() be //---------------------------------------------------------------------------- [ InitPupLevel1(sysZone, ctxQ, 10) Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 400), 400, NetServer)) Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 250), 250, OtherPupCtx)) otherPupQ = Allocate(sysZone, 2); otherPupQ!0 = 0 ] //---------------------------------------------------------------------------- and NetServer(ctx) be //---------------------------------------------------------------------------- [ let servSoc = Allocate(sysZone, lenBSPSoc) //freed by DestoryNetSS OpenLevel1Socket(servSoc, table [ 0; 0; socketCD ]) [ OpenRTPSocket(servSoc, ctxQ, modeListenAndReturn, 0, OtherPup) Block() repeatuntil servSoc>>RTPSoc.state ne stateListening if controlLock eq idle break //open connection CloseRTPSocket(servSoc, 0) //refuse connection ] repeat controlLock = server let diskSS, netSS = 0, CreateNetSS(servSoc) netSS>>SS.type = ssNetPhys PutTemplate(dsp, "*NConnection open with $P", PrintPort, lv servSoc>>BSPSoc.frnPort) [ // repeat let cd = GetBlock(0, false); if cd eq 0 break switchon cd>>CD.type into [ case version: [ PutString(version, cdVersion, versionText) endcase ] case login: [ if (lv cd>>CD.string)>>String.length ne 0 then PutTemplate(dsp, "*NLogin user '$S'", lv cd>>CD.string.string) PutString(yes, 0, "login ignored") endcase ] case hereAreDiskParams: [ if diskSS>>SS.dp ne 0 then Free(sysZone, diskSS>>SS.dp) diskSS>>SS.dp = Allocate(sysZone, cd>>CD.length) MoveBlock(diskSS>>SS.dp, cd, cd>>CD.length) endcase ] case sendDiskParamsR: case sendDiskParamsW: [ PutTemplate(dsp, "*NTell me about '$S'", lv cd>>CD.string) if diskSS ne 0 then (diskSS>>SS.destroy)(diskSS) diskSS = MakeSS(lv cd>>CD.string, cd>>CD.type eq sendDiskParamsW) CtxRunning>>CDCtx.ss = netSS test diskSS eq 0 ifso PutString(no, 1, "Can't initialize disk") ifnot PutBlock(diskSS>>SS.dp) endcase ] case sendErrors: [ PutBlock(diskSS>>SS.errors); endcase ] case storeDisk: [ test writeProtectFlag ifso PutString(no, 3, "Writing not allowed") ifnot [ PutTemplate(dsp, "*NWriting $S", diskSS>>SS.device) DoIt(netSS, diskSS, true, cd) ] endcase ] case retrieveDisk: [ PutTemplate(dsp, "*NReading $S", diskSS>>SS.device) DoIt(diskSS, netSS, true, cd) endcase ] default: [ PutString(no, 4, "Unknown command"); endcase ] ] Free(sysZone, cd) ] repeat if netSS ne 0 then netSS = (netSS>>SS.destroy)(netSS) if diskSS ne 0 then diskSS = (diskSS>>SS.destroy)(diskSS) Wss(dsp, "*NServer connection closed") controlLock = idle ] repeat //---------------------------------------------------------------------------- and MakeNetSS(name, write) = valof //---------------------------------------------------------------------------- // Called by MakeSS. Name is "[Host]Device" // Returns an SS or 0 [ let bracket = 1 for i = 1 to name>>String.length do if name>>String.char^i eq $] then [ bracket = i; break ] let host = ExtractSubstring(name, 2, bracket-1) let port = vec lenPort let res = GetPartner(host, dsp, port, 0, socketCD) Free(sysZone, host) unless res resultis false // The following code handles a special case: // If the user types []device, then strip off // "[]" and recursively call MakeSS. let rte = HLookup(pupRT, port>>Port.net) if rte ne 0 & rte>>RTE.hops eq 0 & rte>>RTE.ndb>>NDB.localHost eq port>>Port.host then [ let device = ExtractSubstring(name, bracket+1) let res = MakeSS(device, write) Free(sysZone, device) resultis res ] // open connection... let soc = Allocate(sysZone, lenBSPSoc) OpenLevel1Socket(soc, 0, port) OpenRTPSocket(soc, ctxQ, modeInitAndReturn, 0, OtherPup) unless valof [ if soc>>RTPSoc.state eq stateOpen then resultis true if soc>>RTPSoc.state ne stateRFCOut then [ CloseRTPSocket(soc) OpenRTPSocket(soc, ctxQ, modeInitAndReturn, 0, OtherPup) ] if (kbdAd!3 & 4) eq 0 % (kbdAd!1 & 3) ne 3 resultis false Block() ] repeat do [ Wss(dsp, "*NConnection attempt failed") CloseRTPSocket(soc, 0) CloseLevel1Socket(soc) Free(sysZone, soc) resultis false ] let netSS = CreateNetSS(soc) netSS>>NetSS.device = ExtractSubstring(name) // exchange versions let ok = true PutString(version, cdVersion, versionText) let cd = GetBlock(); if cd eq 0 then ok = false test ok ifnot Wss(dsp, "*NConnection refused by remote host") ifso if cd>>CD.type ne version % cd>>CD.codeString.code ne cdVersion then [ Wss(dsp, "*NCopyDisk programs are incompatible.") ok = false ] if cd ne 0 then Free(sysZone, cd) // MakeNetSS (cont'd) // login if ok then ok = valof [ let uNam = (userName? userName>>String.length rshift 1, 0) +1 let uPsw = (userPass? userPass>>String.length rshift 1, 0) +1 let cNam = (connName? connName>>String.length rshift 1, 0) +1 let cPsw = (connPass? connPass>>String.length rshift 1, 0) +1 let length = lenString + uNam + uPsw + cNam + cPsw let cd = Allocate(sysZone, length); Zero(cd, length) cd>>CD.length = length let p = lv cd>>CD.string.string if userName then CopyString(p, userName) p = p + uNam if userPass then CopyString(p, userPass) p = p + uPsw if connName then CopyString(p, connName) p = p + cNam if connPass then CopyString(p, connPass) PutBlock(cd, login) Free(sysZone, cd) cd = GetBlock(); if cd eq 0 resultis false let type = cd>>CD.type let code = cd>>CD.codeString.code Free(sysZone, cd) if type eq yes resultis true switchon code into [ case 20b: case 21b: case 2: [ unless GetNamePass("*NLogin user: ", lv userName, lv userPass) resultis false endcase ] case 23b: case 24b: [ unless GetNamePass("*NConnect to directory: ", lv connName, lv connPass) resultis false endcase ] ] ] repeat if ok then ok = valof // get disk parameters [ let device = ExtractSubstring(name, bracket+1) let length = lenString + device>>String.length rshift 1 +1 let cd = Allocate(sysZone, length) cd>>CD.length = length CopyString(lv cd>>CD.string.string, device) Free(sysZone, device) PutBlock(cd, (write? sendDiskParamsW, sendDiskParamsR)) Free(sysZone, cd) netSS>>SS.dp = GetBlock() if netSS>>SS.dp eq 0 % netSS>>SS.dp>>CD.type ne hereAreDiskParams resultis false test netSS>>SS.dp>>CD.diskParams.diskType eq 0 ifso netSS>>SS.type = ssNetLog ifnot [ Puts(dsp, $*N) PrintDiskParams(netSS>>SS.dp) netSS>>SS.type = ssNetPhys ] resultis true ] resultis ok? netSS, DestroyNetSS(netSS) ] //---------------------------------------------------------------------------- and CreateNetSS(soc) = valof //---------------------------------------------------------------------------- [ let ss = Allocate(sysZone, lenNetSS); Zero(ss, lenNetSS) ss>>SS.read = NetReader ss>>SS.write = NetWriter ss>>SS.destroy = DestroyNetSS ss>>SS.printDA = NetPrintDA ss>>SS.compatible = NetCompatible ss>>SS.compare = NetCompare ss>>SS.printBlock = NetPrintBlock ss>>NetSS.soc = soc let stream = CreateBSPStream(soc) ss>>NetSS.stream = stream CtxRunning>>CDCtx.ss = ss resultis ss ] //---------------------------------------------------------------------------- and DestroyNetSS(ss) = valof //---------------------------------------------------------------------------- [ let timeout = ss>>NetSS.stream>>ST.gets eq TruePredicate? 0, defaultTimeout CloseBSPSocket(ss>>NetSS.soc, timeout) Free(sysZone, ss>>NetSS.soc) if ss>>SS.device ne 0 then Free(sysZone, ss>>SS.device) if ss>>SS.dp ne 0 then Free(sysZone, ss>>SS.dp) if ss>>SS.errors ne 0 then Free(sysZone, ss>>SS.errors) Free(sysZone, ss) resultis 0 ] //---------------------------------------------------------------------------- and OtherPup(pbi) be Enqueue(otherPupQ, pbi) //---------------------------------------------------------------------------- //---------------------------------------------------------------------------- and OtherPupCtx(ctx) be //---------------------------------------------------------------------------- // This is a catch-all process. It prints Error and Abort Pups from // BSP connections, it tries to get the string name of this host, // and it updates the title line. [ let soc = vec lenPupSoc; OpenLevel1Socket(soc, 0, table [ 0; 0; 4 ]) let nameTime, nameTimer = 50, nil; SetTimer(lv nameTimer, 500) let us = vec lenPort; Zero(us, lenPort) let name, lock, part = ourName, controlLock, Partition() [ if name ne ourName % lock ne controlLock % (ourName eq 0 & (us>>Port.net ne (ndbQ!0)>>NDB.localNet % us>>Port.host ne (ndbQ!0)>>NDB.localHost)) % part ne Partition() then [ Resets(titleDsp) InvertLine(titleDsp, GetLinePos(titleDsp)) Wss(titleDsp, versionText) SetBitPos(titleDsp, 250) test ourName ne 0 ifso [ name = ourName Wss(titleDsp, ourName) ] ifnot [ us>>Port.net = (ndbQ!0)>>NDB.localNet us>>Port.host = (ndbQ!0)>>NDB.localHost PrintPort(titleDsp, us) ] if part ne 0 then [ part = Partition() SetBitPos(titleDsp, 375) PutTemplate(titleDsp, "Partition $D", part) ] lock = controlLock if controlLock ne 0 then [ SetBitPos(titleDsp, 525) Wss(titleDsp, (controlLock eq server? "Server", "User")) ] ] if otherPupQ!0 ne 0 then [ let pbi = Dequeue(otherPupQ) let errorString, startByte = 0, 0 if pbi>>PBI.pup.type eq typeAbort then [ errorString = "*NAbort"; startByte = 3 ] if pbi>>PBI.pup.type eq typeError then if debugFlag % pbi>>PBI.socket>>BSPSoc.state eq stateAbort then [ errorString = "*NError"; startByte = 25 ] if startByte ne 0 then [ PutTemplate(dsp, "$S Pup from $P: ", errorString, PrintPort, lv pbi>>PBI.pup.sPort) for i = startByte to pbi>>PBI.pup.length-pupOvBytes do Puts(dsp, pbi>>PBI.pup.bytes^i) ] ReleasePBI(pbi) ] // OtherPupCtx (cont'd) manifest [ ptAddressLookup = 223b ptAddressReply = 224b ptNetDirError = 222b ] if soc>>PupSoc.iQ.head ne 0 then [ let pbi = Dequeue(lv soc>>PupSoc.iQ) if ourName eq 0 & pbi>>PBI.pup.type eq ptAddressReply then [ let numChars = pbi>>PBI.pup.length-pupOvBytes+2 ourName = Allocate(sysZone, numChars/2+1) ourName>>String.length = numChars ourName>>String.char^1 = $[ for i = 1 to numChars-2 do ourName>>String.char^(i+1) = pbi>>PBI.pup.bytes^i ourName>>String.char^numChars = $] ] if ourName eq 0 & pbi>>PBI.pup.type eq ptNetDirError then [ let ss = CreateStringStream(lv pbi>>PBI.pup.bytes, 255) PrintPort(ss, us) Closes(ss) ourName = ExtractSubstring(lv pbi>>PBI.pup.bytes) ] ReleasePBI(pbi) ] if ourName eq 0 & TimerHasExpired(lv nameTimer) then [ let pbi = GetPBI(soc, true); if pbi ne 0 then [ MoveBlock(lv pbi>>PBI.pup.bytes, us, lenPort) CompletePup(pbi, ptAddressLookup, pupOvBytes+6) nameTime = nameTime lshift 1 if nameTime gr 1600 then nameTime = 1600 SetTimer(lv nameTimer, nameTime) ] ] Dismiss(20) // 5 times per second ] repeat ] //---------------------------------------------------------------------------- and Partition() = (table [ 61014b; 1401b ])()<