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