// NetExec1.bcpl
// Copyright Xerox Corporation 1979, 1980, 1982
// Last modified April 11, 1982  2:00 PM by Boggs

get "PupEftp.decl"
get "AltoDefs.d"

external
[
// outgoing procedures
PrintName; LoadMicrocode; Where
GetTime; GetDir; GetName; NetBoot

// incoming procedures
LoadKT

Zero; Dequeue; Allocate; Free; Block
SetTimer; TimerHasExpired; SetCalendar
PutTemplate; Wss; Closes
StringCompare; GetKeyword; GetString
UNPACKDT; WRITEUDT; EnumerateKeywordTable

GetPartner; OpenLevel1Socket; CloseLevel1Socket
GetPBI; ReleasePBI; CompletePup; EtherBoot
OpenEFTPSoc; ReceiveEFTPBlock; CloseEFTPSoc

// incoming statics
sysZone
kbdCS; cmdDsp; cmdKT; ebKT; buf; eng
lenPBI; ndbQ

// outgoing statics
timeRequest; dirRequest
]

static
[
timeRequest = true
dirRequest = true
ourName = 0
]

manifest
[
psMiscServ = 4
ptAltoTimeReq = 206b
ptAltoTimeReply = 207b
ptBootFileReq = 244b
ptBootDirReq = 257b
ptBootDirReply = 260b
ptAddressLookup = 223b
ptAddressReply = 224b
ptAddressError = 222b
]

structure KTE:
[
date word 2
host word	//if host is zero then
bfn word	//bfn is really a local procedure (e.g. BfnToKeys)
]

structure BFD: [ bfn word; date word 2; name @String ]

//---------------------------------------------------------------------------
let GetTime() be  //a context
//---------------------------------------------------------------------------
[
Block() repeatuntil timeRequest
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptAltoTimeReq
pbi>>PBI.pup.length = pupOvBytes
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
SimplePup(pbi, 50, 1000, InstallTime)
Free(sysZone, pbi)
timeRequest = 0
] repeat

//---------------------------------------------------------------------------
and InstallTime(pbi, nil) = valof
//---------------------------------------------------------------------------
[
structure NTime:
   [
   time word 2
   zone:
      [
      sign bit 1
      hour bit 7
      minute bit 8
      ]
   beginDST word
   endDST word
   ]

if pbi>>PBI.pup.type ne ptAltoTimeReply resultis true  // keep trying
let nTime = lv pbi>>PBI.pup.words
SetCalendar(lv nTime>>NTime.time)
timeParams>>LTP.sign = nTime>>NTime.zone.sign
timeParams>>LTP.zoneH = nTime>>NTime.zone.hour
timeParams>>LTP.zoneM = nTime>>NTime.zone.minute
timeParams>>LTP.beginDST = nTime>>NTime.beginDST
timeParams>>LTP.endDST = nTime>>NTime.endDST
resultis false
]

//---------------------------------------------------------------------------
and GetDir() be  //a context
//---------------------------------------------------------------------------
[
Block() repeatuntil dirRequest
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptBootDirReq
pbi>>PBI.pup.length = pupOvBytes
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
SimplePup(pbi, 100, 300, InstallDir)
dirRequest = 0
] repeat

//---------------------------------------------------------------------------
and InstallDir(pbi, nil) = valof
//---------------------------------------------------------------------------
[
if pbi>>PBI.pup.type eq ptBootDirReply then
   [
   let ptr, maxPtr = 1, (pbi>>PBI.pup.length - pupOvBytes)/2
   let host = pbi>>PBI.pup.sPort.host
   while ptr ls maxPtr do
      [
      let bfd = lv pbi>>PBI.pup.words↑ptr
      let name = lv bfd>>BFD.name
      let length = name>>String.length
      if StringCompare(name, ".boot", length-4) eq 0 then
         LoadKT(cmdKT, name, host, lv bfd>>BFD.date, bfd>>BFD.bfn)
      if StringCompare(name, ".eb", length-2) eq 0 then
         LoadKT(ebKT, name, host, lv bfd>>BFD.date, bfd>>BFD.bfn)
      ptr = ptr + 4 + length/2
      ]
   ]
resultis true
]

//---------------------------------------------------------------------------
and GetName() be  //a context
//---------------------------------------------------------------------------
[
let ndb = ndbQ!0; Block() repeatwhile ourName ne 0 % ndb>>NDB.localNet eq 0
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptAddressLookup
pbi>>PBI.pup.length = pupOvBytes+6
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
let port = lv pbi>>PBI.pup.bytes↑1
port>>Port.net = ndb>>NDB.localNet
port>>Port.host = ndb>>NDB.localHost
SimplePup(pbi, 100, 500, InstallName)
Free(sysZone, pbi)
] repeat

//---------------------------------------------------------------------------
and InstallName(pbi, nil) = valof
//---------------------------------------------------------------------------
[
switchon pbi>>PBI.pup.type into
   [
   case ptAddressReply:
      [
      let numChars = pbi>>PBI.pup.length - pupOvBytes
      ourName = Allocate(sysZone, numChars/2+1)
      for i = 1 to numChars do
         ourName>>String.char↑i = pbi>>PBI.pup.bytes↑i
      ourName>>String.length = numChars
      resultis false
      ]
   case ptAddressError:
      [
      ourName = -1
      resultis false
      ]
   default: resultis true
   ]
]

//----------------------------------------------------------------------------
and PrintName(stream) be
//----------------------------------------------------------------------------
[
test ourName eq 0 % ourName eq -1
   ifso
      [
      let ndb = ndbQ!0
      PutTemplate(stream, "[$O#$O#]",
       ndb>>NDB.localNet, ndb>>NDB.localHost)
      ]
   ifnot PutTemplate(stream, "[$S]", ourName)
]

//---------------------------------------------------------------------------
and LoadMicrocode() be
//---------------------------------------------------------------------------
[
Wss(kbdCS, " from file ")
let kte = GetKeyword(kbdCS, ebKT)
Closes(cmdDsp)

let soc, port = vec lenEFTPSoc, vec lenPort
port>>Port.net = (ndbQ!0)>>NDB.localNet
port>>Port.host = kte>>KTE.host
port>>Port.socket↑1 = 0
port>>Port.socket↑2 = psMiscServ
OpenEFTPSoc(soc, 0, port)

// ought to do some buffer bounds checking, and check file checksum
let bytePtr = nil
   [
   let pbi = GetPBI(soc)
   pbi>>PBI.pup.id↑2 = kte>>KTE.bfn
   CompletePup(pbi, ptBootFileReq, pupOvBytes)
   bytePtr = ReceiveEFTPBlock(soc, buf, 100) // 1 sec
   ] repeatuntil bytePtr gr 0

let bytes = nil
   [
   bytes = ReceiveEFTPBlock(soc, buf+bytePtr rshift 1, 1000)  // 10 sec
   bytePtr = bytePtr + bytes
   ] repeatuntil bytes le 0

CloseEFTPSoc(soc)

let ptr = buf + 256
if eng eq 4 then
   [  // magic incantation from HGM
   ptr = ptr -1
   ptr!0 = 0
   ]
(table [ 61036b; 1401b ])(ptr, true)  // load ram and boot
]

//---------------------------------------------------------------------------
and Where() be
//---------------------------------------------------------------------------
[
Wss(kbdCS, " (is boot file) ")
let kte = GetKeyword(kbdCS, cmdKT)
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptBootDirReq
pbi>>PBI.pup.length = pupOvBytes
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
SimplePup(pbi, 1000, 250, WhereMatch, kte!-1)
Free(sysZone, pbi)
]

//---------------------------------------------------------------------------
and WhereMatch(pbi, string) = valof
//---------------------------------------------------------------------------
[
if pbi>>PBI.pup.type eq ptBootDirReply then
   [
   let ptr, maxPtr = 1, (pbi>>PBI.pup.length-pupOvBytes)/2
   while ptr ls maxPtr do
      [
      let bfd = lv pbi>>PBI.pup.words↑ptr
      let name = lv bfd>>BFD.name
      let length = name>>String.length
      if StringCompare(string, name) eq 0 then
         [
         let utv = vec 7; UNPACKDT(lv bfd>>BFD.date, utv)
         PutTemplate(cmdDsp, "*N[$O#] boot file number $UO, created $P",
          pbi>>PBI.pup.sPort.host, bfd>>BFD.bfn, WRITEUDT, utv)
         ]
      ptr = ptr + 4 + length/2
      ]
   ]
resultis true
]

//---------------------------------------------------------------------------
and NetBoot() be
//---------------------------------------------------------------------------
[
Wss(kbdCS, " (file named) ")
let kte = GetKeyword(kbdCS, cmdKT)
if kte>>KTE.host eq 0 then
   [ Wss(kbdCS, " - NetExec command; not a boot file"); return ]
Wss(kbdCS, " (from server) ")
let server = GetString(kbdCS)
if server>>String.char↑1 eq $[ then
   [
   for i = 2 to server>>String.length-1 do
      server>>String.char↑(i-1) = server>>String.char↑i
   server>>String.length = server>>String.length -2
   ]
let port = vec lenPort
if GetPartner(server, kbdCS, port) then
   EtherBoot(kte>>KTE.bfn, false, port>>Port.host)
Free(sysZone, server)
]

//----------------------------------------------------------------------------
and SimplePup(outPbi, retransTO, totalTO, proc, arg) be
//----------------------------------------------------------------------------
[
let soc = vec lenPupSoc; OpenLevel1Socket(soc)
let q = vec 1; q!0 = 0; outPbi>>PBI.queue = q
let rTimer = nil; SetTimer(lv rTimer, 0)
let tTimer = nil; SetTimer(lv tTimer, totalTO)
let continue = true
   [
   if TimerHasExpired(lv rTimer) then
      [
      outPbi>>PBI.socket = soc
      CompletePup(outPbi)
      SetTimer(lv rTimer, retransTO)
      ]
   Block() repeatuntil soc>>PupSoc.iQ.head ne 0 %
    TimerHasExpired(lv rTimer) % TimerHasExpired(lv tTimer)
   if TimerHasExpired(lv tTimer) break
   let inPbi = Dequeue(lv soc>>PupSoc.iQ); if inPbi ne 0 then
      [
      continue = proc(inPbi, arg)
      ReleasePBI(inPbi)
      ]
   ] repeatwhile continue
CloseLevel1Socket(soc)
]