// 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)
]