// IfsBackupCmd4.bcpl -- operator interface for backup system
// Copyright Xerox Corporation 1979, 1980, 1981

// Last modified November 17, 1981  8:38 PM by Taft


get "Ifs.decl"
get "IfsSystemInfo.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
get "Disks.d"
get "IfsBackup.decl"

external
[
// outgoing procedures
BackupMount; BackupDismount

// incoming procedures
GetString; Confirm; AbortCmd; EnableCatch; EndCatch
DestroyCreateParams; CreateIFS; OpenIFS; CloseIFS
LookupIFSFile; TransferLeaderPage; DestroyFD; GetBufferForFD
TotalFreePages
VFileReadPage; VFileWritePage; LockCell; UnlockCell
CopyString; StringCompare
Ws; Wss; Puts; PutTemplate; IFSPrintError; WritePackedDT
ReadCalendar; DoubleSubtract; DoubleUsc; Div
Closes; Errors; SysFree; FreePointer; MoveBlock; Zero

// incoming statics
dsp; infoVMD; backupRunning
]


//----------------------------------------------------------------------------
let BackupMount(cs) be
//----------------------------------------------------------------------------
[
Wss(cs, " (backup pack) ")
let name = 0
let bi = nil
if EnableCatch(cs) then
   [ UnlockCell(lv bi); FreePointer(lv name); EndCatch(cs) ]
bi = VFileWritePage(infoVMD, biPage)
LockCell(lv bi)
if bi>>BI.version ne biVersion then
   AbortCmd(cs, "*nPlease set backup parameters first.")
name = GetString(cs, 0, Wss, "pack name")
let bfsd = 0
for i = 0 to numBFSD-1 do
   [
   let bfsd1 = lv bi>>BI.bfsd↑((bi>>BI.iBFSD+i) rem numBFSD)
   switchon bfsd1>>BFSD.state into
      [
      case bfsdUsed:
         Zero(bfsd1, lenBFSD)  //fall into next case
      case bfsdEmpty:
         [ if bfsd eq 0 then bfsd = bfsd1; endcase ]
      case bfsdUsable:
      case bfsdInUse:
         [
         if StringCompare(name, lv bfsd1>>BFSD.id) eq 0 then
            AbortCmd(cs, " -- already mounted.")
         endcase
         ]
      ]
   ]
if bfsd eq 0 then AbortCmd(cs, "*nCan't mount any more.")
let ec = nil
let backupFS = OpenIFS(name, lv ec)
FreePointer(lv name)
if backupFS eq 0 then
   [ Puts(dsp, $*n); IFSPrintError(dsp, ec); AbortCmd(cs) ]
if backupFS>>IFS.type ne ifsTypeBackup then
   [ CloseIFS(backupFS); AbortCmd(cs, "*nNot a backup pack.") ]

// BackupMount (cont'd)

TotalFreePages(backupFS, lv bfsd>>BFSD.freePages)
PutTemplate(dsp, "*n$S ($S), initialized on $P,*n$ED free pages.",
 backupFS>>IFS.id, backupFS>>IFS.name, WritePackedDT,
 lv backupFS>>IFS.created, lv bfsd>>BFSD.freePages)
let fd = LookupIFSFile("<System>BackupIFS.Dir", lcVHighest, 0, backupFS)
test fd eq 0
   ifso
      Ws("*nNo files backed up on this pack.")
   ifnot
      [
      let buf = GetBufferForFD(fd)
      // no need to lock -- I am the only client of this file system
      TransferLeaderPage(fd, buf)
      DestroyFD(fd)
      PutTemplate(dsp, "*nLast backup occurred at $P.",
       WritePackedDT, lv buf>>ILD.created)
      let age = vec 1; ReadCalendar(age);
      DoubleSubtract(age, lv buf>>ILD.created)
      if DoubleUsc(age, lv bi>>BI.fullPeriod) ls 0 then
         PutTemplate(dsp, "*nWarning: last backup less than $D days old!",
          Div(lv bi>>BI.fullPeriod, 3600, age)/24)
      SysFree(buf)
      ]
CopyString(lv bfsd>>BFSD.id, backupFS>>IFS.id)
CloseIFS(backupFS)
if Confirm(cs, "*nIs this the correct pack?") then
   [
   bfsd>>BFSD.refresh = Confirm(cs,
    "*nDo you want to overwrite (re-initialize) this pack?")
   bfsd>>BFSD.state = bfsdUsable
   bi>>BI.okToGo = true
   ]
UnlockCell(lv bi)
]

//----------------------------------------------------------------------------
and BackupDismount(cs) be
//----------------------------------------------------------------------------
[
Wss(cs, " (backup pack) ")
let bi = VFileReadPage(infoVMD, biPage)
if bi>>BI.okToGo % backupRunning then
   AbortCmd(cs, "*nBackup system must be disabled and halted.")
let name = GetString(cs, 0, Wss, "pack name")
bi = VFileWritePage(infoVMD, biPage)
LockCell(lv bi)
let found = false
for i = 0 to numBFSD-1 do
   if StringCompare(name, lv bi>>BI.bfsd↑i.id) eq 0 then
      [
      found = true
      Zero(lv bi>>BI.bfsd↑i, lenBFSD)
      break
      ]
UnlockCell(lv bi)
SysFree(name)
unless found do AbortCmd(cs, " -- not found")
]