// CopyDiskCmd.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 21, 1982 7:04 PM by Boggs
get "AltoDefs.d"
get "CopyDisk.decl"
external
[
// outgoing procedures
InitCopyDiskCmd; GetNamePass
// incoming procedures from OS and packages
Block; Dismiss; InitializeContext; SetTimer; TimerHasExpired
Allocate; Free; Min; ReturnFrom; CallersFrame
MoveBlock; Zero; DefaultArgs; Enqueue
Endofs; Puts; Resets; Gets; PutTemplate
ExtractSubstring; StringCompare; CopyString
CreateKeywordTable; InsertKeyword
EnumerateKeywordTable; LookupKeyword
// incoming procedures from other parts of CopyDisk
GetNumber; GetString; Confirm
Wss; MakeSS; DoIt; Ding
// outgoing statics
connName; connPass; userName; userPass
// incoming statics
bootFlag; checkFlag; debugFlag; compressFlag
ctxQ; CtxRunning; sysZone; writeProtectFlag
keys; dsp; comCm; compareErrors; seriousErrors
UserName; UserPassword; controlLock
]
static
[
connName; connPass; userName; userPass
kbdKT
]
structure String [ length byte; char↑1,1 byte ]
//----------------------------------------------------------------------------
let InitCopyDiskCmd() be
//----------------------------------------------------------------------------
[
Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 400), 400, Command))
kbdKT = CreateKeywordTable(11, 1)
InsertKeyword(kbdKT, "Check")!0 = KbdCheck
InsertKeyword(kbdKT, "Compare")!0 = KbdCompare
InsertKeyword(kbdKT, "Compress")!0 = KbdCompress
InsertKeyword(kbdKT, "Connect")!0 = KbdConnect
InsertKeyword(kbdKT, "Copy")!0 = KbdCopy
InsertKeyword(kbdKT, "Debug")!0 = KbdDebug
InsertKeyword(kbdKT, "Help")!0 = KbdHelp
InsertKeyword(kbdKT, "Login")!0 = KbdLogin
if (table [ 61014b; 1401b ])()<<VERS.eng gr 3 then
InsertKeyword(kbdKT, "Partition")!0 = KbdPartition
InsertKeyword(kbdKT, "Quit")!0 = KbdQuit
InsertKeyword(kbdKT, "WriteProtect")!0 = KbdWriteProtect
if UserName>>String.length ne 0 then
userName = ExtractSubstring(UserName)
if UserPassword>>String.length ne 0 then
userPass = ExtractSubstring(UserPassword)
]
//----------------------------------------------------------------------------
and Command() be //a context
//----------------------------------------------------------------------------
[
// ignore subsys name and global switches
let temp = ReadParam(true); if temp ne 0 then Free(sysZone,temp)
let srcDisk = ReadParam(true)
if srcDisk then Cli(srcDisk) // may return...
controlLock = idle
Kbd() // never returns
]
//----------------------------------------------------------------------------
and Cli(srcDisk) = valof
//----------------------------------------------------------------------------
// CmdError forces a return from this frame back to Command which calls Kbd.
[
controlLock = user
PutTemplate(dsp, "*N**Copy $S ", srcDisk)
let fromOK = StringCompare(srcDisk, "from")
if fromOK eq 0 % fromOK eq -2 then
[ Free(sysZone, srcDisk); srcDisk = ReadParam() ]
let src = MakeSS(srcDisk, false)
Free(sysZone, srcDisk)
if src eq 0 then CmdError()
let snkDisk = ReadParam()
let toOK = StringCompare(snkDisk, "to")
if toOK eq 0 % toOK eq -2 then
[ Free(sysZone, snkDisk); snkDisk = ReadParam() ]
let snk = MakeSS(snkDisk, true)
Free(sysZone, snkDisk)
if snk eq 0 then CmdError(src)
let tp = Compatible(src, snk); if tp eq 0 then CmdError(src, snk)
unless AreYouSure(src, snk) do CmdError(src, snk, tp)
if DoIt(src, snk, true, tp) then
if checkFlag then DoIt(src, snk, false, tp)
PrintErrors(src, snk)
Free(sysZone, tp)
(snk>>SS.destroy)(snk)
(src>>SS.destroy)(src)
finish
]
//----------------------------------------------------------------------------
and CmdError(src, snk, tp; numargs na) be
//----------------------------------------------------------------------------
[
if na gr 0 & src then (src>>SS.destroy)(src)
if na gr 1 & snk then (snk>>SS.destroy)(snk)
if na gr 2 & tp then Free(sysZone, tp)
ReturnFrom(CallersFrame())
]
//----------------------------------------------------------------------------
and ReadParam(dontEcho; numargs na) = valof
//----------------------------------------------------------------------------
[
if comCm eq 0 resultis 0
if na eq 0 then dontEcho = false
let string = vec 127
let char = 0
string>>String.length = 0
[ //name
if Endofs(comCm) break
char = Gets(comCm); unless dontEcho do Puts(dsp, char)
if string>>String.length eq 0 & char eq $*S loop
if char eq $*N % char eq $*S % char eq $/ break
string>>String.length = string>>String.length +1
string>>String.char↑(string>>String.length) = char
] repeat
let resString = string>>String.length ne 0 ? ExtractSubstring(string), 0
string>>String.length = 0
if char eq $/ then
[ //switches
if Endofs(comCm) break
char = Gets(comCm); unless dontEcho do Puts(dsp, char)
if char eq $*N % char eq $*S break
if char ne $/ then
[
string>>String.length = string>>String.length +1
string>>String.char↑(string>>String.length) = char
]
] repeat
// switches are currently ignored (global switches are read elsewhere)
resultis resString
]
//----------------------------------------------------------------------------
and Kbd() be
//----------------------------------------------------------------------------
[
while controlLock eq server do
[ //ignore type-in
unless Endofs(keys) do [ Ding(dsp); Resets(keys) ]
Dismiss(10)
]
Wss(dsp, "*N**")
Block() repeatwhile Endofs(keys) & controlLock eq 0
if controlLock eq 0 then
[
controlLock = user
let key = 0
[
key = GetString(0, key, editEcho+editAppend, CmdList)
if key eq 0 break
let tableKey = nil
let kte = LookupKeyword(kbdKT, key, lv tableKey)
test kte eq 0
ifso Ding(dsp)
ifnot
[
for i = key>>String.length+1 to tableKey>>String.length do
Puts(dsp, tableKey>>String.char↑i)
Free(sysZone, key)
(kte!0)() //execute command
break
]
] repeat
controlLock = idle
]
] repeat
//----------------------------------------------------------------------------
and CmdList() be
//----------------------------------------------------------------------------
[
Wss(dsp, "? one of the following:*N")
let count = 0
EnumerateKeywordTable(kbdKT, PrintCmd, lv count)
Wss(dsp, "*N**")
]
//----------------------------------------------------------------------------
and PrintCmd(kte, kt, key, lvCount) be
//----------------------------------------------------------------------------
[
unless @lvCount eq 0 do Wss(dsp, ", ")
Wss(dsp, key)
test @lvCount eq 5
ifso [ @lvCount = 0; Puts(dsp, $*N) ]
ifnot @lvCount = @lvCount +1
]
//----------------------------------------------------------------------------
and KbdQuit() be finish
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KbdDebug() be
//----------------------------------------------------------------------------
[
debugFlag = not debugFlag
PutTemplate(dsp, "ging printout $S", (debugFlag? "ON", "OFF"))
]
//----------------------------------------------------------------------------
and KbdCheck() be
//----------------------------------------------------------------------------
[
checkFlag = not checkFlag
test checkFlag
ifso Wss(dsp, "ing ON - compare after copying")
ifnot Wss(dsp, "ing OFF - all bets are off")
]
//----------------------------------------------------------------------------
and KbdWriteProtect() be
//----------------------------------------------------------------------------
[
writeProtectFlag = not writeProtectFlag
test writeProtectFlag
ifso Wss(dsp, "ion ON - remote CopyDisks can't overwrite local disks")
ifnot Wss(dsp, "ion OFF - remote CopyDisks can overwrite local disks")
]
//----------------------------------------------------------------------------
and KbdCompress() be
//----------------------------------------------------------------------------
[
compressFlag = not compressFlag
test compressFlag
ifso Wss(dsp, "ion ON - free pages not transmitted or compared")
ifnot Wss(dsp, "ion OFF - perform bit-for-bit copies and compares")
]
//----------------------------------------------------------------------------
and KbdHelp() be
//----------------------------------------------------------------------------
[
Wss(dsp, "*NI copy disk packs -- either between two disk drives on the local")
Wss(dsp, "*N machine, or between a local disk and a remote disk. The remote")
Wss(dsp, "*N disk may even be an Interim File System.*N")
Wss(dsp, "*NThe syntax of disk names is: [HostName]DiskName. 'HostName' may")
Wss(dsp, "*N be e.g. 'Ivy' or '3#17#', and may be omitted for a local disk.")
Wss(dsp, "*N 'DiskName' is e.g. 'BFS', 'DP0', or '<BasicDisks>NonProg.bfs'.")
]
//----------------------------------------------------------------------------
and KbdLogin() be
//----------------------------------------------------------------------------
[
GetNamePass(" user: ", lv userName, lv userPass)
if userName>>String.length ne 0 then
MoveBlock(UserName, userName,
Min(userName>>String.length/2+1, UserName!-1))
if userPass>>String.length ne 0 then
MoveBlock(UserPassword, userPass,
Min(userPass>>String.length/2+1, UserPassword!-1))
]
//----------------------------------------------------------------------------
and KbdConnect() be
//----------------------------------------------------------------------------
GetNamePass(" to directory: ", lv connName, lv connPass)
//----------------------------------------------------------------------------
and GetNamePass(prompt, lvName, lvPass) = valof
//----------------------------------------------------------------------------
[
@lvName = GetString(prompt, @lvName, editEcho+editReplace)
if @lvName ne 0 then
[
@lvPass = GetString(" password: ", @lvPass, editReplace)
resultis @lvPass
]
resultis false
]
//----------------------------------------------------------------------------
and KbdPartition() be
//----------------------------------------------------------------------------
[
let currentPartition = (table [ 61037b; 1401b ])(0)
let newPartition = GetNumber(" number: ", currentPartition)
let result = (table [ 61037b; 1401b ])(newPartition)
if result eq -1 & newPartition ne currentPartition then bootFlag = true
]
//----------------------------------------------------------------------------
and KbdCopy() be KbdDoIt(true)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KbdCompare() be KbdDoIt(false)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KbdDoIt(copyFlag) be
//----------------------------------------------------------------------------
// CmdError forces a return from this frame back to Kbd.
[
let srcDisk = GetString(copyFlag? " from ", " ")
if srcDisk eq 0 then CmdError()
let src = MakeSS(srcDisk, false)
Free(sysZone, srcDisk)
if src eq 0 then CmdError()
let snkDisk = GetString(copyFlag? "*N Copy to ", "*NAgainst ")
if snkDisk eq 0 then CmdError(src)
let snk = MakeSS(snkDisk, copyFlag)
Free(sysZone, snkDisk)
if snk eq 0 then CmdError(src)
let tp = Compatible(src, snk); if tp eq 0 then CmdError(src, snk)
if copyFlag unless AreYouSure(src, snk) do CmdError(src, snk, tp)
let ok = copyFlag? DoIt(src, snk, true, tp), true
if ok & (not copyFlag % checkFlag) then DoIt(src, snk, false, tp)
PrintErrors(src, snk)
Free(sysZone, tp)
(src>>SS.destroy)(src)
(snk>>SS.destroy)(snk)
]
//----------------------------------------------------------------------------
and AreYouSure(src, snk) = valof
//----------------------------------------------------------------------------
[
if snk>>SS.type eq ssNetLog resultis true
PutTemplate(dsp, "*N*NCopying onto $S will destroy its old contents.",
snk>>SS.device)
let ok = Confirm("*NAre you sure this is what you want to do?")
if ok then
[
Dismiss(500) //5 sec
Resets(keys)
ok = Confirm("*N*NAre you still sure?")
]
resultis ok
]
//----------------------------------------------------------------------------
and Compatible(src, snk) = valof
//----------------------------------------------------------------------------
// returns xferParams or 0
[
let srcType = src>>SS.dp>>CD.diskParams.diskType
let snkType = snk>>SS.dp>>CD.diskParams.diskType
if srcType ne 0 & snkType ne 0 & srcType ne snkType then
[ Wss(dsp, "*NDisk types are incompatible"); resultis 0 ]
let xferParams = src>>SS.compatible(src, snk)
Free(sysZone, snk>>SS.dp)
snk>>SS.dp = Allocate(sysZone, src>>SS.dp>>CD.length)
MoveBlock(snk>>SS.dp, src>>SS.dp, src>>SS.dp>>CD.length)
resultis xferParams
]
//----------------------------------------------------------------------------
and PrintErrors(src, snk) be
//----------------------------------------------------------------------------
[
if compareErrors then
PutTemplate(dsp, "*N$UD Data compare errors", compareErrors)
Wss(dsp, "*NDone. ")
test seriousErrors % compareErrors
ifso PutTemplate(dsp, "But DO NOT trust $S.", snk>>SS.device)
ifnot PutTemplate(dsp, "$S and $S are identical.",
src>>SS.device, snk>>SS.device)
]