// IfsBootRare.bcpl -- Boot Server
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified September 5, 1982  12:41 PM by Taft

get "Pup0.decl"
get "Pup1.decl"
get "Streams.d"
get "Ifs.decl"
get "IfsRs.decl"
get "IfsBootServ.decl"
get "IfsServEFTP.decl"
get "AltoFileSys.d"
get "IfsDirs.decl"

external
[
// outgoing procedures
EnableBootServ; BootServUncommon; CheckBFT; InsertBFE

// incoming procedures
FindBFE; SendBootDir; GetTime; InstallBootFiles
PupServReceive; CompletePup; ReleasePBI; GetPBI; SetPupDPort
LockCell; UnlockCell; @VWRP; VirtualPage; MapTree; UpdateRecord
LookupIFSFile; GetBufferForFD; StreamsFD; DestroyFD
SetFilePos; FileLength; ReadBlock; ReadLeaderPage; WriteLeaderPage
DestroyJob; Lock; Unlock
StringCompare; ExpandTemplate; FreePointer
DoubleUsc; DoubleIncrement
SysAllocateZero; SysAllocate; SysFree; Zero; MoveBlock; Max

// incoming statics
@bs; CtxRunning; socMiscellaneous; system
]

//----------------------------------------------------------------------------
let EnableBootServ(enableServer, noNewBootFiles; numargs na) be
//----------------------------------------------------------------------------
[
bs>>BS.externalLock = not enableServer
if na gr 1 then bs>>BS.noNewBootFiles = noNewBootFiles

// Always rebuild BFT when boot server is enabled
bs>>BS.bftCheckTimer = 0
bs>>BS.bftRebuildTimer = 0
]

//----------------------------------------------------------------------------
and BootServUncommon(pbi) be
//----------------------------------------------------------------------------
[ // Note that an ExchangePorts has already been done
switchon pbi>>PBI.pup.type into
   [
   case ptBootDirReply:
      [
      let now = vec 1
      unless bs>>BS.globalLocks eq 0 & // don't update if server disabled
       GetTime(now) &  // do nothing if don't know time
       Lock(lv bs>>BS.treeLock, true, true) endcase  // must write-lock tree

      let p = 1
      until p ge ((pbi>>PBI.pup.length-pupOvBytes)+1) rshift 1 do
         [
         let bfd = lv pbi>>PBI.pup.words↑p
         p = p + offset BFD.name/16 + bfd>>BFD.name.length rshift 1 +1
         if bfd>>BFD.bfn ls 0 %  // don't update if bfn ge 100000B
          DoubleUsc(now, lv bfd>>BFD.date) ls 0 loop  // or if date in future
         let bfe = FindBFE(bfd>>BFD.bfn)
         if bfe eq 0 then
            [ // never heard of this bfn before, perhaps insert new entry.
            // Reject if not accepting new boot files or if bfn ge 40000.
            if bs>>BS.noNewBootFiles % bfd>>BFD.bfn ge 40000B then loop

            // Reject if already have file with same name but different bfn.
            let name = ExpandTemplate("Boot>**-$S", lv bfd>>BFD.name)
            let fd = LookupIFSFile(name, lcVHighest+lcMultiple)
            SysFree(name)
            if fd ne 0 then [ DestroyFD(fd); loop ]

            bfe = InsertBFE(bfd)
            Zero(lv bfe>>BFE.date, 2)  // force update (below)
            ]
         LockCell(lv bfe)
         if StringCompare(lv bfd>>BFD.name, lv bfe>>BFE.name) eq 0 then
            switchon DoubleUsc(lv bfd>>BFD.date, lv bfe>>BFE.date) into
               [
               case 1:  // need to get new copy of boot file from him
                  MoveBlock(lv bfe>>BFE.port, lv pbi>>PBI.pup.dPort, lenPort)
                  bfe>>BFE.update = true
                  VWRP(VirtualPage(bfe rshift 8))  // mark BFE dirty
                  // fall thru
               case -1:  // need to tell him we have a newer version
                  bs>>BS.bftCheckTimer = 0
                  endcase
               ]
         UnlockCell(lv bfe)
         ]

      Unlock(lv bs>>BS.treeLock)
      endcase
      ]
   case ptBootStatsRequest:
      MoveBlock(lv pbi>>PBI.pup.words, lv bs>>BS.stats, size Stats/16)
      CompletePup(pbi, ptBootStatsReply, pupOvBytes+(size Stats/8))
      return
   case ptBootLockRequest:
   case ptBootUnlockRequest:
      if pbi>>PBI.pup.id↑1 eq 27182 & pbi>>PBI.pup.sPort.host ne 0 then
         [
         let enable = pbi>>PBI.pup.type eq ptBootUnlockRequest
         EnableBootServ(enable)
         CompletePup(pbi, (enable? ptBootUnlockReply, ptBootLockReply),
          pupOvBytes)
         return
         ]
      endcase
   ]
ReleasePBI(pbi)
]

//----------------------------------------------------------------------------
and CheckBFT(ctx) be	// a BootCtx
//----------------------------------------------------------------------------
// Context started periodically to check the boot file table.
// Check the BFT for entries with garbage dates, and zero any that are found.
// Then, for all entries marked as needing to be updated, attempt to retrieve
// the boot file from the boot server that advertised itself as having
// a newer one.  Finally, broadcast a copy of our own boot file table.
[
ctx>>BootCtx.userInfo = system
if bs>>BS.externalLock eq 0 then
   [
   // There is only one of me, and I can wait until tree can be write-locked
   Lock(lv bs>>BS.treeLock, true)

   // Rebuild the entire BFT occasionally, so as to pick up boot files that
   // may have been stored via FTP, deleted, etc.
   bs>>BS.bftRebuildTimer = Max(bs>>BS.bftRebuildTimer-1, 0)
   if bs>>BS.bftRebuildTimer eq 0 then
      [ InstallBootFiles(); bs>>BS.bftRebuildTimer = bftRebuildInterval ]

   MapTree(bs>>BS.tree, 0, CheckBFE, 0, 0, true)
   
   // Broadcast copy of my boot file directory
   unless SendBootDir(table [ 0; 0; socketMiscServices ], table [ 0; 0 ]) do
      [  // I have no boot files, broadcast a directory request
      let pbi = GetPBI(socMiscellaneous, true)
      if pbi ne 0 then
         [
         SetPupDPort(pbi, table [ 0; 0; socketMiscServices ])
         CompletePup(pbi, ptBootDirRequest, pupOvBytes)
         ]
      ]
   Unlock(lv bs>>BS.treeLock)
   ]

bs>>BS.bftCheckTimer = bftCheckInterval
bs>>BS.updateCtx = 0
DestroyJob()
]

//----------------------------------------------------------------------------
and CheckBFE(bfe, nil, nil) = valof
//----------------------------------------------------------------------------
[
LockCell(lv bfe)
let now = vec 1
if GetTime(now) & DoubleUsc(now, lv bfe>>BFE.date) ls 0 then
   [ // Garbage date, zero it to make it eligible for update.
   Zero(lv bfe>>BFE.date, 2)
   VWRP(VirtualPage(bfe rshift 8))  // mark BFE dirty
   ]
if bfe>>BFE.update then
   [
   VWRP(VirtualPage(bfe rshift 8))  // mark BFE dirty
   let ftp = vec lenFTP; Zero(ftp, lenFTP)
   ftp>>FTP.frnPort = lv bfe>>BFE.port
   ftp>>FTP.realName = ExpandTemplate("<System>Boot>$UO-$S",
    bfe>>BFE.bfn, lv bfe>>BFE.name)
   ftp>>FTP.tempName = "Temp.boot"
   ftp>>FTP.timeOut1 = 100  // 1 sec
   ftp>>FTP.timeOut2 = 2000  // 20 sec
   ftp>>FTP.proc1 = RBFStartProc
   ftp>>FTP.proc2 = RBFEndProc
   CtxRunning>>BootCtx.bfe = bfe
   if PupServReceive(ftp) then
      DoubleIncrement(lv bs>>BS.stats.filesRcvd)
   SysFree(ftp>>FTP.realName)
   
   // Even if we fail, wait for receipt of next boot dir broadcast
   // before trying again
   bfe>>BFE.update = false
   ]
UnlockCell(lv bfe)
]

//----------------------------------------------------------------------------
and RBFStartProc(soc) be
//----------------------------------------------------------------------------
[
let pbi = GetPBI(soc, true)
if pbi ne 0 then
   [
   pbi>>PBI.pup.id↑2 = CtxRunning>>BootCtx.bfe>>BFE.bfn
   CompletePup(pbi, ptBootFileRequest, pupOvBytes)
   ]
]

//----------------------------------------------------------------------------
and RBFEndProc(stream) = valof
//----------------------------------------------------------------------------
[
SetFilePos(stream, 0, 6)
ReadBlock(stream, lv CtxRunning>>BootCtx.bfe>>BFE.date, 2)
CtxRunning>>BootCtx.bfe>>BFE.exists = true
let ld = GetBufferForFD(StreamsFD(stream))
ReadLeaderPage(stream, ld)
MoveBlock(lv ld>>LD.created, lv CtxRunning>>BootCtx.bfe>>BFE.date, 2)
WriteLeaderPage(stream, ld)
SysFree(ld)
FileLength(stream)  // reposition to end-of-file
resultis true
]

//----------------------------------------------------------------------------
and InsertBFE(bfd) = valof
//----------------------------------------------------------------------------
// Makes a new bft entry containing the information in bft and with
// update=false and exists=false.  Returns pointer to new bfe,
// which caller must keep in a locked cell until done with it.
[
UpdateRecord(bs>>BS.tree, bfd>>BFD.bfn, GenNewBFE, bfd)
resultis FindBFE(bfd>>BFD.bfn)  // can't fail
]

//----------------------------------------------------------------------------
and GenNewBFE(bfe, bfd) = valof
//----------------------------------------------------------------------------
// RecordGenerator procedure called from UpdateRecord.
[
FreePointer(lv bfe)  // free old record if any (shouldn't be one)
let lenBFE = offset BFE.name/16 + bfd>>BFD.name.length rshift 1 +1
bfe = SysAllocateZero(lenBFE)
MoveBlock(lv bfe>>BFE.bfd, bfd, lenBFE - offset BFE.bfd/16)
bfe>>BFE.length = lenBFE
resultis bfe
]