// FtpKbd1.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modifed July 21, 1982  6:23 PM by Boggs

get "PupParams.decl"
get "FtpProt.decl"
get "AltoFileSys.d"
get "CmdScan.decl"

external
[
// outgoing procedures
KbdStore; KbdRetrieve; KbdDump; KbdLoad

// incoming procedures from FtpUserProtFile
UserStore; UserRetrieve

// incoming procedures from FtpUtil
DiskToNet; NetToDisk; DumpToNet; LoadFromNet
FTPM; FillPLFromLD

// incoming procedures from FtpMiscB
ProcessNoCode; CloseLocalFile; MakeNAMB

// incoming procedures from CmdScan package
GetString; GetFile; GetPhrase; ErasePhrase; InitCmd; BackupPhrase
EnableCatch; EndCatch; TerminatingChar; CmdError; DefaultPhrase

// incoming procedures form FtpPlist
FreePList; InitPList

// miscellaneous
PutTemplate; Wss; ExtractSubstring
OpenFile; DeleteFile; Closes; Puts; Resets; Errors
ReadLeaderPage; WriteLeaderPage
Zero; MoveBlock; Allocate; Free; FreePointer; CallSwat
TruePredicate; FalsePredicate

// incoming statics
sysZone; ftpDisk; defaultPL; CtxRunning
kbdCS; userDsp; userKeys
]

//-----------------------------------------------------------------------------------------
let KbdStore() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "local file ")
if EnableCatch(kbdCS) then [ CloseLocalFile(); EndCatch(kbdCS) ]
CtxRunning>>FtpCtx.diskStream = GetFile(kbdCS, ksTypeReadOnly, charItem,
 0, 0, 0, 0, 0, ftpDisk)

Wss(kbdCS, " as remote file ")
Resets(kbdCS)
let localName = GetString(kbdCS)
let remoteName = MakeNAMB(localName)
DefaultPhrase(kbdCS, remoteName)
FreePointer(lv localName, lv remoteName)
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = FillPLFromLD()
localPL>>PL.SFIL = GetString(kbdCS)
localPL>>PL.DPRP.SFIL = true

   [
   let mark = UserStore(localPL, KbdStoreFile)
   if mark<<Mark.mark eq markYes break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
CloseLocalFile()
FreePList(localPL)
]

//-----------------------------------------------------------------------------------------
and KbdStoreFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
if remotePL eq 0 then remotePL = localPL
PutTemplate(userDsp, "*N$S, ", remotePL>>PL.SFIL)
resultis DiskToNet(remotePL, localPL)
]

//-----------------------------------------------------------------------------------------
and KbdRetrieve() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "remote file ")
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = InitPList(defaultPL)
localPL>>PL.SFIL = GetString(kbdCS)
localPL>>PL.DPRP.SFIL = true
localPL>>PL.DPRP.NAMB = true
localPL>>PL.DPRP.TYPE = true
localPL>>PL.DPRP.BYTE = true
localPL>>PL.DPRP.CDAT = true
localPL>>PL.DPRP.SIZE = true
   [
   let mark = UserRetrieve(localPL, KbdRetrieveWantFile, KbdRetrieveCleanup)
   if mark<<Mark.mark eq markEndOfCommand break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
FreePList(localPL)
CloseLocalFile()
]

//-----------------------------------------------------------------------------------------
and KbdRetrieveWantFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
if remotePL>>PL.NAMB eq 0 resultis false
if remotePL>>PL.SFIL eq 0 then
   remotePL>>PL.SFIL = ExtractSubstring(remotePL>>PL.NAMB)
test KbdOpenLocalFile(remotePL)
   ifnot [ Wss(userDsp, " - Not retrieved"); resultis false ]
   ifso [ Puts(userDsp, $*N); resultis NetToDisk ]
]

//-----------------------------------------------------------------------------------------
and KbdRetrieveCleanup(remotePL, ok) be
//-----------------------------------------------------------------------------------------
[
CloseLocalFile()
unless ok do DeleteFile(remotePL>>PL.NAMB, 0, 0, 0, 0, ftpDisk)
]

//-----------------------------------------------------------------------------------------
and KbdDump() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "to remote file ")
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = InitPList(defaultPL)
localPL>>PL.TYPE = Binary
localPL>>PL.BYTE = 8
localPL>>PL.SFIL = GetString(kbdCS)
localPL>>PL.DPRP.SFIL = true
   [
   let mark = UserStore(localPL, KbdDumpFile)
   if mark<<Mark.mark eq markYes break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
CloseLocalFile()
FreePList(localPL)
]

//-----------------------------------------------------------------------------------------
and KbdDumpFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
FTPM(markHereIsFile)
   [
   let cs = InitCmd(256, 5, 0, 0, 0, userKeys, userDsp)
   if cs eq 0 then [ DumpToNet(0, 0); resultis true ]
   PutTemplate(cs, "*N$S _ local file ", remotePL>>PL.SFIL)
   let length = GetPhrase(cs, 0, 0, 0, Wss,
    "<return> to end dump, or type another filename")
   test length eq 0
      ifnot
         [
         Resets(cs)
         CtxRunning>>FtpCtx.diskStream = GetFile(cs,
          ksTypeReadOnly, charItem, 0, 0, 0, 0, 0, ftpDisk)
         Resets(cs)
         FreePointer(lv localPL>>PL.NAMB)
         localPL>>PL.NAMB = GetString(cs)
         let ld = CtxRunning>>FtpCtx.buffer
         ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
         MoveBlock(lv localPL>>PL.CDAT, lv ld>>LD.created, 2)
         let itWentOK = DumpToNet(remotePL, localPL)
         CloseLocalFile()
         unless itWentOK do [ Closes(cs); resultis false ]
         ]
      ifso [ DumpToNet(0); Closes(cs); resultis true ]
   Closes(cs)
   ] repeat
]

//-----------------------------------------------------------------------------------------
and KbdLoad() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, "from remote file ")
let localPL = 0
if EnableCatch(kbdCS) then [ FreePList(localPL); EndCatch(kbdCS) ]
localPL = InitPList(defaultPL)
localPL>>PL.TYPE = Binary
localPL>>PL.BYTE = 8
localPL>>PL.SFIL = GetString(kbdCS)
localPL>>PL.DPRP.SFIL = true
localPL>>PL.DPRP.NAMB = true
localPL>>PL.DPRP.TYPE = true
localPL>>PL.DPRP.BYTE = true
   [
   let mark = UserRetrieve(localPL, KbdLoadWantFile)
   if mark<<Mark.mark eq markEndOfCommand break
   test mark<<Mark.mark eq markNo
      ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
      ifnot Wss(userDsp, "*007 - command failed")
   break
   ] repeat
CloseLocalFile()
FreePList(localPL)
]

//-----------------------------------------------------------------------------------------
and KbdLoadWantFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
unless remotePL>>PL.TYPE eq Binary & remotePL>>PL.BYTE eq 8 do
   [
   PutTemplate(userDsp, "*N$S skipped - not in dump format", remotePL>>PL.SFIL)
   resultis false
   ]
resultis KbdLoadFile
]

//-----------------------------------------------------------------------------------------
and KbdLoadFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let more = LoadFromNet(remotePL, localPL)
CloseLocalFile()
unless more resultis true
FreePointer(lv remotePL>>PL.SFIL)
remotePL>>PL.SFIL = ExtractSubstring(remotePL>>PL.NAMB)
KbdOpenLocalFile(remotePL)
] repeat

//-----------------------------------------------------------------------------------------
and KbdOpenLocalFile(pl) = valof
//-----------------------------------------------------------------------------------------
// Prints "pl>>PL.SFIL to local file pl>>PL.NAMB",
//  and allows the user to edit NAMB.
// Returns false if the user hit delete.
// Returns true with CtxRunning>>FtpCtx.diskStream open for writing.
[
let cs = InitCmd(256, 5, 0, 0, 0, userKeys, userDsp)
if cs eq 0 resultis false  //user typed delete
PutTemplate(cs, "*N$S to local file ", pl>>PL.SFIL)
DefaultPhrase(cs, pl>>PL.NAMB, $*S)
let string = 0
if EnableCatch(cs) then
   [ FreePointer(lv string); CloseLocalFile(); EndCatch(cs) ]
string = GetString(cs)
let hintFP = vec lFP; Zero(hintFP, lFP)
CtxRunning>>FtpCtx.diskStream = OpenFile(string, ksTypeReadOnly,
 charItem, verLatest, hintFP, 0, 0, 0, ftpDisk)
Wss(cs,(CtxRunning>>FtpCtx.diskStream eq 0? " [New file]", " [Old file]"))
CloseLocalFile()
GetPhrase(cs, TruePredicate, TruePredicate, FalsePredicate, Wss,
 "<return> to confirm or type another filename")
if TerminatingChar(cs) ne $*N then
    ErasePhrase(cs, 1, 0, TerminatingChar(cs))
CtxRunning>>FtpCtx.diskStream = OpenFile(string, ksTypeWriteOnly,
 charItem, 0, hintFP, 0, 0, 0, ftpDisk)
FreePointer(lv pl>>PL.NAMB); pl>>PL.NAMB = string
if CtxRunning>>FtpCtx.diskStream eq 0 then  //open failed
   [ CmdError(cs, " Open Failed"); Errors(cs, ecBackupReplace) ]
if pl>>PL.CDAT.h ne 0 then
   [
   let ld = CtxRunning>>FtpCtx.buffer
   ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
   MoveBlock(lv ld>>LD.created, lv pl>>PL.CDAT, 2)
   WriteLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
   ]
Closes(cs)
resultis true
]