// IfsTelnetDisks.bcpl -- server telnet commands dealing with disk packs
// Copyright Xerox Corporation 1979, 1982
// Last modified April 9, 1982 12:59 PM by Taft
get "Ifs.decl"
get "IfsFiles.decl"
get "Streams.d"
external
[
// outgoing procedures
ExecInitialize; ExecExtend; ExecWhat
// incoming procedures
CreateKeywordTable; DestroyKeywordTable; InsertKeyword
GetKeyword; GetNumber; GetString; Confirm
EnableCatch; EndCatch; RetryPhrase; AbortCmd
GetCreateParams; DestroyCreateParams; CreateIFS; CloseIFS; ExtendIFS
OpenTFSDisk; CloseTFSDisk
ExtendStackCall; Lock; Unlock
OpenFile; ReadBlock; Closes
Ws; Wss; IFSPrintError; Errors; StringCompare; PutTemplate; WritePackedDT
// incoming statics
dsp; driveTab; fsQ; openLock
]
//----------------------------------------------------------------------------
let ExecInitialize(cs) be
//----------------------------------------------------------------------------
// Command to initialize a new file system
[
Wss(cs, " (file system type) ")
let kt = nil
if EnableCatch(cs) then [ DestroyKeywordTable(kt); EndCatch(cs) ]
kt = CreateKeywordTable(5)
InsertKeyword(kt, "Primary")!0 = ifsTypePrimary
InsertKeyword(kt, "Backup")!0 = ifsTypeBackup
InsertKeyword(kt, "Auxiliary")!0 = ifsTypeAuxiliary
let cPar = GetCreateParams(GetKeyword(cs, kt)!0)
DestroyKeywordTable(kt)
if cPar ne 0 then
[
Ws("*nInitialization in progress...")
let ec = nil
let fs = CreateIFS(cPar, lv ec)
DestroyCreateParams(cPar)
test fs ne 0
ifso [ CloseIFS(fs); Ws("Done.") ]
ifnot [ Ws("Failed:*n"); IFSPrintError(dsp, ec) ]
]
]
//----------------------------------------------------------------------------
and ExecExtend(cs) be
//----------------------------------------------------------------------------
// Command to extend a file system by adding another pack
[
Wss(cs, " (file system) ")
let ifs = GetFileSystem(cs)
Wss(cs, " (by adding drive) ")
let drive = GetNumber(cs, 8)
if drive ls 0 % drive ge nDrives then RetryPhrase(cs)
if driveTab>>DriveTab↑drive.ifs ne 0 then RetryPhrase(cs, " already in use")
if Confirm(cs) then
[
Ws("*nInitialization in progress...")
let ec = ExtendIFS(ifs, drive)
test ec eq 0
ifso Ws("Done.")
ifnot [ Ws("Failed:*n"); IFSPrintError(dsp, ec) ]
]
]
//----------------------------------------------------------------------------
and GetFileSystem(cs) = valof
//----------------------------------------------------------------------------
[
let name = GetString(cs, 0, Wss, "file system ID")
let ifs = fsQ!0
while ifs ne 0 do
[
if StringCompare(name, ifs>>IFS.id) eq 0 resultis ifs
ifs = ifs!0
]
Errors(cs, 0)
]
//----------------------------------------------------------------------------
and ExecWhat(cs) be
//----------------------------------------------------------------------------
// What (is the pack on drive) <drive>
[
Wss(cs, " (is the pack on drive) ")
let drive = GetNumber(cs, 8)
if drive ls 0 % drive ge nDrives then Errors(cs, 0)
if driveTab>>DriveTab↑drive.ifs ne 0 then
AbortCmd(cs, "*nDrive already in use.")
ExtendStackCall(2048, DoWhat, drive)
]
//----------------------------------------------------------------------------
and DoWhat(drive) be
//----------------------------------------------------------------------------
[
Lock(openLock, true)
let disk = OpenTFSDisk(drive, 0)
Unlock(openLock)
if disk eq 0 then [ Ws("*nCannot mount."); return ]
let s = OpenFile("IFS.home", ksTypeReadOnly, 0, 0, 0, 0, 0, 0, disk)
test s eq 0
ifso
Ws("*nNot an IFS pack.")
ifnot
[
let home = vec lenHome
ReadBlock(s, home, lenHome)
Closes(s)
PutTemplate(dsp, "*nID: $S, Name: $S, Logical unit $O,",
lv home>>Home.id, lv home>>Home.name, home>>Home.thisUnit)
PutTemplate(dsp, "*nType: $S, Initialized at $P.",
(selecton home>>Home.type into
[
case ifsTypePrimary: "Primary"
case ifsTypeBackup: "Backup"
case ifsTypeAuxiliary: "Auxiliary"
default: "??"
]),
WritePackedDT, lv home>>Home.created)
]
Lock(openLock, true)
CloseTFSDisk(disk)
Unlock(openLock)
]