// 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 [<ourHost>]device, then strip off
// "[<ourHost>]" 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 ])()<<VERS.eng gr 3?
(table [ 61037b; 1401b ])(0), 0
//----------------------------------------------------------------------------