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