// PupTestMisc.bcpl
// Copyright Xerox Corporation 1980, 1982
// Last modified February 15, 1982 5:36 PM by Boggs
get "pup.decl"
get "puptest.decl"
external
[
// outgoing procedures
MiscServices
// incoming procedures
Ws; Puts; Gets; PutTemplate; UNPACKDT; WRITEUDT
GetPBI; ReleasePBI; CompletePup; AppendStringToPup
OpenLevel1Socket; CloseLevel1Socket
SetTimer; TimerHasExpired; Enqueue; Dequeue; Block; MultEq
Confirm; GetString
OpenPort; RTTitle; RTEntry; PrintPort
OtherSpigot
// incoming statics
dsp; keys
]
manifest
[
// misc services protocols
psMiscServ = 4
ptStringTimeRequest = 200b
ptStringTimeReply = 201b
ptTenexTimeRequest = 202b
ptTenexTimeReply = 203b
ptAltoTimeRequest = 206b
ptAltoTimeReply = 207b
ptMailCheckRequest = 214b
ptMailCheckYes = 211b
ptMailCheckNo = 212b
ptMailCheckError = 213b
ptNameRequest = 220b
ptNameReply = 221b
ptNameAddrError = 222b
ptAddressRequest = 223b
ptAddressReply = 224b
ptNetDirVersion = 240b
ptWhereUserRequest = 230b
ptWhereUserReply = 231b
ptWhereUserError = 232b
ptAuthRequest = 250b
ptAuthYes = 251b
ptAuthNo = 252b
ptValidRecipRequest = 266b
ptValidRecipYes = 267b
ptValidRecipNo = 270b
// Routing info protocol
psRouteInfo = 2
ptRouteInfoRequest = 200b
ptRouteInfoReply = 201b
]
static [ miscID; miscSoc ]
//----------------------------------------------------------------------------
let MiscServices(quit) be
//----------------------------------------------------------------------------
[
let soc = vec lenPupSoc; miscSoc = soc
unless OpenPort("Misc services host: ", soc, 0, psMiscServ) return
[
Ws("*N>>")
switchon Gets(keys) into
[
case $A: case $a:
[ Authenticate(); endcase ]
case $D: case $d:
[ DateAndTime(); endcase ]
case $H: case $h:
[ quit = false; break ]
case $N: case $n:
[ NetDirectory(); endcase ]
case $M: case $m:
[ MailCheck(); endcase ]
case $Q: case $q:
[ quit = Confirm("Quit "); break ]
case $R: case $r:
[ RoutingInfo(); endcase ]
case $V: case $v:
[ ValidateRecip(); endcase ]
case $W: case $w:
[ WhereIsUser(); endcase ]
case $?:
[
Ws("? One of the following:")
Ws("*nAuthenticate, Date and time, Host,")
Ws("*nNet Directory, Mail check, Quit,")
Ws("*nRouting info, Validate recipient, Where is User.")
loop
]
]
] repeat
CloseLevel1Socket(soc)
] repeatuntil quit
//----------------------------------------------------------------------------
and DateAndTime() be
//----------------------------------------------------------------------------
[
Ws("Date and time protocol ")
[
let pbi = GetPBI(miscSoc)
[
Ws("*N>>>")
switchon Gets(keys) into
[
case $T: case $t:
[
Ws("Tenex format: ")
pbi>>PBI.pup.type = ptTenexTimeRequest
break
]
case $A: case $a:
[
Ws("Alto format: ")
pbi>>PBI.pup.type = ptAltoTimeRequest
break
]
case $S: case $s:
[
Ws("String format: ")
pbi>>PBI.pup.type = ptStringTimeRequest
break
]
case $Q: case $q: Ws("Quit") //falls through
case $*177: [ ReleasePBI(pbi); return ]
case $?:
[
Ws("Alto, Tenex, String: ")
loop
]
]
] repeat
pbi>>PBI.pup.length = pupOvBytes
pbi = SendCommand(pbi); if pbi eq 0 loop
switchon pbi>>PBI.pup.type into
[
case ptStringTimeReply:
[ PrintContents(pbi); endcase ]
case ptTenexTimeReply:
[
for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
PutTemplate(dsp,"$UO ", pbi>>PBI.pup.bytes↑i)
endcase
]
case ptAltoTimeReply:
[
for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
PutTemplate(dsp,"$UO ", pbi>>PBI.pup.bytes↑i)
let uv = vec 6
UNPACKDT(lv pbi>>PBI.pup.bytes↑1, uv)
Ws("= ")
WRITEUDT(dsp, uv)
endcase
]
]
ReleasePBI(pbi)
] repeat
]
//----------------------------------------------------------------------------
and NetDirectory() be
//----------------------------------------------------------------------------
[
Ws("Net directory protocol ")
[
let pbi = GetPBI(miscSoc)
[
Ws("*N>>>")
switchon Gets(keys) into
[
case $A: case $a:
[
break
]
case $N: case $n:
[
let string = vec 40
unless GetString("Name: ", string, true, false) return
AppendStringToPup(pbi, 1, string) //sets Pup.length
pbi>>PBI.pup.type = ptNameRequest
break
]
case $V: case $v:
[
Ws("Version of net dir = ")
pbi>>PBI.pup.words↑1 = 1
pbi>>PBI.pup.words↑2 = 0
pbi>>PBI.pup.type = ptNetDirVersion
pbi>>PBI.pup.length = pupOvBytes+4
break
]
case $Q: case $q: Ws("Quit") // falls through
case $*177: [ ReleasePBI(pbi); return ]
case $?:
[
Ws("Name->Address, Version of NetDir: ")
loop
]
]
] repeat
pbi = SendCommand(pbi); if pbi eq 0 return
switchon pbi>>PBI.pup.type into
[
case ptNameAddrError:
[ PrintContents(pbi); endcase ]
case ptNameReply:
[
for i = 1 to pbi>>PBI.pup.length-pupOvBytes by 6 do
[ PrintPort(lv pbi>>PBI.pup.bytes↑i); Ws(" ") ]
endcase
]
case ptNetDirVersion:
[
PutTemplate(dsp, "$UD", pbi>>PBI.pup.words↑1)
endcase
]
]
ReleasePBI(pbi)
] repeat
]
//----------------------------------------------------------------------------
and WhereIsUser() be
//----------------------------------------------------------------------------
[
let string = vec 40
unless GetString("Where is user: ", string, true, false) return
let pbi = GetPBI(miscSoc)
AppendStringToPup(pbi, 1, string)
pbi = SendCommand(pbi, ptWhereUserRequest)
if pbi eq 0 return
switchon pbi>>PBI.pup.type into
[
case ptWhereUserError:
[ Ws("- No such user"); endcase ]
case ptWhereUserReply:
[
test pbi>>PBI.pup.length eq pupOvBytes
ifso Ws("- Not logged in")
ifnot for i = 1 to pbi>>PBI.pup.length-pupOvBytes by 2 do
[
PutTemplate(dsp, "- Job $D", pbi>>PBI.pup.bytes↑i)
test pbi>>PBI.pup.bytes↑(i+1) eq #377
ifso Ws(", Detached")
ifnot PutTemplate(dsp, ", TTY $0", pbi>>PBI.pup.bytes↑(i+1))
]
endcase
]
]
ReleasePBI(pbi)
]
//----------------------------------------------------------------------------
and RoutingInfo() be
//----------------------------------------------------------------------------
// Note that this one goes to the gateway info socket instead of misc services
[
let pbi = GetPBI(miscSoc)
pbi>>PBI.pup.dPort.socket↑1 = 0
pbi>>PBI.pup.dPort.socket↑2 = psRouteInfo
pbi = SendCommand(pbi, ptRouteInfoRequest, pupOvBytes, 1)
if pbi then
[
Enqueue(lv miscSoc>>PupSoc.iQ, pbi)
RTTitle("Foreign routing table: ")
]
let count = 0
let timer = nil; SetTimer(lv timer, 500) // 5 seconds
[
Block() repeatuntil miscSoc>>PupSoc.iQ.head % TimerHasExpired(lv timer)
let pbi = Dequeue(lv miscSoc>>PupSoc.iQ.head); if pbi eq 0 break
if pbi>>PBI.pup.type eq ptRouteInfoReply then
for i = 1 to pbi>>PBI.pup.length-pupOvBytes by 4 do
RTEntry(pbi>>PBI.pup.bytes↑i, pbi>>PBI.pup.bytes↑(i+1),
pbi>>PBI.pup.bytes↑(i+2), pbi>>PBI.pup.bytes↑(i+3), lv count)
ReleasePBI(pbi)
] repeat
]
//----------------------------------------------------------------------------
and Authenticate() be
//----------------------------------------------------------------------------
[
let name = vec 40
unless GetString("Authenticate user: ", name, true, false) return
let psw = vec 40
unless GetString(" password: ", psw, false, false) return
let pbi = GetPBI(miscSoc)
AppendMesaStringToPup(pbi, 1, name)
AppendMesaStringToPup(pbi, (name>>String.length+7)/2, psw)
pbi = SendCommand(pbi, ptAuthRequest)
if pbi eq 0 return
switchon pbi>>PBI.pup.type into
[
case ptAuthYes:
[ Ws("- Good"); endcase ]
case ptAuthNo:
[ Ws("- No "); PrintContents(pbi); endcase ]
]
ReleasePBI(pbi)
]
//----------------------------------------------------------------------------
and ValidateRecip() be
//----------------------------------------------------------------------------
[
let string = vec 40
unless GetString("Validate recipient: ", string, true, false) return
let pbi = GetPBI(miscSoc)
AppendMesaStringToPup(pbi, 1, string)
pbi = SendCommand(pbi, ptValidRecipRequest)
if pbi eq 0 return
switchon pbi>>PBI.pup.type into
[
case ptValidRecipYes:
[ Ws("- Good"); endcase ]
case ptValidRecipNo:
[ Ws("- Bad"); endcase ]
]
ReleasePBI(pbi)
]
//----------------------------------------------------------------------------
and MailCheck() be
//----------------------------------------------------------------------------
[
let string = vec 40
unless GetString("Mail check for user: ", string, true, false) return
let pbi = GetPBI(miscSoc)
AppendStringToPup(pbi, 1, string)
pbi = SendCommand(pbi, ptMailCheckRequest)
if pbi eq 0 return
switchon pbi>>PBI.pup.type into
[
case ptMailCheckError:
[ Ws("- No such user"); endcase ]
case ptMailCheckNo:
[ Ws("- No new mail"); endcase ]
case ptMailCheckYes:
[ Ws("- New mail waiting "); PrintContents(pbi); endcase ]
]
ReleasePBI(pbi)
]
//----------------------------------------------------------------------------
and SendCommand(opbi, type, length, retries; numargs na) = valof
//----------------------------------------------------------------------------
// returns response pbi or 0 if timeout
[
if na ls 4 then retries = 3
if na ge 3 then opbi>>PBI.pup.length = length
if na ge 2 then opbi>>PBI.pup.type = type
opbi>>PBI.pup.id↑2 = miscID
miscID = miscID+1
let soc = opbi>>PBI.socket
let tQ = vec 1; tQ!0 = 0
opbi>>PBI.queue = tQ
Enqueue(tQ, opbi)
let ipbi = 0
for i = 1 to retries do
[
Block() repeatwhile tQ!0 eq 0
CompletePup(Dequeue(tQ))
let timer = nil; SetTimer(lv timer, 200) //2 sec
[
Block() repeatuntil TimerHasExpired(lv timer) % soc>>PupSoc.iQ.head ne 0
ipbi = Dequeue(lv soc>>PupSoc.iQ)
if ipbi eq 0 break //timeout - retransmit
if MultEq(lv ipbi>>PBI.pup.id, lv opbi>>PBI.pup.id) then
if ipbi>>PBI.pup.type ne typeError break
OtherSpigot(ipbi); ipbi = 0
] repeat
if ipbi ne 0 break
]
Block() repeatwhile tQ!0 eq 0
ReleasePBI(Dequeue(tQ))
resultis ipbi
]
//----------------------------------------------------------------------------
and PrintContents(pbi) be
//----------------------------------------------------------------------------
[
for i = 1 to pbi>>PBI.pup.length-pupOvBytes do
Puts(dsp, pbi>>PBI.pup.bytes↑i)
]
//----------------------------------------------------------------------------
and AppendMesaStringToPup(pbi, firstWord, string) be
//----------------------------------------------------------------------------
[
structure MesaString:
[
length word
maxLength word
char↑1,1 byte
]
let ms = lv pbi>>PBI.pup.words + firstWord -1
ms>>MesaString.length = string>>String.length
ms>>MesaString.maxLength = (string>>String.length+1) & -2
for i = 1 to string>>String.length do
ms>>MesaString.char↑i = string>>String.char↑i
pbi>>PBI.pup.length = pupOvBytes+firstWord*2+ms>>MesaString.maxLength+2
]