// FtpCli1.bcpl -- data transfer commands
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 21, 1982 6:23 PM by Boggs
get "FtpProt.decl"
get "FtpUser.decl"
get "AltoFileSys.d"
get "Streams.d"
external
[
// outgoing procedures
CliStore; CliRetrieve; CliDump; CliLoad
// incoming procedures from FtpUserProt
UserStore; UserRetrieve; UserDirectory
// incoming procedures from FtpUtil
DiskToNet; NetToDisk; DumpToNet; LoadFromNet
FTPM; DblUsc; FillPLFromLD
// incoming procedures from FtpMiscB
CloseLocalFile; MakeNAMB; ProcessNoCode; FreePointer
// incoming procedures form FtpPlist
FreePList; InitPList; WritePTV
// incoming procedures from FtpCliUtil
CliSwitches; IsCommand; CliError
CliGetString; CliConfirm
// miscellaneous
ExtractSubstring; StringCompare; CopyString
Allocate; Free; Zero; MoveBlock; CallSwat
OpenFile; DeleteFile; LookupEntries
ReadLeaderPage; WriteLeaderPage
Closes; Puts; Enqueue; Dequeue
PutTemplate; Wss
// incoming statics
sysZone; ftpDisk; defaultPL; CtxRunning
userDsp; cli; mt; fpSysDir
overwrite; selective; verify
all; dates; update
]
manifest maxNames = 50
static [ nameVec; cdat; newVers ]
structure String [ length byte; char↑1,1 byte ]
//-----------------------------------------------------------------------------------------
let CliStore() be
//-----------------------------------------------------------------------------------------
[
selective, verify = false, false
all, dates, update = false, false, false
CliSwitches()
let localPL = 0
nameVec = Allocate(sysZone, maxNames); Zero(nameVec, maxNames)
let dvVec = Allocate(sysZone, lDV*maxNames)
let numNames = 0 //number of valid entries in nameVec
let nameIndex = 0 //name we are working on
let firstTime = true
[ //giant repeat loop
if selective & not firstTime break
if nameIndex eq numNames then //nameVec is empty. fill it.
[
if cli ne 0 break //exhausted nameVec and bumped into a command
numNames, nameIndex = 0, 0
for i = 0 to maxNames-1 do FreePointer(nameVec+i)
for i = 0 to maxNames-1 do
[
cli = CliGetString(false); if IsCommand() break
nameVec!i = cli; cli = 0; numNames = numNames+1
]
if numNames eq 0 break //didn't find any. we are done.
let sysDir = OpenFile("SysDir", 0, 0, 0, fpSysDir, 0, 0, 0, ftpDisk)
if sysDir eq 0 then CallSwat("Can't open sysDir!")
LookupEntries(sysDir, nameVec, dvVec, numNames, true)
Closes(sysDir)
]
if selective & numNames ne 2 then
[ CliError("Store/S must specifiy EXACTLY 2 filenames"); break ]
let dv = dvVec + lDV*nameIndex
let fp = dv + offset DV.fp/16
let name = nameVec!nameIndex
PutTemplate(userDsp, "$S$S", (firstTime? "", "*N**Store "), name)
firstTime = false
CtxRunning>>FtpCtx.diskStream = OpenFile(name, ksTypeReadOnly, charItem,
0, fp, 0, 0, 0, ftpDisk)
nameIndex = nameIndex+1
if CtxRunning>>FtpCtx.diskStream eq 0 then
[ CliError(" - No such file"); loop ]
localPL = FillPLFromLD()
if dates then PutTemplate(userDsp, " [$P]", WritePTV, lv localPL>>PL.CDAT)
Wss(userDsp, " as remote file ")
test selective
ifso
[
localPL>>PL.SFIL = nameVec!1; nameVec!1 = 0
Wss(userDsp, localPL>>PL.SFIL)
]
ifnot
[
localPL>>PL.NAMB = MakeNAMB(name)
Wss(userDsp, localPL>>PL.NAMB)
]
// CliStore (cont'd)
let mark, ok = 0, true
if update % verify % dates then
[
localPL>>PL.DPRP.CDAT = true
localPL>>PL.DPRP.VERS = true
mt>>MT.ptx↑markNo = false
let v = vec 2; Zero(v, 2); cdat = v
newVers = true
[
mark = UserDirectory(localPL, CliStoreList)
if mark<<Mark.mark eq markNo then
test mark<<Mark.subCode eq 100b // file not found
ifso
[
Wss(userDsp, " [New file]")
if update then ok = all
]
ifnot if ProcessNoCode(mark<<Mark.subCode, localPL) loop
if mark<<Mark.mark eq markEndOfCommand then
[
if update then
ok = (((table [ dLS; dEQ; dGR ]+1)!DblUsc(lv localPL>>PL.CDAT, cdat)) & update) ne 0
test dates
ifso PutTemplate(userDsp, " [$P]", WritePTV, cdat)
ifnot test newVers
ifso Wss(userDsp, " [New version]")
ifnot Wss(userDsp, " [Old file]")
]
break
] repeat
mt>>MT.ptx↑markNo = true
]
if ok & verify then ok = CliConfirm()
localPL>>PL.DPRP = 0
localPL>>PL.DPRP.SFIL = true
if ok then
[
mark = UserStore(localPL, CliStoreFile)
if mark<<Mark.mark eq markNo then
if ProcessNoCode(mark<<Mark.subCode, localPL) loop
break
] repeat
if mark ne markYes then Wss(userDsp, " - NOT stored")
CloseLocalFile()
localPL = FreePList(localPL)
if mark eq 0 break
] repeat
CloseLocalFile()
FreePList(localPL)
for i = 0 to maxNames-1 do FreePointer(nameVec+i)
Free(sysZone, nameVec)
Free(sysZone, dvVec)
]
//-----------------------------------------------------------------------------------------
and CliStoreFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
if remotePL eq 0 then remotePL = localPL
PutTemplate(userDsp, "*N$S, ", remotePL>>PL.SFIL)
resultis DiskToNet(remotePL, localPL)
]
//-----------------------------------------------------------------------------------------
and CliStoreList(remotePL, localPL) be
//-----------------------------------------------------------------------------------------
[
if DblUsc(lv remotePL>>PL.CDAT, cdat) gr 0 then
MoveBlock(cdat, lv remotePL>>PL.CDAT, 2)
newVers = remotePL>>PL.VERS ne 0
]
//-----------------------------------------------------------------------------------------
and CliRetrieve() be
//-----------------------------------------------------------------------------------------
[
overwrite = true
selective, verify = false, false
all, dates, update = false, false, false
CliSwitches()
let firstTime = true
[
cli = CliGetString(false); if IsCommand() return
unless firstTime do Wss(userDsp, "*N**Retrieve ")
firstTime = false
PutTemplate(userDsp, "remote file $S", cli)
let localPL = InitPList(defaultPL)
localPL>>PL.SFIL = cli; cli = 0
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
if dates % update then localPL>>PL.DPRP.CDAT = true
let mark = nil
[
mark = UserRetrieve(localPL, CliRetrieveWantFile, CliRetrieveCleanup)
if mark<<Mark.mark eq markEndOfCommand break
test mark<<Mark.mark eq markNo
ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
ifnot CliError(" - command failed")
break
] repeat
CloseLocalFile()
FreePList(localPL)
if mark eq 0 % (selective & mark ne markEndOfCommand) break
] repeat
]
//-----------------------------------------------------------------------------------------
and CliRetrieveWantFile(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)
if selective then
[
FreePointer(lv remotePL>>PL.NAMB)
remotePL>>PL.NAMB = CliGetString()
]
test CliOpenLocalFile(remotePL)
ifnot [ Wss(userDsp, " - Not retrieved"); resultis false ]
ifso [ Puts(userDsp, $*N); resultis NetToDisk ]
]
//-----------------------------------------------------------------------------------------
and CliRetrieveCleanup(remotePL, ok) be
//-----------------------------------------------------------------------------------------
[
CloseLocalFile()
unless ok do DeleteFile(remotePL>>PL.NAMB, 0, 0, 0, 0, ftpDisk)
]
//-----------------------------------------------------------------------------------------
and CliDump() be
//-----------------------------------------------------------------------------------------
[
FreePointer(lv cli); cli = CliGetString(); if IsCommand() return
PutTemplate(userDsp, "to remote file $S", cli)
let localPL = InitPList(defaultPL)
localPL>>PL.TYPE = Binary
localPL>>PL.BYTE = 8
localPL>>PL.SFIL = cli; cli = 0
localPL>>PL.DPRP.SFIL = true
[
let mark = UserStore(localPL, CliDumpFile)
if mark<<Mark.mark eq markYes break
test mark<<Mark.mark eq markNo
ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
ifnot CliError(" - command failed")
break
] repeat
CloseLocalFile()
FreePList(localPL)
]
//-----------------------------------------------------------------------------------------
and CliDumpFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let itWentOK = true
let nameVec = Allocate(sysZone, maxNames); Zero(nameVec, maxNames)
let dvVec = Allocate(sysZone, lDV*maxNames)
let numNames = 0 //number of valid entries in nameVec
let nameIndex = 0 //name we are working on
FTPM(markHereIsFile)
[ //repeat
if nameIndex eq numNames then //nameVec is empty. fill it.
[
if cli ne 0 break
numNames, nameIndex = 0, 0
for i = 0 to maxNames-1 do FreePointer(nameVec+i)
for i = 0 to maxNames-1 do
[
cli = CliGetString(false); if IsCommand() break
nameVec!i = cli; cli = 0; numNames = numNames+1
]
if numNames eq 0 break //didn't find any. we are done.
let sysDir = OpenFile("SysDir", 0, 0, 0, fpSysDir, 0, 0, 0, ftpDisk)
if sysDir eq 0 then CallSwat("Can't open sysDir!")
LookupEntries(sysDir, nameVec, dvVec, numNames, true)
Closes(sysDir)
]
let dv = dvVec + lDV*nameIndex
let fp = dv + offset DV.fp/16
let name = nameVec!nameIndex; nameIndex = nameIndex+1
PutTemplate(userDsp, "*N$S ← $S", remotePL>>PL.SFIL, name)
CtxRunning>>FtpCtx.diskStream = OpenFile(name, ksTypeReadOnly, charItem,
0, fp, 0, 0, 0, ftpDisk)
if CtxRunning>>FtpCtx.diskStream eq 0 then
[ CliError(" - No such file"); loop ]
FreePointer(lv localPL>>PL.NAMB)
localPL>>PL.NAMB = ExtractSubstring(name)
let ld = CtxRunning>>FtpCtx.buffer
ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
MoveBlock(lv localPL>>PL.CDAT, lv ld>>LD.created, 2)
itWentOK = DumpToNet(remotePL, localPL)
CloseLocalFile()
unless itWentOK break
] repeat
if itWentOK then DumpToNet(0) //write END block
for i = 0 to maxNames-1 do FreePointer(nameVec+i)
Free(sysZone, nameVec)
Free(sysZone, dvVec)
resultis itWentOK
]
//-----------------------------------------------------------------------------------------
and CliLoad() be
//-----------------------------------------------------------------------------------------
[
overwrite = true
selective, verify = false, false
all, dates, update = false, false, false
CliSwitches()
let firstTime = true
[
cli = CliGetString(false); if IsCommand() return
unless firstTime do Wss(userDsp, "*N**Load ")
firstTime = false
PutTemplate(userDsp, "from remote file $S", cli)
let localPL = InitPList(defaultPL)
localPL>>PL.TYPE = Binary
localPL>>PL.BYTE = 8
localPL>>PL.SFIL = cli; cli = 0
localPL>>PL.DPRP.SFIL = true
localPL>>PL.DPRP.NAMB = true
localPL>>PL.DPRP.BYTE = true
localPL>>PL.DPRP.TYPE = true
if selective then
[
let t = vec 1; t!0 = 0; nameVec = t
[
cli = CliGetString(false); if IsCommand() break
if cli>>String.char↑(cli>>String.length) eq $. then
cli>>String.length = cli>>String.length -1
let t = Allocate(sysZone, cli>>String.length lshift 1 +2)
CopyString(t+1, cli); FreePointer(lv cli)
Enqueue(nameVec, t)
] repeat
if nameVec!0 eq 0 then selective = false
]
let mark = nil
[
mark = UserRetrieve(localPL, CliLoadWantFile)
if mark<<Mark.mark eq markEndOfCommand break
test mark<<Mark.mark eq markNo
ifso if ProcessNoCode(mark<<Mark.subCode, localPL) loop
ifnot CliError(" - command failed")
break
] repeat
CloseLocalFile()
FreePList(localPL)
if selective then
[
while nameVec!0 ne 0 do
Free(sysZone, Dequeue(nameVec))
break
]
if mark eq 0 break //catastrophic error
] repeat
]
//-----------------------------------------------------------------------------------------
and CliLoadWantFile(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
unless remotePL>>PL.TYPE eq Binary & remotePL>>PL.BYTE eq 8 do
[
CliError("*N$S skipped - not in dump format", false, remotePL>>PL.SFIL)
resultis false
]
resultis CliLoadFile
]
//-----------------------------------------------------------------------------------------
and CliLoadFile(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)
let found = not selective
if selective then
[
let name = nameVec!0
while name ne 0 do
[
let namb = remotePL>>PL.NAMB
if namb>>String.char↑(namb>>String.length) eq $. then
namb>>String.length = namb>>String.length -1
if StringCompare(name+1, namb) eq 0 then [ found = true; break ]
name = name!0
]
]
test found
ifso CliOpenLocalFile(remotePL)
ifnot PutTemplate(userDsp, "*N$S", remotePL>>PL.NAMB)
] repeat
//-----------------------------------------------------------------------------------------
and CliOpenLocalFile(pl) = valof
//-----------------------------------------------------------------------------------------
// Handles the all, overwrite, update, dates, and verify flags.
// Returns true with CtxRunning>>FtpCtx.diskStream open for writing,
// or zero if the file should be skipped.
[
PutTemplate(userDsp, "*N$S", pl>>PL.SFIL)
if dates then PutTemplate(userDsp, " [$P]", WritePTV, lv pl>>PL.CDAT)
PutTemplate(userDsp, " to local file $S", pl>>PL.NAMB)
let hintFP = vec lFP; Zero(hintFP, lFP)
CtxRunning>>FtpCtx.diskStream = OpenFile(pl>>PL.NAMB,
ksTypeReadOnly, charItem, verLatest, hintFP, 0, 0, 0, ftpDisk)
let ld = CtxRunning>>FtpCtx.buffer
let ok = true
test CtxRunning>>FtpCtx.diskStream eq 0
ifso
[
Wss(userDsp, " [New file]")
if update then ok = all
]
ifnot
[
if dates % update then
ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
if update then
ok = (((table [ dLS; dEQ; dGR ]+1)!DblUsc(lv pl>>PL.CDAT, lv ld>>LD.created)) & update) ne 0
test dates
ifso PutTemplate(userDsp, " [$P]", WritePTV, lv ld>>LD.created)
ifnot Wss(userDsp, " [Old file]")
unless overwrite do ok = false
CloseLocalFile()
]
if ok & verify then ok = CliConfirm()
if ok then
[
CtxRunning>>FtpCtx.diskStream = OpenFile(pl>>PL.NAMB,
ksTypeWriteOnly, charItem, 0, hintFP, 0, 0, 0, ftpDisk)
if CtxRunning>>FtpCtx.diskStream eq 0 resultis CliError(" - Open Failed")
if pl>>PL.CDAT.h ne 0 then // remove when Juniper implements dates
[
ReadLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
MoveBlock(lv ld>>LD.created, lv pl>>PL.CDAT, 2)
WriteLeaderPage(CtxRunning>>FtpCtx.diskStream, ld)
]
]
resultis ok
]